开发者

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

I'm running an IRC Bot (Bot::BasicBot) which has two child processes runni开发者_如何学Gong 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"; }
}


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.


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.


I'd be concerned with why your child processes are not terminating properly. Under "normal" circumstances, the parent shouldn't have to do anything (perhaps call waitpid if you care about the results, or halting processing until they are done).

This isn't really much of an answer yet -- you'll probably have to paste some of the code in the children. But a bit of advice -- start off with simple programs that call fork manually, rather than relying on a CPAN module to do it for you. It's important to understand how multiple processes are handled by the system. Then when you've got that, you can leverage some framework to handle a lot of processes for you.

You should probably also read through perldoc perlfork if you have not done so recently, and try out some of the examples.


As of version 0.82, Bot::BasicBot will kill outstanding child processes (created by forkit()) when exiting.


Fork will return the process ID of the child in the parent block.

In response to the answer from Mintx, no pipe is necessary.

my $pid = fork();
if ($pid == 0) {
  #child block
  <do child stuff which might hang>
}
else {
  #parent block
  <do parent stuff>
  <if you think child is hung> {
    kill 1, $child_id;
  }
}
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜