#!/usr/bin/perl
# -*- perl -*-

#
# $Id: runbbbikecgi,v 1.13 2005/03/10 00:07:53 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 2000 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: eserte@cs.tu-berlin.de
# WWW:  http://user.cs.tu-berlin.de/~eserte/
#

# Startet httpi, Netscape und bbbike.cgi

use strict;

BEGIN {
    eval <<'EOF';
use FindBin;
use lib "$FindBin::RealBin/../lib";
EOF
    if ($@) {
	eval <<'EOF';
	use lib "../lib";
	$FindBin::RealBin = ".";
EOF
    }
}
use WWWBrowser 2.14;

my $http_server = "tinyhttpd";
my $v = 0;
my $httpi_port;
my $start_browser = 1;

if (eval "require Getopt::Long; 1") {
    if (!Getopt::Long::GetOptions("servertype=s" => \$http_server,
				  "v+" => \$v,
				  "p|port=i" => \$httpi_port,
				  "browser!" => \$start_browser,
				 )) {
	die "usage: $0 [-servertype httpi|tinyhttpd|HTTP::Daemon] [-port port] [-v] [-nobrowser]";
    }
}

if ($http_server eq 'httpi') {
    $httpi_port = "22295" # "BBBI(K)E"
	unless defined $httpi_port;
} elsif ($http_server eq 'minisvr') {
    # no port
    # XXX not supported anymore...
} elsif ($http_server eq 'HTTP::Daemon') {
    $httpi_port = "22297" unless defined $httpi_port;
} else {
    $httpi_port = "22296" unless defined $httpi_port;
    $http_server = 'tinyhttpd';
}

# XXX mit pid_files arbeiten...
#  my $pid_file;
#  my $tmpdir = tmpdir();
#  if ($tmpdir) {
#      $pid_file = "$tmpdir/runbbbikecgi.pid";
#  }

# XXX erlaubte Ports testen...

if ($http_server eq 'httpi') {
    # alten httpi-Prozess killen
    # XXX ist noch zu betriebssystemabhängig
    if ($^O ne 'MSWin32') {
	my $pid = `ps uagxww | grep "dhttpi.*$httpi_port" | grep -v grep | perl -nale 'print \$F[1]'`;
	if (defined $pid and $pid ne "") {
	    warn "Killing old httpi server...\n";
	    kill 9 => $pid;
	}
    }

    # neuen Server starten
    my @httpi_cmd = "$FindBin::RealBin/httpi";
    unshift @httpi_cmd, (1, $^X) if $^O eq 'MSWin32';
    system(@httpi_cmd);

} elsif ($http_server eq 'minisvr') {
    open(START, "env SERVER_NAME=localhost QUERY_STRING= REQUEST_METHOD=GET SCRIPT_NAME=/~eserte/bbbike/cgi/bbbike-fast.cgi ./bbbike-fast.cgi |");
    while(<START>) {
	if (m|http://localhost:(\d+)/~eserte/bbbike/cgi/bbbike-fast.cgi|) {
	    $httpi_port = $1;
	    last;
	}
    }
    close START;
    die "Can't get port ..." if !defined $httpi_port;

} elsif ($http_server eq 'HTTP::Daemon') {
    start_http_daemon();

} else { # tinyhttpd
    # XXX alten Prozess killen?
    # XXX ist noch zu betriebssystemabhängig
    my $pid_file = tmpdir() . "/.runbbbikecgi.pid";
    warn "Pid file is $pid_file.\n" if $v;
    if ($^O ne 'MSWin32') {
	if (open(PID, $pid_file)) {
	    chomp(my $pid = <PID>);
	    close PID;
	    if (defined $pid) {
		warn "Kill process id $pid...\n";
		kill 9 => $pid;
	    }
	    unlink $pid_file;
	}
	my $pid = `ps uagxww | grep "perl.*tinyhttpd" | grep -v grep | $^X -nale 'print \$F[1]'`;
	if (defined $pid and $pid ne "") {
	    warn "There is still an old tinyhttpd server (pid $pid)...\n";
	}
    }

    # neuen Server starten
    my @httpi_cmd = ($^X, "$FindBin::RealBin/tinyhttpd");
    unshift @httpi_cmd, (1) if $^O eq 'MSWin32';
    if ($^O eq 'MSWin32') {
	system(@httpi_cmd);
    } else {
	my $pid = fork;
	if ($pid == 0) {
	    exec @httpi_cmd or die "Can't start @httpi_cmd: $!";
	}
	if (open(PID, ">" . $pid_file)) {
	    print PID $pid, "\n";
	    close PID;
	}
    }
    warn "Started @httpi_cmd\n" if $v;
}

# XXX pid des Server merken und für kill verwenden

# kleine Verzögerung, da httpi/tinyhttpdi vielleicht noch nicht
# geladen wurde... (XXX vielleicht besser überprüfen, ob error_log
# geschrieben wurde)

sleep 1;

my $url = "http://localhost:$httpi_port/bbbike/cgi/bbbike.cgi";
if ($start_browser) {
    warn "About to load $url in browser...\n" if $v;
			  
    WWWBrowser::start_browser($url, -oldwindow => 1);
} else {
    print STDERR "Point your browser to $url\n";
}


sub start_http_daemon {
    require File::Spec;
    $HTTP::Daemon::DEBUG = 10 if $v >= 3;
    require HTTP::Daemon;
    require HTTP::Status;
    require HTTP::Response;
    require IPC::Open2;
    require POSIX;

    if ($^O ne 'MSWin32') {
	my @pid = `ps uagxww | grep "runbbbikecgi.*HTTP::Daemon" | grep -v grep | perl -nale 'print \$F[1]'`;
	for my $pid (@pid) {
	    next if $pid == $$;
	    warn "Killing old HTTP::Daemon server with pid $pid...\n";
	    kill 9 => $pid;
	}
    }

    chdir "/" or die $!;
    open STDIN, "< ". File::Spec->devnull or die $!;
    open STDOUT, "> ". File::Spec->devnull or die $!;

    $ENV{SERVER_NAME} = "localhost";
    $ENV{SERVER_PORT} = $httpi_port;

    if (fork == 0) {
	POSIX::setsid();
	my $d = HTTP::Daemon->new(LocalPort => $httpi_port)|| die;
	while (my $c = $d->accept) {
	    warn "Accepted connection $c\n" if $v >= 2;
	    if (fork == 0) {
		warn "forked" if $v >= 3;
		while (my $r = $c->get_request) {
		    my $path = $r->url->path;
		    if ($v >= 2) {
			warn $r->method . " " . $path . "\n";
		    }
		    if ($r->method =~ m{GET|POST}) { # XXX no HEAD support
			if ($path =~ m{(^|/)..(/|$)}) {
			    print STDERR ".. in path is forbidden\n";
			    $c->send_error(HTTP::Status::RC_FORBIDDEN());
			}
			if ($path =~ m{^/bbbike/cgi/(.*\.cgi)$}) {
			    my $prog = $1;
			    $ENV{SCRIPT_FILENAME} = "$FindBin::RealBin/$prog";
			    $ENV{SCRIPT_NAME} = $path;
			    $ENV{REQUEST_METHOD} = $r->method;
			    $ENV{HTTP_USER_AGENT} = $r->header("user-agent");
			    my @args;
			    if ($r->method =~ /^(HEAD|GET)$/) {
				$ENV{QUERY_STRING} = $r->uri->query;
				@args = $r->uri->query_form;
			    } elsif ($r->method eq 'POST') {
				warn "POST not yet implemented";
			    }
			    if ($v >= 3) {
				require Data::Dumper;
				warn Data::Dumper->new([\@args],[qw()])->Indent(1)->Useqq(1)->Dump, "\n";
			    }

# 			    open(FH, "-|") or do {
# 				$c->close; # XXX???
# 				$d->close;
# 				exec "$FindBin::RealBin/$prog";
# 				die $!;
# 			    };
#			    binmode FH;
			    #open(OUT, ">/tmp/bla.html") or die $!;
#			    print OUT <FH>;
			    #print OUT
			    my $out = "200 OK\015\012";
			    open(FH, "-|") or do {
				exec $ENV{SCRIPT_FILENAME}, @args;
				die "Cannot execute $ENV{SCRIPT_FILENAME}: $!";
			    };
			    local $/ = undef;
			    $out .= <FH>;
			    close FH;
			    if ($!) {
				warn "Cannot execute $ENV{SCRIPT_FILENAME}: $!";
				$c->send_error(500);
			    } else {
				
				#close OUT;
				#$c->send_file_response("/tmp/bla.html");
				my $res = HTTP::Response->parse($out);
				$c->send_response($res);
			    
# 			    $c->send_basic_header(200, "OK", "HTTP/1.0");
# 			    $c->send_file(\*FH);
#			    close FH;
			    }
			} elsif ($path =~ m{^/bbbike/(.*)}) {
			    $c->send_file_response("$FindBin::RealBin/../$1");
			} else {
			    print STDERR "Path $path is forbidden\n";
			    $c->send_error(HTTP::Status::RC_FORBIDDEN())
			}
		    } else {
			print STDERR "Method " . $r->method . " is forbidden\n";
			$c->send_error(HTTP::Status::RC_FORBIDDEN())
		    }
		}
		$c->close;
		exit;
	    } else {
		$c->close;
	    }
	    undef($c);
	}
	exit 0;
    }
}

# REPO BEGIN
# REPO NAME tmpdir /home/e/eserte/src/repository 
# REPO MD5 66f13045a8970a4545d814cccd9be848
=head2 tmpdir()

Return temporary directory for this system.

=cut

sub tmpdir {
    foreach my $d ($ENV{TMPDIR}, $ENV{TEMP},
		   "/tmp", "/var/tmp", "/usr/tmp", "/temp") {
	next if !defined $d;
	next if !-d $d || !-w $d;
	return $d;
    }
    undef;
}
# REPO END

__END__