#! /usr/bin/perl
# Copyright 1994-2000, Cunningham & Cunningham, Inc.
# Open Source for personal use only.
# ... and then only
# with the understanding that the owner(s) cannot be
# responsible for any behavior of the program or
# any damages that it may cause. See LICENSE.TXT
#@INC = ('D:\Perl\Lib', '.');

use Socket;
use Carp;

($port) = @ARGV;
$port = 80 unless $port;
$| = 1;
print "running on port $port\n";

$WNOHANG = 1;  # require "sys/wait.h"
$AF_INET = 2;
$SOCK_STREAM = 1;
$sockaddr = 'S n a4 x8';

($name, $aliases , $proto ) = getprotobyname ('tcp');
$this = pack($sockaddr, $AF_INET, $port, "\0\0\0\0");
##select(NS); $| = 1;
socket(S, $AF_INET, $SOCK_STREAM, $proto) || die "socket: $!";
setsockopt(S, SOL_SOCKET, SO_REUSEADDR,
           pack("l", 1))   || die "setsockopt: $!";
bind(S,sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
# was $this
listen(S,5) || die "connect: $!";
select(S); $| = 1; 
select(NS);

for($con = 1; ; $con++) {
	($addr = accept(NS,S)) || die "accept: $!";
#	if (($child = fork()) == O) {
		&service();
#		exit;
#	}
#	close(NS);
#	waitpid(-1, $WNOHANG);
#	waitpid(-1, $WNOHANG);
}

sub service {
	($af,$port,$inetaddr) = unpack($sockaddr,$addr);
	@inetaddr = unpack('C4',$inetaddr);
	$inetaddr = join('.', @inetaddr);

	local (%head, %body, $query);
	$request = <NS>;
	($method, $file, $protocol) = $request =~ /^(\S*) \/(\S*) (\S*)/;
	%head = ();
	while(<NS>) {
		s/\r|\n//g;
		last unless /\S/;
		$head{"\L$1"}=$2 if /^(\S*): (.*)/;
	}

	$file =~ s/\%(..)/pack(C, hex($1))/geo;
	print STDOUT "$con: $inetaddr $method $file\n";
	($file, $query) = ($`, $') if $file =~ /\?/;
	$file = "wiki.cgi" unless $file;
	$file =~ /\.cgi$/
		? &invoke()
		: &copy();
	close(NS);
}

sub index {
	$file =~ s/\/$//;
	opendir(D, $file);
	print NS 
		"<h1>$file/</h1><ul>\n",
		map("<li><a href=$file/$_>$_</a>\n", readdir(D)),
		"</ul>\n";
	closedir(D);
}
		

sub invoke {
	local (%ENV);
	$ENV{REQUEST_METHOD} = $method;
	$ENV{QUERY_STRING} = $query if $query;
	$ENV{CONTENT_LENGTH} = $head{'content-length'} if $head{'content-length'};
	$ENV{HTTP_REFERER} = $head{'referer'} if $head{'referer'} ;
#	$ENV{REMOTE_USER} = '';
	$ENV{SERVER_SOFTWARE} = 'Quicki';  # used later in save.cgi
	print NS "HTTP/1.0 200\r\n";
	do $file;
	$/ = "\n";  # failsafe restore of EOL
	print NS join('<br>', split("\n",$@)) if $@;
	# see p139 for more ideas
}

sub copy {
	open(F, $file);
	binmode F;
	copy: while ($len = sysread(F, $buf, 10240)) {
		if (!defined $len) {
			next if $! =~ /^Interrupted/;
			last copy;
		}
		$offset = 0;
		while ($len) {	# Handle partial writes.
			$written = syswrite(NS, $buf, $len, $offset);
			last copy unless defined $written;
			$len -= $written;
			$offset += $written;
		}
	}
	close(F);
}