在Perl中，杀害儿童和它的孩子孩子使用开放创建时

Question

这里是我的代码，错误处理和其他的东西为清楚起见移除：

sub launch_and_monitor { 

    my ($script, $timeout) = @_; 

    sub REAPER { 
     while ((my $child = waitpid(-1, &WNOHANG)) > 0) {} 
     $SIG{CHLD} = \&REAPER; 
    } 
    $SIG{CHLD} = \&REAPER; 

    my $pid = fork; 
    if (defined $pid) { 
     if ($pid == 0) { 
      # in child 
      monitor($timeout); 
     } 
     else { 
      launch($script); 
     } 
    } 
} 

推出子执行shell脚本，启动其他过程，像这样：

sub launch($) { 

    my ($script) = @_; 

    my $pid = open(PIPE, "$script|"); 

    # write pid to pidfile 

    if ($pid != 0) { 
     while(<PIPE>) { 
      # do stuff with output 
     } 
     close(PIPE) or die $!; 
    } 
} 

监视器子基本上只是等待指定的时间周期，然后尝试杀外壳脚本。

sub monitor($) { 

    my ($timeout) = @_; 

    sleep $timeout; 

    # check if script is still running and if so get pid from pidfile 
    if (...) { 
     my $pid = getpid(...);   
     kill 9, $pid; 
    } 
} 

这会杀死脚本，但是它不会杀死它的任何子进程。怎么修？

Answer 1

你可以用进程组做到这一点，如果您的操作系统支持他们。你需要使脚本程序成为进程组创建者。子进程，这将运行从其父继承进程组。然后，可以使用杀来的信号在同一时间发送到每个进程在一组。

在launch()中，您需要将open行替换为分叉。然后在孩子，你会exec'ing命令之前调用setpgrp()。像下面这样的东西应该工作：

my $pid = open(PIPE, "-|"); 
if (0 == $pid) { 
    setpgrp(0, 0); 
    exec $script; 
    die "exec failed: $!\n"; 
} 
else { 
    while(<PIPE>) { 
     # do stuff with output 
    } 
    close(PIPE) or die $!; 
} 

后来，杀死脚本进程和它的孩子，否定，你信令进程ID：

kill 9, -$pid; 

Answer 2

一般来说，我不认为你可以期望信号传播到所有的子进程;这不是特定于perl的。

这就是说，你可能能够使用组信号的功能内置到perl的kill()过程：

...如果信号为负，它杀死进程组，而不是流程...

你可能需要在你的（直接）子过程中使用setpgrp()，然后改变你杀调用是这样的：

kill -9, $pgrp; 

Answer 3

尝试增加：

use POSIX qw(setsid); 
setsid; 

你launch_and_monitor函数的顶部。这将使你的流程在一个单独的会话，并导致东西离开时，会议领导（即主）退出。

Answer 4

杀灭processgroup作品，但不要” t忘记父母也可以单独被杀害。假设子进程有一个事件循环，他们可以在执行fork（）以验证有效性之前检查在套接字对中创建的父套接字。事实上，当父套接字不存在时，select（）干净地退出，所有需要做的就是检查套接字。

E.g.：

use strict; use warnings; 
use Socket; 

$SIG{CHLD} = sub {}; 

socketpair(my $p, my $c, AF_UNIX, SOCK_STREAM, PF_UNSPEC) or die $!; 

print "parent $$, fork 2 kids\n"; 
for (0..1){ 
    my $kid = fork(); 
    unless($kid){ 
     child_loop($p, $c); 
     exit; 
    } 
    print "parent $$, forked kid $kid\n"; 
} 

print "parent $$, waiting 5s\n"; 
sleep 5; 
print "parent $$ exit, closing sockets\n"; 

sub child_loop { 
    my ($p_s, $c_s) = @_; 
    print "kid: $$\n"; 
    close($c_s); 
    my $rin = ''; 
    vec($rin, fileno($p_s), 1) = 1; 
    while(1){ 
     select my $rout = $rin, undef, undef, undef; 
     if(vec($rout, fileno($p_s), 1)){ 
      print "kid: $$, parent gone, exiting\n"; 
      last; 
     } 
    } 
} 

运行像这样：

[email protected]:~$ perl ~/abc.pl 
parent 5638, fork 2 kids 
parent 5638, forked kid 5639 
kid: 5639 
parent 5638, forked kid 5640 
parent 5638, waiting 5s 
kid: 5640 
parent 5638 exit, closing sockets 
kid: 5640, parent gone, exiting 
kid: 5639, parent gone, exiting 
[email protected]:~$