require "html.pl";
require "http.pl";
package HTTP::SERVER;

$mime_header = "Content-type: text/html\r\n\r\n";

sub http_bad_request { # type, value
    my($type,$value)=@_;
    &HTML::print_head("bad $type request");
    print "<pre>$value</pre>$HTML::tail";
}

sub process_get {		# database, path
    my($database, $path) = @_;

    print $mime_header;

    my($verb,$obj,$pw) = ($path =~ m%^/([a-z]*)=([^ &]*)(&pw=.*)?$%);

    if(defined($verb) && defined $subgetverbs->{$verb}) {
	&{$subgetverbs->{$verb}}($database,$obj,$pw);
    } elsif(defined $subgetpaths->{$path}) {
	&{$subgetpaths->{$path}}($database);
    } else {
	&http_bad_request("GET",$path);
    }
}
sub process_post {		# database, path, FD
    my($database, $path, $NS) = @_;
    print $HTTP::mime_header;
    my(%content);
    my($verb,$tag,$other) = ($path =~ m%^/([a-z]*)=([^ &]*)(&.*)?$%);

    if (defined($verb) && defined $subpostverbs->{$verb}) {
	@args = &HTTP::getmimeheaders($NS);
	$line = &HTTP::getmimecontent($NS, $args[0]);
	%content = &HTTP::getpostfields($line);
	if (!&checkpassword($database,$tag,$content{"pw"})) {
	    &HTML::print_head("bad password for $verb $database/$tag");
	    print "$verb in $tag not committed\n$HTML::tail";
	} else {
	    &{$subpostverbs->{$verb}}($database,$tag,$pw,\%content);
	}
    } else {
	&http_bad_request("POST",$path);
    }
}

$servergetverbs = {
    "down" => sub {
	&HTML::print_head("server going down");
	print $HTML::tail;
	close NS; close S; exit;
    },
    "backup" => \&makebackup, # wrong args!
    "reboot" => sub { &HTML::print_head("restarting server");
	print qq{
<pre>
perl $0 @main::ORIGARGV
</pre>
$HTML::tail
};
	close NS; close S;
	exec "perl", $0, @main::ORIGARGV;
    },
}; 

sub process_server_get {
    my($path) = @_;
    print $mime_header;
    if (defined $servergetverbs->{$path}) {
	&{$servergetverbs->{$path}}();
    } else {
	&http_bad_request("toplevel GET",$path);
    }
}
$debugpostverbs = {
    "norm" => 
	sub { my $line = shift; my %content;
	      %content = &HTTP::getpostfields($line);
	      print "<ul>\n";
	      for $k (keys %content) {
		  print "<li>$k set to <pre>$content{$k}</pre>\r\n";
	      }
	      print "</ul>\n";
	  },
    "raw" => 
        sub { my $line = shift; print "Raw data: <pre>\n$line\n</pre>"; },
};

sub process_debug_post {
    my ($path) = @_;
    my (@args, $line, %content, $k);
    print $mime_header;

    if (defined $debugpostverbs->{$path}) {
	@args = &HTTP::getmimeheaders(\*NS);
	$line = &HTTP::getmimecontent(\*NS, $args[0]);
	&HTML::print_head($path);
	&{$debugpostverbs->{$path}}();
	print $HTML::tail; 
    } else {
	&http_bad_request("debug POST",$path);
    }
}

sub http_handle_unknown {
    my($NS) = @_;
    my @args;
    print $mime_header;
    &HTML::print_head("bad request");
    print "<h2>Headers:</h2><pre>$_</pre>";
    @args = &HTTP::getmimeheaders($NS);
    print $args[1];
    print "<h2>Content: (len $args[0])</h2><pre>";
    print &HTTP::getmimecontent($NS,$args[0]);
    print "</pre>".$HTML::tail;
    close $NS;
}

sub http_handle_get { 
    my($p,$NS) = @_;
    &http_handle_common($p,$NS,\&process_get, "server", \&process_server_get);
}
sub http_handle_post {
    my($p,$NS) = @_;
    &http_handle_common($p,$NS,\&process_post, "debug", \&process_debug_post);
}
sub http_handle_common {
    my($p,$NS,$type,$exception,$exceptproc) = @_;
    if ($p =~ "/${exception}=([^ ]*)") {
	&$exceptproc($1);
    } else {
	$p =~ m%/([^/]*)(/[^/]*)$%;
	if (defined($dbpaths{$1})) {
	    &$type($dbpaths{$1},$2,$NS);
	} else {
	    print $HTTP::mime_header;
	    &HTML::print_head("unknown path $p"); # should specify verb?
	    print "$1, $2\n" if ($2 ne " HTTP/1.0");
	    print "<ul>\n";
	    for (keys %dbpaths) {
		print qq{<li><a href="$_/">$_</a>\n};
	    }
	    print "</ul>\n";
	    print $HTML::tail;		    
	}
    }
}

$httpverbs = {
    "GET" => \&HTTP::SERVER::http_handle_get,
    "POST" => \&HTTP::SERVER::http_handle_post,
};

sub serverloop { # port
    my ($port) = @_;
    &NETSERVER::startlistener(\*S,$port);

    for(;;) {
	($addr = accept(NS,S)) || die $!;
	select(NS); $| = 1;
	
	# standard reply
	print $HTTP::banner;
	
	# command is first line
	$_ = <NS>;
	
	my($verb,$arg) = m%^([A-Z]*) ([^ ]*)( HTTP/1.0)??$%;
	if(defined($verb) && defined $httpverbs->{$verb}) {
	    &{$httpverbs->{$verb}}($arg,\*NS);
	    close NS;
	    next;
	} else {
	    &HTTP::SERVER::http_handle_unknown(\*NS);
	}
    }
}

1;
