[SWLUG] mini web server

[Steve Marvell]

It's a bit hacky, but it'll do, I'm sure.

#!/usr/bin/perl

use IO::Socket;

# usage: $0 <ip> <port>

$ip = shift || "127.0.0.1";
$port = shift || 80;

$cons = 5; # queue size

print "Mini server on $ip:$port\n";

$SIG{'QUIT'} = $SIG{'INT'} = $SIG{'TERM'} = $SIG{'HUP'} 
  = sub { print "bang\n"; close $connection; close $server; exit 1 };

$server = new IO::Socket::INET ( LocalAddr => $ip,
                                 LocalPort => $port,
				 Reuse => 1,
                                 Proto => 'tcp',
                                 Listen => $cons );

die "$!" unless $server;

# you could fork for connections but it seems silly, in context

while (($connection,$peer) = $server->accept()) {
    
    ($peerport, $peeraddr) = sockaddr_in($peer);
    $peerhost = join(".",unpack ("C4", $peeraddr));

    print "* Connection from: $peerhost:$peerport\n";

    # Authenticate
    # use whatever means you want to authenticate the request

    while(<$connection>) {

      print; # locally

      ($request,$http) = ($1,$2) if (/^GET ([^ ]+) (HTTP\/1.\d)/);

      # or whatever

      last if /\s+/;
    }
    
    print "request: $request\n";
    print "http: $http\n";

    # Authorise

    # do what you will to authorise the thing

    $auth = $request =~ m!/home/steve!;

    if ($auth) {

      # check file exists

      if (-f $request) {

	# determine type

	$mime = "application/bogus"; # to ensure download

	if (open(FILE,$request)) {

	  print "OK\n";
	  print $connection "$http 200 OK\n";
	  print $connection "Content-type: $mime\n\n";
	  print $connection $_ while(<FILE>);

	} else {

	  print "Error opening $request: $!\n";
	  print $connection "$http 403 Forbidden\n";
	  print $connection "Content-type: text/plain\n\n$request: $!";
	}	  

      } else {

	print "404\n";
	print $connection "$http 404 Not Found\n";
	print $connection "Content-type: text/plain\n\n$request not found\n";
      }

    } else {

      print "AUTH: not allowed to request $request\n";
      print $connection "$http 403 Forbidden\n";
      print $connection "Content-type: text/plain\n\n$request not allowed\n";
      # optionally exit here
    }

    print "* closing connection\n";
    close $connection;
}

close $server;