当Perl发生警报时,应该如何清理挂起的孙子进程？

$fork_bomb <parallel jobs> <number of forks>

 $fork_bomb 8 500

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

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

我已经读了这个问题了几次,我想我得到了你的一些
正在努力做你有一个控制脚本.这个脚本产生了
孩子做一些东西,这些孩子产卵孙子
实际做工作.问题是孙子可以
太慢(等待STDIN或其他),你想杀死他们.
此外,如果有一个缓慢的孙子,你想要整个
孩子死亡(如果可能,杀死其他孙子孙).

所以,我试着实现这两种方式.第一个是做的
父生成一个新的UNIX会话中的一个孩子,设置一个计时器几个
秒,并在定时器关闭时杀死整个小孩会话.
这使得父母对孩子和孩子负责
孙子.它也没有正常工作.

下一个策略是让父母产生孩子,然后
使孩子负责管理孙子孙.它会
为每个孙子设置一个计时器,如果进程没有,则将其杀死
在到期时间退出.这很好,所以这里是代码.

我们将使用EV来管理孩子和计时器,以及AnyEvent
API. (您可以尝试另一个AnyEvent事件循环,如Event或POE.
但是我知道EV正确地处理孩子退出的状况
在你告诉循环来监视它之前,这消除了烦人的种族
其他循环易受影响的条件.)

#!/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

我们需要跟踪孩子观察者：

# active child watchers
my %children;

然后我们需要编写一个函数来启动孩子.这些事
父母的产卵被称为孩子,孩子们的东西
产卵称为工作.

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

参数是当孩子完成时调用的回调
成功(意思是它的工作也是成功的),一个回调的时候
孩子没有成功完成,然后是一个coderef的列表
工作运行.

在这个功能中,我们需要fork.在父母中,我们设置一个孩子
观察者监视孩子：

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

在孩子里,我们实际上是运行这个工作.这涉及到一点点
设置,但.

首先,我们忘记了父母的孩子观察者,因为没有这样做
感觉孩子被告知其兄弟姐妹离开. (叉是
有趣的是,因为你继承了父母的所有状态,即使是这样
没有任何意义.)

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

我们还需要知道什么时候完成所有的工作,以及是否
他们都是成功的.我们使用一个计数条件变量
确定何时退出.我们在启动时增加
退出退出,当计数为0时,我们知道一切都完成了.

我也保持一个布尔值来指示错误状态.如果一个过程
退出非零状态,错误转到1.否则,它保持为0.
你可能想要保持比这更多的状态:)

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

        $done->begin;

(我们也开始计数1,所以如果有0个工作,我们的过程
仍然退出)

现在我们需要为每个工作分叉,并运行这个工作.在父母中,我们
做一些事情我们增加condvar.我们设定一个计时器来杀死
孩子如果太慢了我们设置一个孩子观察者,所以我们可以
被告知工作的退出状态.

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

使用定时器比报警更容易一些,因为它带有
状态与它.每个计时器都知道要杀死哪个进程,很容易
当进程成功退出时取消定时器 – 我们只是
从哈希中删除它.

这是父母(孩子).孩子(小孩;或小孩)
工作)真的很简单：

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

你也可以在这里关闭stdin,如果你想的话.

现在,在所有的过程都产生之后,我们等待他们
所有退出通过等待condvar.事件循环将会恶化
孩子和计时器,为我们做正确的事情：

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

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

然后,当所有的孩子都退出时,我们可以做任何清理
我们想要的工作,像：

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

好的,那就是孩子和孙子/工作.现在我们只需要写
父母,这很容易.

像小孩一样,我们要用一个数字的condvar来等待我们
儿童.

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

我们需要一些工作去做.这是一个总是成功的,而且
一个将成功,如果你按返回,但会失败,如果你
只是让它被计时器杀死：

my $good_grandchild = sub {
    exit 0;
};

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

那么我们只需要开始小孩的工作.如果你记得的方式
回到start_child的顶部,它需要两个回调,一个错误
回调和成功回调.我们会把那些错误
回调将打印“不好”,并减少condvar,并且
成功回调将打印“ok”并执行相同操作.很简单.

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

然后,我们可以开始一群孩子,甚至更多的孙子
工作：

say "starting...";

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

其中两个将超时,两个将成功.如果您按Enter键
虽然他们正在运行,但他们可能都会成功.

无论如何,一旦开始,我们只需要等待他们
完：

$all_done->recv;

say "...done";

exit 0;

这就是程序.

有一件事我们没有做,Parallel :: ForkManager是
“速率限制”我们的叉子,以便只有n个孩子正在运行
时间.这很容易手动实现,虽然：

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;

这里的优点是你可以在孩子的时候做其他的事情
正在运行 – 只是在做异常之前产生更多的线程
阻止连接.你也有更多的控制孩子
使用AnyEvent :: Subprocess – 您可以在Pty和feed中运行该子项
它stdin(像Expect),你可以捕获它的stdin和stdout
和stderr,或者你可以忽略这些东西,或任何东西.你得到
决定,而不是一些模块作者试图使事情“简单”.

无论如何,希望这有帮助.