#!/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";
[download]