#!/usr/bin/perl
use IO::Socket;	# ws - http server with mimetypes CGI GET POST
use strict;
my ($Port, $DocRoot, $CGIRoot, $CGIname) = map shift || $_,
	80, "$ENV{HOME}/doc", "$ENV{HOME}/cgi-bin", "cgi-bin";
my %mime = (jpg => "image/jpeg", jpeg => "image/jpeg", html=>
	"text/html", htm => "text/html", gif => "image/gif", @ARGV);
my ($err, $in, %env) = "HTTP/1.0 404 Not Found\nServer: ws\n" .
	"Content-Type: text/plain\n\nFile Not Found or Not Executable\n";
my $server = IO::Socket::INET->new(LocalPort => $Port, Reuse => 1,
	Listen => 9) or die "ws: $@ on server port $Port\n";
warn "ws($$): (v2.6 by Rick) ready on port @{[$server->sockport]}\n";
while($SIG{CHLD} = 'IGNORE', my $client = $server->accept) {
	fork ? (close $client, next) : close $server;
	s/\r//, $in .= $_ while $in !~ /\n\n/ and sysread $client, $_, 1;
	my ($mth, $file, $query) = $in =~ /^(GET|POST|HEAD)\s+([^ ?\n]+)
		(?:\?(\S+))?/x or die "ws: invalid HTTP header: $in";
	(print $client $err), die "ws: bad path $file\n" if $file =~ /\.\./;
	if( (my $path = $file) =~ s[^/$CGIname/][$CGIRoot/] ) {
		$_ = uc $1, y/-/_/, $env{$_} = $2 while $in =~ /^(\S+?):\s*(.*)/mg;
		%ENV = (%env, PATH => '/bin:/usr/bin', REQUEST_METHOD => $mth,
			SCRIPT_NAME => $file, SERVER_NAME => split /\n/, `hostname`);
		$ENV{QUERY_STRING} = $query if defined $query;
		open STDIN, "<&4" and open STDOUT, ">&4" or die "ws: $! on dups";
		print $client "HTTP/1.0 200 OK\nServer: ws\n" if -x $path;
		$SIG{CHLD} = close $client && $path =~ m[(.*)/(.*)] && 'DEFAULT';
		chdir $1 and exec "./$2" or (print $err), die "ws: exec: $path $!";
	}
	$file .= -r "$DocRoot$file/index.html" && "/index.html";
	(print $client "HTTP/1.0 200 OK\nContent-Type: @{[$mime{(split /\./,
		lc $file)[-1]} || 'text/plain']}\nContent-Length: @{[-s IN]}\n\n",
		<IN>), exit if -f "$DocRoot$file" and open IN, "$DocRoot$file";
	print $client $err and die "ws: not found: $DocRoot$file\n";
}