Как я должен очистить подвешенные процессы внука, когда предупреждение смещается в Perl?

Брайан - это немного грубо и неидиоматично, но один подход, который я видел, заключается в следующем: каждый раз, когда вы разветвляетесь, вы:

1. Дайте дочерний процесс - первый фиктивный параметр «-id» для программы с несколько уникальным (для каждого PID) значением - хорошим кандидатом может быть временная метка с точностью до миллисекунды + родительский PID.

2. Родитель записывает дочерний PID и значение -id в (в идеале постоянный) реестр вместе с желаемым таймаутом / временем уничтожения.

Затем пусть процесс-наблюдатель (конечный дедушка или отдельный процесс с тем же UID) просто периодически просматривает реестр и проверяет, какие процессы, которые нужно убить (согласно времени to-kill), все еще остаются (путем сопоставления значения параметра PID и «-id» в реестре с идентификаторами PID и командной строкой в ​​таблице процессов); и послать такому процессу сигнал 9 (или проявить милосердие и сначала попытаться аккуратно убить, попробовав послать сигнал 2).

Уникальный параметр «-id», очевидно, предназначен для предотвращения убийства какого-то невинного процесса, который случайно случайно повторно использовал PID предыдущего процесса, что, вероятно, с учетом упомянутого вами масштаба.

Идея реестра помогает решить проблему «уже отделившихся» внуков, поскольку вы больше не зависите от системы, которая будет поддерживать связь между родителями и детьми за вас.

Это своего рода грубая сила, но так как никто еще не ответил, я решил, что придумываю идею на 3 цента по-твоему.

Мне нужно решить эту же проблему в модуле над которым я работаю. Я тоже не полностью удовлетворен всеми своими решениями, но то, что обычно работает на Unix, это

1. изменить группу процессов ребенка
2. породить внуков по мере необходимости
3. снова изменить группу процессов ребенка (скажем, вернуть исходное значение)
4. подать сигнал группе процессов внуков, чтобы убить внуков

Что-то вроде:

use Time::HiRes qw(sleep);

sub be_sleepy { sleep 2 ** (5 * rand()) }
$SIGINT = 2;

for (0 .. $ARGV[1]) {
    print ".";
    print "\n" unless ++$count % 50;
    if (fork() == 0) {   
        # a child process
        # $ORIGINAL_PGRP and $NEW_PGRP should be global or package or object level vars
        $ORIGINAL_PGRP = getpgrp(0);
        setpgrp(0, $$);
        $NEW_PGRP = getpgrp(0);

        local $SIG{ALRM} = sub {
            kill_grandchildren();
            die "$$ timed out\n";
        };

        eval {
            alarm 2;
            while (rand() < 0.5) {
                if (fork() == 0) {
                    be_sleepy();
                }
            }
            be_sleepy();
            alarm 0;
            kill_grandchildren();
        };

        exit 0;
    }
}

sub kill_grandchildren {
    setpgrp(0, $ORIGINAL_PGRP);
    kill -$SIGINT, $NEW_PGRP;   # or  kill $SIGINT, -$NEW_PGRP
}

Это не совсем надежно. Внуки могут изменить свои группы процессов или отловить сигналы.

Конечно, все это не будет работать в Windows, но давайте просто скажем, что TASKKILL /F /T - ваш друг.

Обновление: Это решение не справляется (для меня, во всяком случае) со случаем, когда дочерний процесс вызывает system "perl -le ''". Для меня это немедленно приостанавливает процесс, не позволяет сработать SIGALRM и запустить обработчик SIGALRM. Является ли закрытие STDIN единственным обходным решением?

Я прочитал этот вопрос несколько раз и, кажется, понял, что вы пытаются сделать. У вас есть управляющий скрипт. Этот скрипт порождает детям делать что-то, и эти дети порождают внуков на самом деле делать работу. Проблема в том, что внуки могут быть слишком медленно (ждет 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) = @_;

Аргументы - это обратный вызов, который будет вызываться, когда дочерний элемент завершает успешно (это означает, что его работа также была успешной), обратный вызов, когда ребенок не завершил успешно, а затем список кодовых ссылок рабочие места для запуска.

В этой функции нам нужно выполнить форк. В родительском мы настраиваем дочерний Наблюдатель для наблюдения за ребенком:

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

Использовать таймер немного проще, чем будильник, поскольку он состояние с этим. Каждый таймер знает, какой процесс убить, и это легко чтобы отменить таймер при успешном завершении процесса - мы просто удалите его из хеша.

Это родитель (ребенка). Ребенок (ребенка; или job) действительно прост:

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

Вы также можете закрыть stdin здесь, если хотите.

Теперь, когда все процессы созданы, мы ждем, пока они все выходят, ожидая кондвара. Цикл событий будет отслеживать детей и таймеров, и поступают правильно для нас:

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

Хорошо, это ребенок и внук / работа. Теперь нам просто нужно написать родитель, что намного проще.

Как и ребенок, мы собираемся использовать счетный кондвар, чтобы дождаться нашего дети.

# 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, а Успешный обратный вызов напечатает «ОК» и сделает то же самое. Очень простой.

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

Тогда мы сможем завести группу детей с еще большим количеством внуков jobs:

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;

И это программа.

Одна вещь, которую мы не делаем Параллельно ::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;

Преимущество здесь в том, что вы можете делать другие вещи, пока ваши дети запущены - просто создайте больше потоков с помощью async , прежде чем выполнять блокирующее присоединение. У вас также есть гораздо больше контроля над детьми с AnyEvent :: Subprocess - вы можете запускать дочерний элемент в Pty и кормить это stdin (как с Expect), и вы можете захватить его stdin и stdout и stderr, или вы можете игнорировать эти вещи, или что-то еще. Вы доберетесь до решить, а не какой-то автор модуля, который пытается сделать вещи «простыми».

В любом случае, надеюсь, это поможет.