#!/usr/local/bin/perl5 -Tw

use strict;
BEGIN { $ENV{'PATH'} = '/usr/ucb:/usr/bin' }
use vars qw($opt_p $opt_f $opt_l $opt_t $opt_u $opt_h);
use vars qw($VERSION $SERVER $PORT $MAX_FORK $MAX_LENGTH $TIMEOUT $USER);
use vars qw(%HTTP_STATUS $NCHLD);
use vars qw($pid $waitedpid);
use vars qw(*S *NS);

use Socket;
use FileHandle;
use Getopt::Std;
getopts('p:f:l:t:u:h');
&usage if $opt_h;

$VERSION = "HTTP/1.1";
$SERVER = "Echo-Httpd/1.1";
$PORT = $opt_p || 8080;
$MAX_FORK = $opt_f || 100;
$MAX_LENGTH = $opt_l || 1000;
$TIMEOUT = $opt_t || 60;
$USER = $opt_u || "nobody";
$SIG{'CHLD'} = \&reapchild;
$SIG{'ALRM'} = \&timeout;
%HTTP_STATUS = (
                200 => "OK",
                408 => "Request Timeout",
                413 => "Request Entity Too Large",
                499 => "Request Ignored",
                );

($<,$() = ($>,$)) = (getpwnam($USER))[2,3];
if(($pid = fork) > 0) { # turn into daemon mode
    exit(0);
} elsif ($pid == -1) {
    die "cannot fork: $!";
}
setpgrp(0,$$);
&waitmsg(\&sendmsg);
exit(1);

########

sub waitmsg {
    my($coderef,$argref) = @_;
    my($name,$aliases,$proto) = getprotobyname('tcp');
    my($port) = ($PORT =~ /^\d+$/) ? $PORT : getservbyport($PORT, 'tcp');
    print "$SERVER Daemon started at port $port..\n";

    socket(S, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";
    setsockopt(S, SOL_SOCKET, SO_REUSEADDR, pack("l",1))
        or die "setsockopt: $!";
    bind(S, sockaddr_in($port, INADDR_ANY)) or die "bind: $!";
    listen(S, SOMAXCONN) or die "listen: $!";

    my($paddr);
    for($waitedpid = 0;
        ($paddr = accept(NS,S)) || $waitedpid;
        $waitedpid = 0, close(NS)) {
#        next if $waitedpid;

        my($port,$iaddr) = sockaddr_in($paddr);
        my($name) = gethostbyaddr($iaddr, AF_INET);
        my($pid);
      FORK: {
          if (($pid = fork) == 0) {
              open(STDIN, "<&NS") or die "cannot dup NS to STDIN";
              open(STDOUT, ">&NS") or die "cannot dup NS to STDOUT";
              STDOUT->autoflush();
              alarm($TIMEOUT);
              exit(&$coderef(@$argref));
          } elsif ($pid < 0) { # retry when fail
              sleep 1;
              next FORK;
          }
          $NCHLD++;
      }
        while ($NCHLD > $MAX_FORK) {
            sleep 1;
        }
    }
}

sub reapchild {
    $SIG{'CHLD'} = \&reapchild;
    $waitedpid = wait;
    $NCHLD--;
}

sub timeout {
    my($code);
    &put_response($code=408);
    exit($code);
}

sub sendmsg {
    my($rbyte,$fragmsg,$msg,$msglen,$code,@msg);
    my($crlf) = '\r?\n';
    while($rbyte = sysread(NS,$fragmsg,$MAX_LENGTH)) {
        $msglen += $rbyte;
        if($msglen > $MAX_LENGTH) {
            &put_response($code=413);
            return($code);
        }
        $msg .= $fragmsg;
        last if $msg =~ s/($crlf)$crlf.*$/$1/;
    }
    if($msg =~ m|^\s*GET\s/|i) {
        @msg = split(/$crlf/, $msg);
        &put_response($code=200,@msg);
        return(0);
    } else {
        &put_response($code=499);
        return($code);
    }
}

sub put_response {
    my($code,@msg) = @_;
    my($clen,$date,@response,@ctag);
    my($crlf) = "\r\n";
    $clen = length(join($crlf,@msg));
    $date = &get_date;
    push(@ctag, "Content-Type: text/plain",
                sprintf("Contenet-Length: %d", $clen - $#msg + 1),
                "Last-Modified: $date") if $clen;
    @response =
        ("$VERSION $code $HTTP_STATUS{$code}",
         "Date: $date",
         "Server: $SERVER",
         @ctag,
         "ETag: ",
         "");
    push(@response,@msg) if @msg;
    print NS join($crlf,@response).$crlf;
}

sub get_date {
    my(@ltime) = localtime;
    sprintf("%s, %02d %s %04d %02d:%02d:%02d JST",
            ('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[$ltime[6]],
            $ltime[3],
            ('Jan','Feb','Mar','Apr','May','Jun',
             'Jul','Aug','Sep','Oct','Nov','Dec')[$ltime[4]],
            $ltime[5]+1900, reverse @ltime[0..2]);
}

sub usage {
    $0 =~ m|([^/]+)$|;
    print <<EOM;
Usage: $1 [-p #port] [-f #maxfork] [-l #maxlength]
           [-t #timeout] [-u username]

EOM
    exit(0);
}