¿Cuál es la forma correcta de matar procesos secundarios en perl antes de salir?

Question

Estoy ejecutando un Bot de IRC (Bot::BasicBot) que tiene dos procesos secundarios que ejecutan File::Tail pero al salir, no terminan. Así que los estoy usando killling Proc::ProcessTable como esto antes de salir:

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

Funciona pero me da esta advertencia:

 
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. 

¿Qué más puedo hacer para matar procesos hijos? El proceso bifurcado se crea utilizando el método forkit en Bot::BasicBot.

Script de ejemplo:

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

Estaría ocupa de por qué sus procesos secundarios no están terminando correctamente. En circunstancias "normales", el padre no debería tener que hacer nada (tal vez llame al waitpid si le importan los resultados o detiene el procesamiento hasta que terminen).

Esto no es realmente una gran respuesta aún - probablemente tenga que pegar parte del código en los niños. Pero un poco de consejo: comience con programas simples que llamen al fork de forma manual, en lugar de depender de un módulo de CPAN para que lo haga por usted. Es importante entender cómo el sistema maneja múltiples procesos. Luego, cuando lo tengas, puedes aprovechar un marco para manejar muchos procesos para ti.

Probablemente también deberías leer perldoc perlfork si no lo has hecho recientemente, y probar algunos de los ejemplos.

Answer 2

No estoy familiarizado con cualquiera de los módulos que mencionas, pero cuando he escrito se bifurcan programas Perl en ese pasado, por lo general ha sido suficiente para poner esta línea en el principal proceso padre:

$SIG{CHLD} = sub { wait }; 

De esta forma, cuando sale un proceso hijo y el proceso padre recibe una señal SIGCHLD, automáticamente recoge al niño con wait.

Answer 3

A partir de la versión 0.82, Bot::BasicBot matará los procesos secundarios pendientes (creados por forkit()) al salir.

Answer 4

Estoy desenterrando una publicación anterior, pero estaba buscando una respuesta a esta pregunta y una búsqueda en Google lo puso como el resultado principal. Entonces, en caso de que alguien más tropiece con esto, así es como lo hice.

Antes de que se bifurcan, establecer un pipe por lo que sus procesos bifurcados pueden comunicarse:

pipe PARENTRECEIVE,CHILDSEND;

Tenedor su proceso y haga que el niño envía a los padres su nuevo ID de proceso immendiately. Luego, cuando se cree que el niño está colgado (ya sea a través de un temporizador o un SIG) se puede matar el proceso hijo:

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; 
    } 
} 

A veces nuestra bloqueos del servidor web, por lo que usar esto para comprobar para ver si todavía está respondiendo a Solicitudes HTTP GET en un tiempo razonable. Si el niño no termina de agarrar la URL antes de que el temporizador de los padres esté activo, envía una alerta por correo electrónico para informar que algo está activo.