Perl 将 SIGINT 转发给分叉的子进程

Question

所以我正在尝试创建一个 Perl 程序，该程序分叉一个工作程序并等待它完成。在我的真实用例中，我需要 fork 很多 worker 并等待他们全部，所以我想我会用一个 worker 来尝试一个测试用例。我在这里担心的是，当我在终端中运行这个程序时，发送 ^C 不会杀死父进程，即使信号处理程序看起来应该获取子进程并导致父进程正常退出。我正在尝试使用 waitpid 让父进程保持活动状态，以便它可以接收信号并将它们传递给子进程，但父进程似乎完全忽略了 ^C。

use strict;
use warnings FATAL => 'all';
use POSIX ":sys_wait_h";

my $cpid;

sub reap_children_and_exit {
    defined $cpid and kill 'HUP', $cpid;
    exit 0;
}

$SIG{INT} = \&reap_children_and_exit;

my $child_text = <<'EOF';
perl -e 'while (1) { printf "%s\n", rand() }'
EOF

$cpid = fork;
if ($cpid == 0) {
    exec($child_text)
}

waitpid($cpid, WNOHANG);

Answer 1

I am trying to use waitpid to keep the parent alive

您立即告诉 waitpid 给 return。将 WNOHANG 更改为 0。

Answer 2

如果不需要全部自己实现，可以使用模块，我推荐：https://metacpan.org/pod/Parallel::Prefork 该模块为您轻松包装了所有 worker/children 创建和管理，此外，它还节省了内存使用量。

如果您打算创建一个守护进程，还有另一个可以管理分叉的守护进程：https://metacpan.org/pod/Daemon::Control

或者试试这个解决方案：

use strict;
use warnings FATAL => 'all';
use feature 'say';
use POSIX ":sys_wait_h";

BEGIN {
    sub reap_children_and_exit {
        my $signame = shift;
        my $pid = shift;
        defined $pid and kill $signame, $pid;
        say "$pid => Received '$signame' !";
        exit 0;
    }
    $SIG{INT} = \&reap_children_and_exit;
}

my %children;

$SIG{CHLD} = sub {
    # don't change $! and $? outside handler
    local ($!, $?);
    while ( (my $pid = waitpid(-1, WNOHANG)) > 0 ) {
        delete $children{$pid};
        reap_children_and_exit('HUP', $pid);
    }
};

my $child_text = <<'EOF';
perl -e 'while (1) { printf "%s\n", rand(); sleep 1; }'
EOF

while (1) {
    my $pid = fork();
    die "Cannot fork" unless defined $pid;
    say "I'm the PID $pid";
    if ($pid == 0) {
        say q{I'm the parent};
        exit 0;
    } else {
        $children{$pid} = 1;
        system($child_text);
    }
}

希望对您有所帮助。此致！

Perl 将 SIGINT 转发给分叉的子进程

Perl forward SIGINT to forked child process

perl

fork

sigint