70a
#!/opt/perl/bin/perl -w

use strict;
use Socket;
use POSIX qw/:sys_wait_h/;

my $EOL = "\015\012";

my $waitedpid = 0;


sub logmsg {
    print "$0 $$: @_ at ", scalar localtime, "\n";
}

sub reaper {
    my $child;
    while (($waitedpid = waitpid(-1, WNOHANG)) > 0) {
	logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
    }
}

sub spawn {
    my $pid;
    if (! defined($pid = fork)) {
	logmsg "cannot fork: $!";
	return;
    } elsif ($pid) {
	logmsg "begat $pid";
	return;
    }

    open(STDIN, "<&Client") || die "can't dup client to stdin";
    open(STDOUT, ">&Client") || die "can't dup client to stdout";
    open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
    $|=1;

    print "Hello there, it's now ", scalar localtime, $EOL, $EOL;
    $SIG{CHLD} = 'DEFAULT';
    open(PIPE, '-|', "/usr/games/fortune") or die "open: $!\n";
    while (<PIPE>) {
	s/[\015\012]+$//;
	print "$_$EOL";
    }
    close(PIPE);
    exit;
}


$SIG{CHLD} = \&reaper;

my $port = shift || 2345;
my $proto = getprotobyname('tcp');

($port) = $port =~ /^(\d+)$/ or die "invalid port\n";

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

logmsg "server started on port $port";

for ($waitedpid = 0; (my $paddr = accept(Client, Server)) || $waitedpid;
	$waitedpid = 0, close Client) {
    next if $waitedpid and not $paddr;
    my($port,$iaddr) = sockaddr_in($paddr);
    my $name = gethostbyaddr($iaddr,AF_INET);
    logmsg "connection from $name [", inet_ntoa($iaddr), "] at port $port";
    spawn;
}
.

0