perl - 当 Perl 中的警报触发时，我应该如何清理挂起的孙子进程？

Question

我有一个并行化的自动化脚本，它需要调用许多其他脚本，其中一些脚本挂起是因为它们(错误地)等待标准输入或等待各种其他不会发生的事情。这没什么大不了的，因为我用 alarm 捕获了那些.诀窍是在子进程关闭时关闭那些挂起的孙子进程。我想到了SIGCHLD的各种咒语、waiting 和 process 组可以解决问题，但它们都阻塞并且不会获得孙子。

我的解决方案虽然有效，但似乎不是正确的解决方案。我对 Windows 解决方案还不是特别感兴趣，但我最终也会需要它。我的只适用于 Unix，现在很好。

我写了一个小脚本，它需要同时运行的并行子节点的数量和 fork 的总数:

 $ fork_bomb <parallel jobs> <number of forks>

 $ fork_bomb 8 500

这可能会在几分钟内达到每个用户的进程限制。我发现的许多解决方案只是告诉您增加每个用户的进程限制，但我需要它运行大约 300,000 次，所以这是行不通的。同样，重新执行等以清除进程表的建议也不是我所需要的。我想真正解决这个问题，而不是在上面贴胶带。

我爬取进程表以查找子进程并在 SIGALRM 中单独关闭挂起的进程。处理程序，它需要死亡，因为此后其余的真实代码没有成功的希望。从性能的角度来看，通过进程表的kludgey 爬行并没有打扰我，但我不介意不这样做:

use Parallel::ForkManager;
use Proc::ProcessTable;

my $pm = Parallel::ForkManager->new( $ARGV[0] );

my $alarm_sub = sub {
        kill 9,
            map  { $_->{pid} }
            grep { $_->{ppid} == $$ }
            @{ Proc::ProcessTable->new->table }; 

        die "Alarm rang for $$!\n";
        };

foreach ( 0 .. $ARGV[1] ) 
    {
    print ".";
    print "\n" unless $count++ % 50;

    my $pid = $pm->start and next; 

    local $SIG{ALRM} = $alarm_sub;

    eval {
        alarm( 2 );
        system "$^X -le '<STDIN>'"; # this will hang
        alarm( 0 );
        };

    $pm->finish;
    }

如果你想用完进程，取出kill .

我认为设置一个进程组会起作用，这样我就可以一起杀死所有东西，但这会阻止:

my $alarm_sub = sub {
        kill 9, -$$;    # blocks here
        die "Alarm rang for $$!\n";
        };

foreach ( 0 .. $ARGV[1] ) 
    {
    print ".";
    print "\n" unless $count++ % 50;

    my $pid = $pm->start and next; 
    setpgrp(0, 0);

    local $SIG{ALRM} = $alarm_sub;

    eval {
        alarm( 2 );
        system "$^X -le '<STDIN>'"; # this will hang
        alarm( 0 );
        };

    $pm->finish;
    }

与 POSIX 相同的事情的 setsid也没有用，而且我认为这实际上以不同的方式破坏了事情，因为我并没有真正对此进行守护。

奇怪的是，Parallel::ForkManager的 run_on_finish对于相同的清理代码，发生得太晚了:在那时，孙子进程显然已经与子进程分离。

Answer 1

我已经读了几次这个问题，我想我有点明白你的意思
正在努力做。你有一个控制脚本。这个脚本产生
children 做一些事情，这些 child 会产生孙子
实际完成工作。问题是孙子可以
太慢(等待 STDIN 或其他)，你想杀死它们。
此外，如果有一个慢孙子，你想要整个
child 死了(如果可能的话，杀死其他孙子孙女)。

所以，我尝试实现这两种方式。第一个是使
父级在新的 UNIX session 中生成一个子级，设置几个计时器
秒，并在计时器关闭时终止整个子 session 。
这使得 parent 对 child 和
孙子。它也没有正常工作。

下一个策略是让父级生成子级，然后
让 child 负责管理孙子。它会
为每个孙子设置一个计时器，如果进程没有，则将其杀死
过期时间退出。这很好用，所以这是代码。

我们将使用 EV 来管理 child 和计时器，并使用 AnyEvent 来管理
应用程序接口(interface)。 (您可以尝试另一个 AnyEvent 事件循环，例如 Event 或 POE。
但我知道 EV 正确地处理了 child 退出的情况
在你告诉循环监控它之前，这消除了恼人的竞争
其他循环容易受到的条件。)

#!/usr/bin/env perl

use strict;
use warnings;
use feature ':5.10';

use AnyEvent;
use EV; # you need EV for the best child-handling abilities

我们需要跟踪 child 观察者:

# active child watchers
my %children;

然后我们需要编写一个函数来启动 child 。事情
parent 产生的东西被称为 child ，而 child 的东西
产卵被称为工作。

sub start_child($$@) {
    my ($on_success, $on_error, @jobs) = @_;

参数是在 child 完成时要调用的回调
成功(意味着它的工作也成功)，回调
child 没有成功完成，然后是coderef的列表
要运行的作业。

在这个函数中，我们需要 fork 。在父级中，我们设置了一个子级
watcher 监控 child :

    if(my $pid = fork){ # parent
        # monitor the child process, inform our callback of error or success
        say "$$: Starting child process $pid";
        $children{$pid} = AnyEvent->child( pid => $pid, cb => sub {
            my ($pid, $status) = @_;
            delete $children{$pid};

            say "$$: Child $pid exited with status $status";
            if($status == 0){
                $on_success->($pid);
            }
            else {
                $on_error->($pid);
            }
        });
    }

在 child 中，我们实际上运行了工作。这涉及到一点点
设置，不过。

首先，我们忘记了 parent 的 child 观察者，因为它不会
让 child 知道其 sibling 退出的感觉。 (叉是
有趣，因为你继承了父级的所有状态，即使是
完全没有意义。)

    else { # child
        # kill the inherited child watchers
        %children = ();
        my %timers;

我们还需要知道所有工作何时完成，以及是否
他们都取得了成功。我们使用计数条件变量来
确定一切何时退出。我们在启动时递增，并且
退出时递减，当计数为 0 时，我们知道一切都已完成。

我还保留了一个 bool 值来指示错误状态。如果一个进程
以非零状态退出，错误变为 1。否则，它保持为 0。
您可能想要保持比这更多的状态:)

        # then start the kids
        my $done = AnyEvent->condvar;
        my $error = 0;

        $done->begin;

(我们也从 1 开始计数，这样如果有 0 个作业，我们的过程
仍然退出。)

现在我们需要为每个作业 fork ，并运行作业。在父级中，我们
做几件事。我们增加条件变量。我们设置了一个计时器来杀死
如果 child 太慢。我们设置了一个 child 观察者，所以我们可以
被告知作业的退出状态。

    for my $job (@jobs) {
            if(my $pid = fork){
                say "[c] $$: starting job $job in $pid";
                $done->begin;

                # this is the timer that will kill the slow children
                $timers{$pid} = AnyEvent->timer( after => 3, interval => 0, cb => sub {
                    delete $timers{$pid};

                    say "[c] $$: Killing $pid: too slow";
                    kill 9, $pid;
                });

                # this monitors the children and cancels the timer if
                # it exits soon enough
                $children{$pid} = AnyEvent->child( pid => $pid, cb => sub {
                    my ($pid, $status) = @_;
                    delete $timers{$pid};
                    delete $children{$pid};

                    say "[c] [j] $$: job $pid exited with status $status";
                    $error ||= ($status != 0);
                    $done->end;
                });
            }

使用定时器比闹钟容易一点，因为它带有
与它状态。每个计时器都知道要杀死哪个进程，而且很容易
当进程成功退出时取消计时器——我们只是
从哈希中删除它。

那是( child 的) parent 。 child ( child 的；或
工作)非常简单:

            else {
                # run kid
                $job->();
                exit 0; # just in case
            }

如果您愿意，您也可以在此处关闭 stdin。

现在，在所有进程产生后，我们等待它们
所有通过等待 condvar 退出。事件循环将监视
child 和计时器，并为我们做正确的事情:

        } # this is the end of the for @jobs loop
        $done->end;

        # block until all children have exited
        $done->recv;

然后，当所有 child 都退出时，我们可以做任何清理工作
我们想要的工作，例如:

        if($error){
            say "[c] $$: One of your children died.";
            exit 1;
        }
        else {
            say "[c] $$: All jobs completed successfully.";
            exit 0;
        }
    } # end of "else { # child"
} # end of start_child

好的，这就是 child 和孙子/工作。现在我们只需要写
parent ，这要容易得多。

像 child 一样，我们将使用计数条件来等待我们的
children 。

# main program
my $all_done = AnyEvent->condvar;

我们需要做一些工作。这是一个总是成功的，并且
一个如果你按回车会成功，但如果你会失败
让它被计时器杀死:

my $good_grandchild = sub {
    exit 0;
};

my $bad_grandchild = sub {
    my $line = <STDIN>;
    exit 0;
};

那么我们只需要启动子作业。如果你记得方式
返回顶部 start_child ，需要两个回调，一个错误
回调和成功回调。我们会设置这些；错误
回调将打印“not ok”并减少 condvar，并且
成功回调将打印“ok”并执行相同操作。很简单。

my $ok  = sub { $all_done->end; say "$$: $_[0] ok" };
my $nok = sub { $all_done->end; say "$$: $_[0] not ok" };

然后我们可以开始一群 child ，有更多的孙子
工作:

say "starting...";

$all_done->begin for 1..4;
start_child $ok, $nok, ($good_grandchild, $good_grandchild, $good_grandchild);
start_child $ok, $nok, ($good_grandchild, $good_grandchild, $bad_grandchild);
start_child $ok, $nok, ($bad_grandchild, $bad_grandchild, $bad_grandchild);
start_child $ok, $nok, ($good_grandchild, $good_grandchild, $good_grandchild, $good_grandchild);

其中两个将超时，两个将成功。如果你按回车
然而，当他们在奔跑时，他们可能都会成功。

无论如何，一旦这些开始，我们只需要等待他们
完成:

$all_done->recv;

say "...done";

exit 0;

这就是程序。

我们没有做的 Parallel::ForkManager 做的一件事是
“限速”我们的 fork ，以便只有 n children 跑在一个
时间。不过，这很容易手动实现:

 use Coro;
 use AnyEvent::Subprocess; # better abstraction than manually
                           # forking and making watchers
 use Coro::Semaphore;

 my $job = AnyEvent::Subprocess->new(
    on_completion => sub {}, # replace later
    code          => sub { the child process };
 )

 my $rate_limit = Coro::Semaphore->new(3); # 3 procs at a time

 my @coros = map { async {
     my $guard = $rate_limit->guard;
     $job->clone( on_completion => Coro::rouse_cb )->run($_);
     Coro::rouse_wait;
 }} ({ args => 'for first job' }, { args => 'for second job' }, ... );

 # this waits for all jobs to complete
 my @results = map { $_->join } @coros;

这样做的好处是您可以在 child 的同时做其他事情
正在运行——只需使用 async 生成更多线程在你做之前
阻止加入。你也对 child 有更多的控制权
使用 AnyEvent::Subprocess -- 您可以在 Pty 中运行子进程并提供
它的标准输入(与 Expect 一样)，您可以捕获它的标准输入和标准输出
和标准错误，或者你可以忽略这些东西，或者其他什么。你可以
决定，而不是某个试图使事情变得“简单”的模块作者。

无论如何，希望这会有所帮助。