Tim Van Wassenhove » Perl

Simple HTTP proxy with Perl

timvw — Tue, 20 Dec 2005 19:23:45 +0000

Today i had to demonstrate my version of a HTTP proxy and hand in the code. There are already various programs that do this, but here is my version: httpproxy.txt

Parsing http headers

timvw — Mon, 14 Nov 2005 19:42:37 +0000

Today i updated my HTTP proxy a little. RFC 2616 describes Message Headers as following:

message-header = field-name ":" [ field-value ]
field-name     = token
field-value    = *( field-content | LWS )
field-content  =

Here is the code i used to get the field-name and field-value. Do you see the bug?

my ($name, $value) = split /:/, $in;

Location headers look like “header: http://www.example.com”. Now, the problem is that split returns a list with “location”, “http” and “www.example.com”. Here is the solution:

my $in = "location: http://www.example.com";
my ($name, $value) = split /:/, $in, 2;

Reading http chunked body

timvw — Mon, 14 Nov 2005 19:40:53 +0000

Here is my implementation of Chunked Transfer Coding. I find it quite elegant compared to other snippets i’ve seen.

###################################################
# {{{ read body chunked
###################################################
sub getbodychunked
{
	my $sh = shift; # the socket handle should be passed
	my ($in, $body);

	for ($in = < $sh>; defined $in; $in = < $sh>)
	{
		$in = trim $in;
		my $chunk = hex $in;
		while (defined $in && $chunk > 0)
		{
			$chunk -= read $sh, $in, $chunk;
			$body .= $in;
		}
	}
	return $body;
}

Handling options

timvw — Thu, 10 Nov 2005 19:45:54 +0000

Last couple of days i’ve been writing a little script in Perl. One of the requirements is the following: it accepts (eventual) parameters to indicate the port it should use, where it should write log messages, how verbose the logging is. To do implement this i use the Getopt::Std module. You can see in the following snippet how easy it makes things: (Notice how it takes care of invalid option switches etc…)

#!/usr/bin/env perl
###############################################
# Author: Tim Van Wassenhove
# Update: $Id:$
###############################################
# {{{ initialize
###############################################
use strict;
use diagnostics;
use Getopt::Std;

use constant {
        DEFAULT_PORT => 8888,
        DEFAULT_LOGFILE => "&STDOUT",
        DEFAULT_LOGLEVEL => 5,
        PROGNAME => "stupid proxy/0.1",
};
# }}}
###############################################
# {{{ display usage options
###############################################
sub usage
{
        print STDERR < < "EOF";
usage: $0 [-p port] [-f logfile] [-l level]

-h              : this (help) message
-p port         : the portnumber to run this proxy server on
-f logfile      : the file where the logging message go to
-l loglevel     : the level of verboseness of the logging, 0 is silent, 5 is loud

Report bugs and suggestions at http://timvw.madoka.be
EOF
        exit;
}
# }}}
###############################################
# {{{ main entry point
###############################################
my %options;
getopts 'p:f:l:h', \%options or usage;
usage if exists $options{h};

# use default port unless user gave different port
my $port = DEFAULT_PORT;
if (exists $options{p} && $options{p} =~ /^\d+$/)
{
        $port = $options{p};
}

# use default logfile unless user gave different file
my $logfile = DEFAULT_LOGFILE;
if (exists $options{f})
{
        $logfile = $options{f};
}

# use default loglevel, unless user gave different level
my $loglevel = DEFAULT_LOGLEVEL;
if (exists $options{l} && $options{l} >= 0 && $options{l} < = 5)
{
        $loglevel = $options{l};
}

Passing a filehandle as parameter

timvw — Thu, 20 Oct 2005 00:23:25 +0000

To keep things maintainable we split our program in modules, classes, functions… In perlsub from the execellent perl documentation you can lookup the syntax of how to use functions. Offcourse, you have to digg pretty deep to find out how you can pass a filehandle:

# clientproc(*STDOUT);
# pass the socket
clientproc(*CH);

sub clientproc
{
  $fh = shift;
  print $fh "hello world";
}