#!/usr/bin/perl -w                                                                            
use strict;                                                                                   
use IO::Socket;                                                                               
use POSIX qw(:sys_wait_h);                                                                    
use Errno;                                                                                    
                                                                                              
my $waitedpid = 0;                                                                            
my $terminated_pid = 0;                                                                       

sub logmsg { print scalar localtime() . " $$: @_\n" }

sub REAPER {
        local $!;
        while (($waitedpid = waitpid(-1,WNOHANG)) > 0 && WIFEXITED($?)) {
                $terminated_pid = $waitedpid;                            
                logmsg "Parent: Reaped $waitedpid" . ($? ? " with exit $?" : '');
        }
        $SIG{'CHLD'} = \&REAPER;
}
$SIG{'CHLD'} = \&REAPER;

my $sock = new IO::Socket::INET(
                   LocalHost => '127.0.0.1',
                   LocalPort => 9898,
                   Proto     => 'tcp',
                   Listen    => 10,
                   ReuseAddr     => 1
                                   );
$sock or die "no socket :$!";

logmsg "Parent $$: Server up";
STDERR->autoflush(1);
STDOUT->autoflush(1);

while (1) {
        my $new_sock = $sock->accept()  || do {
        # try again if accept() returned because a signal was received
                next if $!{EINTR};
                die "accept: $!";
        };

        $new_sock->autoflush(1);
        my($buf, $kid);
        if ($kid = fork) {

                # parent closes the client since
                # it is not needed
                logmsg "Parent after forking";
        }
        else {
                die "fork: $!" unless defined $kid;

                # child now...
                logmsg "Child: started";

                # read from client
                $buf = <$new_sock>;
                chomp $buf;
                logmsg "Child: Read from client: $buf";
                my $secs = int(rand(srand())*10)+1;
                sleep $secs;
                print $new_sock "READY\n";
                logmsg "Child sent READY, closing";
                $new_sock->close;
                exit 0;
        }
}

logmsg "Parent: Should never get here";