Как мне очистить зависшие процессы внуков, когда тревога срабатывает в Perl?
У меня есть параллельный сценарий автоматизации, который должен вызывать многие другие сценарии, некоторые из которых зависают, потому что они (неправильно) ожидают стандартного ввода или ждут различных других вещей, которые не произойдут. Это не имеет большого значения, потому что я ловлю тех с тревогой. Хитрость заключается в том, чтобы отключить эти зависшие процессы внука, когда ребенок выключается. Я думал, что различные заклинания SIGCHLD, ожидание, и группы процессов могли бы добиться цели, но все они блокируются, и внуки не пожинаются.
Мое решение, которое работает, просто не похоже, что это правильное решение. Меня пока не особенно интересует решение для Windows, но оно мне тоже в конечном итоге понадобится. Мой работает только для Unix, что пока хорошо.
Я написал небольшой скрипт, который принимает количество одновременных параллельных дочерних элементов и общее количество вилок:
$ fork_bomb <parallel jobs> <number of forks>
$ fork_bomb 8 500
Это, вероятно, достигнет предела для каждого пользователя в течение пары минут. Многие решения, которые я нашел, просто говорят вам об увеличении лимита процессов для каждого пользователя, но мне нужно, чтобы он работал около 300000 раз, так что это не сработает. Точно так же, предложения по повторному выполнению и т. Д. Для очистки таблицы процессов - это не то, что мне нужно. Я бы хотел исправить проблему, вместо того, чтобы наклеивать клейкую ленту на нее.
Я сканирую таблицу процессов в поисках дочерних процессов и выключаю зависшие процессы по отдельности в SIGALRM обработчик, который должен умереть, потому что остальная часть реального кода не имеет надежды на успех после этого. Слабое сканирование по таблице процессов не беспокоит меня с точки зрения производительности, но я не возражаю против этого:
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;
}
То же самое с POSIXsetsid тоже не сработало, и я думаю, что это на самом деле сломало вещи по-другому, так как я на самом деле не демонизирую это.
Любопытно, Parallel:: ForkManager's run_on_finish происходит слишком поздно для того же самого кода очистки: внуки, по-видимому, уже оторваны от дочерних процессов в этот момент.
3 ответа
Я прочитал вопрос несколько раз и думаю, что понял, что вы пытаетесь сделать. У вас есть контрольный скрипт. Этот сценарий порождает детей, чтобы делать некоторые вещи, и эти дети порождают внуков, чтобы действительно делать работу. Проблема в том, что внуки могут быть слишком медленными (в ожидании 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 для запуска.
В этой функции нам нужно форк. В родительском элементе мы устанавливаем дочерний наблюдатель для наблюдения за дочерним элементом:
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
}
Вы также можете закрыть здесь стандартный ввод, если хотите.
Теперь, после того как все процессы были запущены, мы ждем их завершения, ожидая 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
Итак, это ребенок и внук / работа. Теперь нам просто нужно написать родителя, что намного проще.
Как и ребенок, мы будем использовать счетчик, чтобы ждать наших детей.
# main program
my $all_done = AnyEvent->condvar;
Нам нужно кое-что сделать. Вот тот, который всегда успешен, и тот, который будет успешным, если вы нажмете return, но потерпит неудачу, если вы просто позволите ему быть убитым таймером:
my $good_grandchild = sub {
exit 0;
};
my $bad_grandchild = sub {
my $line = <STDIN>;
exit 0;
};
Итак, нам просто нужно начать работу с детьми. Если вы помните путь назад к вершине start_child, требуется два обратных вызова, обратный вызов ошибки и обратный вызов успеха. Мы настроим их; обратный вызов ошибки выведет "не в порядке" и уменьшит condvar, а обратный вызов успеха выведет "в порядке" и сделает то же самое. Очень просто.
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, $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);
У двух из них будет тайм-аут, а у двух будет успех. Если вы нажмете 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;
Преимущество здесь в том, что вы можете делать другие вещи, пока ваши дети бегут - просто создавайте больше потоков с async прежде чем сделать блокирующее соединение. У вас также есть намного больший контроль над потомками с AnyEvent::Subprocess - вы можете запустить потомка в Pty и передать ему стандартный ввод (как с Expect), и вы можете захватить его stdin и stdout и stderr, или вы можете игнорировать эти вещи, или что-то еще. Вам решать, а не какой-то автор модуля, который пытается сделать вещи "простыми".
В любом случае, надеюсь, это поможет.
Брайан - это немного грубо и не идиоматично, но один из подходов, который я видел, заключается в следующем: каждый раз, когда вы разветвляетесь, вы:
Дайте дочернему процессу первый фиктивный параметр "-id" для программы с несколько уникальным (для PID) значением - хорошим кандидатом может быть метка времени с точностью до миллисекунды + PID родителя.
Родитель записывает дочерний PID и значение -id в (в идеале, постоянный) реестр вместе с желаемым временем ожидания / уничтожения.
Затем попросите процесс наблюдателя (конечного прародителя или отдельный процесс с тем же UID) просто периодически циклически проходить по реестру и проверять, какие процессы, которые нужно уничтожить (в соответствии с временем до уничтожения), все еще находятся в процессе (путем сопоставления оба значения PID и "-id" в реестре с PID и командной строкой в таблице процессов); и отправьте сигнал 9 такому процессу (или будьте любезны и попытайтесь сначала аккуратно убить, попытавшись отправить сигнал 2).
Уникальный параметр "-id", очевидно, предназначен для предотвращения уничтожения невинного процесса, который случайно использовал PID предыдущего процесса по совпадению, что, вероятно, вероятно с учетом масштаба, который вы упомянули.
Идея реестра помогает решить проблему "уже разобщенных" внуков, поскольку вы больше не зависите от системы, которая поддерживает связь между родителями и детьми.
Это своего рода грубая сила, но так как никто еще не ответил, я решил, что я думаю, что мои 3 цента стоят идеи по-вашему.
Я должен решить эту проблему в модуле, над которым я работал. Я не полностью удовлетворен всеми моими решениями, но в Unix обычно работает
- изменить группу процессов ребенка
- порождает внуков по мере необходимости
- снова измените дочернюю группу процессов (скажем, вернитесь к исходному значению)
- подать сигнал процессуальной группе внуков, чтобы убить внуков
Что-то вроде:
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 '<STDIN>'", Для меня это немедленно приостанавливает процесс и предотвращает запуск SIGALRM и запуск обработчика SIGALRM. Закрывается STDIN единственный обходной путь?