What's the right way to kill child processes in perl before exiting?

Question

I'm running an IRC Bot (Bot::BasicBot) which has two child processes running File::Tail but when exiting, they don't terminate. So I'm killling them using Proc::ProcessTable like this before exiting:

my $parent=$$;
my $proc_table=Proc::ProcessTable->new();
for my $proc (@{$proc_table->table()}) {
  kill(15, $proc->pid) if ($proc->ppid == $parent);
}

It works but I get this warning:

14045: !!! Child process PID:14047 reaped:
14045: !!! Child process PID:14048 reaped:
14045: !!! Your program may not be using sig_child() to reap processes.
14045: !!! In extreme cases, your program can force a system reboot
14045: !!! if this resource leakage is not corrected.

What else can I do to kill child processes? The forked process is created using the forkit method in Bot::BasicBot.

Sample script:

package main;

my $bot = SOMEBOT->new ( server => 'irc.dal.net', channels => ['#anemptychannel'] );

$SIG{'INT'} = 'Handler';
$SIG{'TERM'} = 'Handler';

sub Handler {
$bot->_stop('Leaving.');
}

$bot->run;

package SOMEBOT;

use base qw(Bot::BasicBot);
use File::Tail;
use Proc::ProcessTable;
sub irc_error_state { die if $_[10] =~ /Leaving\./; }
sub help { return; }


sub stop_state {
my $parent=$$;
my $proc_table=Proc::ProcessTable->new();
for my $proc (@{$proc_table->table()}) {
  kill(15, $proc->pid) if ($proc->ppid == $parent);
}
die;

}

sub connected {
my $self = shift;

$self->forkit (
                run     =>  \&announcer,
                body    =>  '/home/somebody/somefile.txt',
                channel =>  '#anemptychannel',
              ) unless $self->{log1};
$self->{log1} = 1;


$self->forkit (
                run     =>  \&announcer,
                body    =>  '/home/somebody/anotherfile.txt',
                channel =>  '#anemptychannel',
              ) unless $self->{log2};
$self->{log2} = 1;

}

sub announcer {
my $announcefile = shift;
my $file=File::Tail->new(name => $announcefile, maxinterval=>5, adjustafter=>7);
while (defined(my $line=$file->read)) { chomp $line; print "$line\n"; }
}

Answer 1

I'm digging up an old post, but I was looking for an answer to this question and a Google search put this as the top result. So, in case anyone else stumbles on this, here's how I did it.

Before forking, set up a pipe so your forked processes can communicate:

pipe PARENTRECEIVE,CHILDSEND;

Fork your process and have the child send the parent its new process ID immendiately. Then when you think the child is hung (either through a timer or a SIG) you can kill the child process:

my $pid = fork();
if ($pid eq 0) {
  #child block
  my $cid = $$;       
  print CHILDSEND "$cid\n";
  <do child stuff which might hang>
}
else {
  #parent block
  my $child_id = <PARENTRECEIVE>;
  chomp $child_id;
  <do parent stuff>
  <if you think child is hung> {
    kill 1, $child_id;
  }
}

Sometimes our web server hangs, so I use this to check to see if it's still responding to HTTP GET requests in a reasonable amount of time. If the child doesn't finish grabbing the URL before the parent's timer is up, it sends out an e-mail alert to say something is up.

Answer 2

I'm not familiar with any of the modules you mention, but when I've written forking Perl programs in that past, it has usually sufficed to put this line in the main parent process:

$SIG{CHLD} = sub { wait };

That way, when a child process exits and the parent process gets a SIGCHLD signal, it automatically reaps the child with wait.