#!/afs/athena/contrib/perl/perl

require 'sys/socket.ph';

$sockaddr = 'S n a4 x8';

#serve TCP port 7999 unless a different one is specified on command line
$proto = (getprotobyname('tcp'))[2];
$port = $ARGV[0] || 7999;
$port = pack($sockaddr, &AF_INET, $port, "\0\0\0\0");

socket(S, &AF_INET, &SOCK_STREAM, $proto) || die "Can't open socket: $!";
bind(S, $port) || die "Can't bind socket: $!";
listen (S, 5);

while(1) {
   accept(NS, S);
   select (NS);
   $| = 1;
   
   # send standard HTTP "OK" reply
   print "HTTP/1.0 200 OK\r\n";
   print "Content-type: text/plain\r\n\r\n";

   # read and echo HTTP command request; save request-type away for later use
   ($reqtype) = split(/ /, $_ = <NS>);
   print;

   # read and echo MIME headers; watch for Content-Length: header
   while (<NS>) {
      print;
      /^Content-Length:\s*(.*)\r$/i && ($length = $1);
      last if /^\r$/; # blank line ends MIME headers
      }

   if ($length) {
      # Content-Length: header found; read the specified number of bytes
      $line .= getc(NS) while ($length--);
     
      # read(NS, $line, $length); # this hangs, why?
      # $line = <NS>;  # this doesn't hang
      print "$line\r\n";
      }

   elsif (($reqtype eq "PUT") || ($reqtype eq "POST")) {
      # no Content-Length: header, so look for terminating line
      while (<NS>) {
	 last if /^.\r$/;  # line containing only a period terminates input
	 print;
	 }
      }
   close NS;
   }