7

これが私のコードです。わかりやすくするために、エラー処理やその他のものを削除しています。

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

launch subは、次のような他のプロセスを起動するシェルスクリプトを実行します。

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

これによりスクリプトは強制終了されますが、そのサブプロセスは強制終了されません。それを修正する方法は？

4

4 に答える 4

13

オペレーティングシステムがプロセスグループをサポートしている場合は、プロセスグループを使用してこれを行うことができます。スクリプトプロセスをプロセスグループリーダーにする必要があります。実行する子プロセスは、親からプロセスグループを継承します。次に、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;
于 2009-11-04T19:13:25.120 に答える
2

一般に、シグナルがすべての子プロセスに伝播されることは期待できないと思います。これはperlに固有のものではありません。

そうは言っても、perl kill（）に組み込まれているプロセスグループシグナル機能を使用できる可能性があります。

... SIGNALが負の場合、プロセスではなくプロセスグループを強制終了します...

おそらく、（直接の）子プロセスでsetpgrp（）を使用してから、kill呼び出しを次のように変更する必要があります。

kill -9, $pgrp;
于 2009-11-04T19:07:16.397 に答える
2

追加してみてください：

use POSIX qw(setsid);
setsid;

関数の上部にありますlaunch_and_monitor。これにより、プロセスが別のセッションに配置され、セッションリーダー（つまりマスター）が終了したときに処理が終了します。

于 2009-11-04T19:09:12.677 に答える
1

プロセスグループの強制終了は機能しますが、親も単独で強制終了できることを忘れないでください。子プロセスにイベントループがあると仮定すると、fork（）を実行する前に、ソケットペアで作成された親ソケットをチェックして有効性を確認できます。実際、select（）は、親ソケットがなくなるときれいに終了します。実行する必要があるのは、ソケットをチェックすることだけです。

例えば：

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:~$
于 2017-02-25T22:23:20.437 に答える