#!/usr/bin/perl

use NetServer::Generic;

# minimal http server (HTTP/0.9):

sub url_to_file($) {
   # for a given URL, turn it into an absolute pathname
   my ($u) = shift ;    # incoming URL fragment from GET request
   my ($f) = "";        # file pathname to return
   my ($htbase) = "/home/httpd/html/";
   my ($htdefault) = "index.html";
   chomp $u;
   if ($u eq "/") {
       $f = $htbase . $htdefault;
       return $f;
   } else {
       if ($u =~ m|^/.+|) {
           $f = $htbase;  chop $f;
           $f .= $u;
       } elsif ($u =~ m|[^/]+|) {
           $f = $htbase . $u;
       }
       if ($u =~ m|.+/$|) {
           $f .= $htdefault;
       }
       if ($f =~ /\.\./) {
           my (@path) = split("/", $f);
           my ($buff, $acc) = "";
           shift @path;
           while ($buff = shift @path) {
               my ($tmp) = shift @path;
               if ($tmp ne '..') {
                   unshift @path, $tmp;
                   $acc .= "/$buff";
               }
           }
           $f = $acc;
       }
   }
   return $f;
}

my ($http) = sub {
    while (defined ($tmp = <STDIN>)) {
        chomp $tmp;
	print STDERR "Raw http request: $tmp\n";
	my ($req, $url, $proto) = split(/\s+/, $tmp);
	print STDERR "request: $req\nurl: $url\nprotocol: $proto\n\n";
        if ($req =~ /GET/) { 
            my ($getfile) = url_to_file($url);
            print STDERR "Sending $getfile\n";
	    if (! -r $getfile) {
                 print STDERR "could not read $getfile\n";
	    }
            my ($in) = new IO::File();
            if ($in->open("<$getfile") ) {
                $in->autoflush(1);
                my $httpd_hdr = "Content-type: text/html\n\n";
                print STDOUT $httpd_hdr;
		$NetServer::Debug && print STDERR $httpd_hdr;
                while (defined ($line = <$in>)) {
                    print STDOUT $line;
		    $NetServer::Debug && print STDERR $line;
                }
            } else {
	        my $httpd_err = "404: File not found\n\n";
                print STDOUT $httpd_err;
		$NetServer::Debug && print $httpd_err, "$!\n";
            }
        }
        return 0;
    }
};                           

my (%config) =  ("port" => 9000, 
                 "callback" => $http, 
                 "mode" => "prefork",
                 "start_servers" => 4,
                 "max_servers" => 10,
                 "min_spare_servers" => 2,
                );
my ($foo) = new NetServer::Generic(%config);

my ($allowed) = ['.*antipope\.org', 
                 '.*easynet\.co\.uk' ];

my ($forbidden) = [ '194\.205\.10\.2'];

$foo->allowed($allowed);
$foo->forbidden($forbidden);
print "Server started\n";
$foo->run();

__END__

=pod

=head1 shttpd -- a trivial HTTP server

This is not a real web server, although it might turn into one
eventually!

You will need to modify %config (specifically the hostname) before
it will do anything useful. You may also need to modify the
B<allowed> and B<forbidden> anonymous arrays; these are given to
provide an example of simple access control to a server.

B<shttpd> understands a single HTTP command:

  GET I<filename>

It looks for files in B<$htbase> (defined in B<url_to_file()>, the 
subroutine that maps HTTP requests to absolute pathnames). If a
trailing slash is encountered, it appends B<$htdefault> (currently
set to I<index.html>).

If the file is not found, it returns a 404: File not found response --
otherwise it assumes the file is HTML and sends it(!). This may not
be what you want to do if the file is I<not> HTML, so take care.

B<shttpd> doesn't understand CGI scripts, relative URLs, or just about
anything. However, it serves as a skeleton which can easily be
extended to add these features.