perl 5.6 to perl 5.8 and signal handling

Tue, 15 Jul 2003 06:38:04 -0700

Hi all,

i have a question regarding the switch from perl 5.6 to perl 5.8 and the
usage of fork and signal handlers.

I have written a script (on a debian linux (sid) box, perl 5.6.1)
that is using fork and a signal handler (if a CHLD signal received some cleanup function is called).
After updating to perl 5.8 this script is not longer working as before.

Bevor the switch:

client connects to server (i.e. my perl script)
server forks
forked process is handling the client request
client closes connection (forked process exits --> signal handler performs cleanup)
server is still up and running listening for requests.

After the switch:

client connects to server (i.e. my perl script)
server forks
forked process is handling the client request
client closes connection (forked process exits --> signal handler performs cleanup)
server is terminating !

I have read that there was a change of the perl fork implementation from 5.6 to 5.8.
Could someone give me a hint how to fix the problem ?

Included the code of a small test app, build like my server script and same problem.
THX in advance for you help

mikle

-- snip --

#!/usr/bin/perl
#

use strict;
use POSIX ":sys_wait_h";       # needed for non blocking wait
use IO::Socket;
use Net::hostent;              # for OO version of gethostbyaddr

my $PORT = 9000;                  # pick something not in use
my $client;

my %CLIENT_PIDS = undef;

$SIG{CHLD} = \&REAPER; # for babysitting we do some signal handling

my $server = IO::Socket::INET->new( Proto     => 'tcp',
                                         LocalPort => $PORT,
                                    Listen    => SOMAXCONN,
                                    Reuse     => 1);
while($client = $server->accept())
{
 spawn(\&function,"hi child");
}

#
# Subs
#

sub main_loop
{
 while(1)
 {
  spawn(\&function,"hi child");
  sleep(3);
 }
}

sub spawn
{
 my $coderef = shift @_;
 my $param_for_child = shift @_;

 unless (@_ == 0 &&
         $coderef &&
         ref($coderef) eq 'CODE') {
         die "usage: spawn CODEREF";
       }
 my $pid;

 if(!defined($pid = fork)) {
   logerr("cannot fork:$!");
   return undef;
 } elsif ($pid) {
   print "(spawn parent) --> $pid\n";

$CLIENT_PIDS{$pid} = $param_for_child;
return $pid; # i am the parent
}
# i am the child
print "(spawn child) spawn client: info from parent --> $param_for_child\n";

 exit &$coderef(); # after perl 5.8
}

sub function
{
$server->close();
while ( <$client>) {
 next unless /\S/;       # blank line
 if    (/quit|exit/i)    { close $client; POSIX:_exit(1); }
 elsif (/date|time/i)    { printf $client "%s\n", scalar localtime; }
 elsif (/who/i )         { print  $client `who 2>&1`; }
 elsif (/cookie/i )      { print  $client `/usr/games/fortune 2>&1`; }
 elsif (/motd/i )        { print  $client `cat /etc/motd 2>&1`; }
                
 else {
     print $client "Commands: quit date who cookie motd\n";
       }
 } continue {
 print $client "Command? ";}
}

sub REAPER{

#$SIG{CHLD} = \&REAPER;

my $waitedpid = waitpid(-1,&WNOHANG);

# remove client from list

if(defined($CLIENT_PIDS{$waitedpid}))
{
  $CLIENT_PIDS{$waitedpid} = undef;

 print "(REAPER) removed child $waitedpid from client list\n";
}

print "(REAPER) reaped $waitedpid";
print "(REAPER) satus $?";
}


-- snip --



--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]

Reply via email to