Signal handling problem

gnu@perl has asked for the wisdom of the Perl Monks concerning the following question:

I have a pre-forking program in which I wish to send a signal to the child processes and have them exit gracefully. Below is the relavent code snippet.

The problem I am having is that if the child process is currently in a 'ping' process and I send the USR1 signal the processes just hangs and never ends. CTRL-C ($SIG{INTR} & $SIG{TERM}) in the parent are both directed to a sub routine to kill the child processes. If I press CTRL-C a second time I get errors. The subs that kill the children, the child process and the errors are below.

Can anyone let me know what I am doing wrong here?

TIA, Chad.

Following are the errors I get when I press CTRL-C the second time:

9
11
IN CHILD 17116 PINGING 207.59.97.99
12
^CPlease wait, stopping child processes
Child 17116 in SIGNAL
^CPlease wait, stopping child processes
Child 17116 in SIGNAL
Use of uninitialized value in subroutine entry at /usr/local/lib/perl5
+/5.8.0/sun4-solaris/Socket.pm line 370.
13
14
15
16
17
    INSERTING '207.59.97.99' at '1065125651'
18
19
20
21
1
Child 17116 received shutdown
Attempt to free unreferenced scalar.
[download]

Here's the subs that kill the children:

sub kill_child
{
    print "Please wait, stopping child processes\n";
    kill USR1 => keys(%child_pids);
    sleep while (%child_pids);
}

sub reap_child
{
    while ( (my $child = waitpid(-1,&WNOHANG)) > 0 ) {
        delete $child_pids{$child};
    }
}
[download]

Here's the child process

sub ping_child
{
  use Net::Ping;
  my $SHUTDOWN = 0;
    my $sigset = POSIX::SigSet->new(SIGINT,SIGTERM);
    my $old_sigset = POSIX::SigSet->new;
    my ($sockpath, $dsn,
        $host,$user, $pass) = (@_);
    my $clientSocket = IO::Socket::UNIX->new($sockpath);
       sigprocmask(SIG_BLOCK,$sigset);
       $SIG{USR1} = sub{ print "Child $$ in SIGNAL\n"; $SHUTDOWN++ ; }
+;
    my $ping         = Net::Ping->new('icmp',5);
    my $buffer;
    my $db_handle = DBI->connect($dsn,$user,$pass,{RaiseError => 1, Au
+toCommit => 1})
       or die "Could not connect to database. $DBI::errstr\n";

    until (defined($clientSocket))
    {
        ssleep(.250);
        $clientSocket = IO::Socket::UNIX->new($sockpath);
    }
    $clientSocket->autoflush(1);
    while (1)
    {
print "1\n";
        if ($SHUTDOWN) { print "Child $$ received shutdown\n";exit 0};
print "2\n";
        syswrite($clientSocket,"req");
print "3\n";
        my $bytes_read = 0;
print "4\n";
        my $tmpval;
print "5\n";
           if ($SHUTDOWN) { print "Child $$ received shutdown\n";exit 
+0};
print "6\n";
           $bytes_read = sysread($clientSocket,$buffer,8192);
print "7\n";
             chomp($buffer);
print "8\n";
             $tmpval = $buffer;
print "9\n";

        if ($buffer eq "TRY_AGAIN")
        {
print "10\n";
            print "CHILD $$ TRYING AGAIN\n";
            next;
        }
print "11\n";
        print "IN CHILD $$ PINGING $tmpval\n";
print "12\n";
        my $pingresult = $ping->ping($tmpval);
print "13\n";

        if ( (! defined($pingresult)) or (!$pingresult) )
        {
print "14\n";
           my $EPOCH_TIME = time();
print "15\n";
           my $sth = $db_handle->prepare("INSERT INTO FAILURES".
                                   " VALUES(\'$tmpval\',\'$EPOCH_TIME\
+')");
print "16\n";
              die "\$sth error: $!\n" if (! $sth);
print "17\n";
              print "    INSERTING \'$tmpval\' at \'$EPOCH_TIME\'\n";
print "18\n";
           my $return = $sth->execute;
print "19\n";
              die "\$return error: $!\n" if (! $return);
print "20\n";
        }
print "21\n";
    }
    $db_handle->disconnect();
}
[download]

Comment on Signal handling problem Select or Download Code

Replies are listed 'Best First'.
Re: Signal handling problem by sandfly (Beadle) on Oct 02, 2003 at 20:57 UTC
I can't see exactly what the problem is. Is it possible the SIGCHLD is not breaking you out of the sleep? It must boil down to one of three things: 1. Your child process isn't dying 2. The child process dies, but the parent isn't reaping it. 3. The child process dies, the parent reaps it, but %child_pids is not clear I suggest you find out which, using ps, or similar. Most likely it's 2 or 3. Put print statements into the reaping sub; also, change the parent's sleep to sleep 1, and print the %child_pids hash every time round the while loop.	[reply]
Re: Re: Signal handling problem by gnu@perl (Pilgrim) on Oct 02, 2003 at 21:23 UTC
Been there, but thanks for your help. I think I found out what it was. For some reason, even though I had blocked them, some of the signals were getting through to the child processes and it was acting on them as well. What I did was to assign all the $SIG{XXX} = 'DEFAULT' then reassign what I wanted in the child and it seems to work now. This isn't a permanent fix, but it will do until I have more time to track it down.	[reply]
Re: Signal handling problem by Aristotle (Chancellor) on Oct 02, 2003 at 19:38 UTC
`sleep while (%child_pids);` [download] But you never do anything that would clear the `%child_pids` hash. Makeshifts last the longest.	[reply] [d/l]
Re: Re: Signal handling problem by gnu@perl (Pilgrim) on Oct 02, 2003 at 19:47 UTC
I actually do that, I forgot and left that line out, it is further up in the code, sorry. I do clear the hash, the reap_child sub is called by the $SIG{CHLD}= \&reap_child signal, this sub reaps the child with 'waitpid' and removes the pid from the hash.	[reply]


Syntactic Confectionery Delight
	PerlMonks