#!/usr/athena/bin/perl

sub __STDC__ {0;} sub INTEL {0;} sub ATT {0;}
sub _POSIX_C_SOURCE {0;} sub _BSD {0;}
sub killchild { wait; }
sub alarm {
  alarm(600);
  exit 0 if getppid == 1;
}

require "sys/types.ph";
require "sys/socket.ph";
eval 'require "sys/errno.ph"';
require "errno.ph" if $@ ne "";

$sockaddr = 'S n a4 x8';

if ($ARGV[0] eq "-v") {
  $verbose = 1;
  shift;
}
if ($ARGV[0] eq "-kill") {
  $killprocess = $ARGV[1];
  shift; shift;
}

($port, $helpdir) = @ARGV;
$port = 8001 unless $port;
$helpdir = '/mit/outland/share/lib/xzewd/help/' unless $helpdir;

($name, $aliases, $proto) = getprotobyname('tcp');
if ($port !~ /^\d+$/) {
  ($x, $y, $port) = getservbyport($port, 'tcp');
}

socket(S, &AF_INET, &SOCK_STREAM, $proto) || die "socket: $!";

do {
  $this = pack($sockaddr, &AF_INET, $port++, "\0\0\0\0");
} while (!bind(S, $this));

listen(S, 5) || die "listen: $!";

$port--;
print STDERR "#listening on port ", $port, "\n" if $verbose;
open(PORTFILE, ">/tmp/helpserver.$$");
print PORTFILE $port, "\n";
close PORTFILE;
kill('USR1', $killprocess) if $killprocess;

select(NS); select(STDOUT); select(S); $| = 1; select(STDOUT);
$SIG{'CHLD'} = 'killchild';
$SIG{'ALRM'} = 'alarm';
alarm(600);

while (1) {
  if (!($addr = accept(NS, S))) {
    die "$! during accept" if ($! != &EINTR);
    next;
  }
  
  if (fork() == 0) {
    close S;
    $_ = <NS>;
    chop $_ if /\n$/;
    chop $_ if /\r$/;
    
    if (/^GET (\S*)\s*(.*)$/) {
      select NS;

      $http1 = 0;
      ($first, $search) = split(/\?/, $1);
      if ($2 =~ m~HTTP/(\d*).*~) {
	$http1 = 1 if $1 > 0;
      }
      $first .= "index.html" if $first =~ m|/$|;
      $redirect = 0;
      
      if ($first =~ /\.map$/ && $search) {
	($dir) = $first =~ m#(.*/)[^/]*#;
	($x, $y) = split(/,/, $search);
	$found = 0;
	if (open(MAPF, $helpdir . $first)) {
	  while (<MAPF>) {
	    ($X, $Y, $W, $H, $first) = split;
	    if ($x >= $X && $y >= $Y && $x < $X + $W && $y < $Y + $H) {
	      $found = 1;
	      $first = $dir . $first if $dir && $first !~ m#^/#;
	      last;
	    }
	  }
	  close MAPF;
	}
	$first = "/mapnotfound" if (!$found);
	$redirect = 1;
      }
      
      $location = $first;
      print STDERR "(~", $first, "=", $location if $verbose;
      while ($location =~ m~(.*/)[^/]*/\.\./(.*)~) {
	$location = $1 . $2;
      }
      if ($redirect && $http1) {
	print <<"EOF";
HTTP/1.0 302 Found
Location: http://localhost:$port$location

<head><title>This indirection is nice</title></head>
<body><h1>This indirection is nice</h1>
It's really <a href="http://localhost:$port$location">here</a>.
</body>
EOF
      } elsif (open(HTML, $helpdir . $first)) {
	$_ = <HTML>;
	if (/^<!-- HASMAP -->/) {
	  while (<HTML>) {
	    if (/^<!-- MAP ([^>]*)>/) {
	      print "<", $1, ">";
	    } else {
	      print;
	    }
	  }
	} else {
	  print;
	  print while (<HTML>);
	}
	close HTML;
      } else {
	print "<head><title>Whoops!</title></head>
<body><h1>Sorry, this document is unavailable</h1>
Sorry, but the document `", $first, "' is unavailable right now.
This help system isn't done yet, after all!</body>
";
      }
      print STDERR ")\n" if $verbose;
      select STDOUT;
    }
    close NS;
    exit;
  }
  
  close NS;
}

