package MyHTTPD;
use vars qw(@ISA);
use strict;
use Net::Server::PreFork;
@ISA = qw(Net::Server::PreFork);
MyHTTPD->run();
exit;
sub configure_hook {
my $self = shift;
$self->{server}->{port} = ['*:80']; $self->{server}->{chdir} = '/'; $self->{server}->{user} = 'nobody'; $self->{server}->{group} = 'nobody'; $self->{server}->{setsid} = 1;
open(STDIN, '</dev/null') || die "Can't close STDIN [$!]";
open(STDOUT,'>/dev/null') || die "Can't close STDOUT [$!]";
$self->{document_root} = "/home/httpd/www";
$self->{default_index} = [ qw(index.html index.htm main.htm) ];
$self->{mime_types} = {
html => 'text/html',
htm => 'text/html',
gif => 'image/gif',
jpg => 'image/jpeg',
};
$self->{mime_default} = 'text/plain';
}
sub process_request {
my $self = shift;
local %ENV = ();
my $line = <STDIN>;
$line =~ s/[\r\n]+$//;
unless( $line =~ /^ (\w+) \ + (\S+) \ + (HTTP\/1.\d) $ /x ){
return error(400, "Bad request");
}
my ($method,$req,$protocol) = ($1,$2,$3);
$self->read_headers || return error(400, "Strange headers");
unless( $method =~ /GET|POST|HEAD/ ){
return error(400, "Unsupported Method");
}
unless( $req =~ m%^ (?:http://[^/]+)? (.*) $%x ){
return error(400, "Malformed URL");
}
$ENV{REQUEST_URI} = $1;
my $uri = '';
$ENV{QUERY_STRING} = '';
if( $ENV{REQUEST_URI} =~ m%^ ([^\?]+) (?:\?(.+))? $%x ){
$ENV{QUERY_STRING} = defined($2) ? $2 : '';
$uri = $1;
}
if( $uri=~/[\ \;]/ ){
return error(400, "Malformed URL");
}
$uri =~ s/%(\w\w)/chr(hex($1))/eg;
1 while $uri =~ s|^\.\./+||;
$uri = "$self->{document_root}$uri";
if( -d $uri ){
foreach (@{ $self->{default_index} }){
if( -e "$uri/$_" ){
$uri = "$uri/$_";
last;
}
}
}
if( !-e $uri ){
return error(404, "file not found");
}elsif( -d $uri ){
print content_type('text/html'),"\r\n";
print "Directory listing not supported";
}elsif( open(FILE, "<$uri") ){
my ($type) = $uri =~ m/([^\.]+)$/;
$type = exists($self->{mime_types}->{$type})
? $self->{mime_types}->{$type} : $self->{mime_default};
print status(200), content_type( $type ), "\r\n";
print STDOUT $_ while (<FILE>);
close(FILE);
}else{
return error(500, "Can't open file [$!]");
}
}
sub read_headers {
my $self = shift;
$self->{headers} = {};
while(<STDIN>){
s/[\r\n]+$//;
last unless length $_;
unless( /^([\w\-]+) :[\ \t]+ (.+) $/x ){
return 0;
}
my $key = "HTTP_" . uc($1);
$key =~ tr/-/_/;
$self->{headers}->{$key} = $2;
}
return 1;
}
sub content_type {
my $type = shift;
return "Content-type: $type\r\n";
}
sub error{
print &status;
print "\r\n";
}
sub status {
my $number = shift;
my $msg = shift || '';
return "Status $number: $msg\r\n";
}
1;