使用 open 创建孩子时杀死孩子及其孩子答案

【问题标题】：Killing child and its children when child was created using open使用 open 创建孩子时杀死孩子及其孩子
【发布时间】：2009-11-04 18:29:41
【问题描述】：

这是我的代码，为清楚起见删除了错误处理和其他内容：

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

monitor sub基本上只是等待一段指定的时间，然后尝试杀死shell脚本。

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

这会杀死脚本，但是，它不会杀死它的任何子进程。如何解决？

【问题讨论】：

我没有你的主要问题的答案，但我建议将 REAPER 设为匿名子，例如my $reaper = sub { ... }; $SIG{CHLD} = $reaper; 将命名的 sub 放入另一个 sub 并不会将其隐藏在其他范围内。在 Perl 中，所有命名的 subs 都是包符号
speculation.org/garrick/kill-9.html
好点，感谢您指出这一点

标签： perl kill children

【解决方案1】：

杀死一个进程组是可行的，但不要忘记父进程也可以单独被杀死。假设子进程有一个事件循环，它们可以检查在执行 fork() 之前在套接字对中创建的父套接字的有效性。其实select()在父socket没有了的时候就干净的退出了，需要做的就是检查socket。

例如：

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

像这样运行：

tim@mint:~$ 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
tim@mint:~$

【讨论】：

【解决方案2】：

如果您的操作系统支持，您可以对进程组执行此操作。您需要使脚本进程成为进程组组长。它运行的子进程将从其父进程继承进程组。然后，您可以使用 kill 同时向组中的每个进程发送信号。

在launch() 中，您需要将open 行替换为分叉的行。然后在孩子中，您将在执行命令之前调用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;

【讨论】：

我认为你应该否定信号编号（或名称）而不是 PID：kill '-9', $pid。

【解决方案3】：

一般来说，我认为您不能期望信号会传播到所有子进程中；这不是 perl 特有的。

也就是说，您也许可以使用 perl kill() 中内置的进程 group 信号功能：

...如果 SIGNAL 为负数，它会杀死进程组而不是进程...

您可能需要在您的（直接）子进程上使用setpgrp()，然后将您的终止调用更改为：

kill -9, $pgrp;

【讨论】：

【解决方案4】：

尝试添加：

use POSIX qw(setsid);
setsid;

在launch_and_monitor 函数的顶部。这会将您的进程置于单独的会话中，并在会话领导者（即主节点）退出时导致事物退出。

【讨论】：