Убить зависшего ребенка - PullRequest
Новая
       28

Убить зависшего ребенка

5 голосов
/ 22 февраля 2012

Мой Perl-скрипт запускает внешнюю программу (которая принимает один параметр командной строки) и обрабатывает ее вывод. Первоначально я делал это: 

my @result = `prog arg`;

Однако оказывается, что программа глючит и в редких случаях зависает непредсказуемо. Как я могу убить программу, если она не вышла через определенное время? Сценарий должен работать как в Windows, так и в Linux, и, насколько я понимаю, сигналы тревоги и вилки не работают (или вообще не работают) в Windows.

Я нашел модуль с именем IPC :: Run , но я не могу понять, как правильно его использовать, из его документации. :-( Я пробовал это: 

use strict;
use warnings;
use IPC::Run qw(run timeout);
my $in;
my $out;
my $err;
my @result;
my @cmd = qw(prog arg);
run \@cmd, \$in, \$out, \$err, timeout (10) or die "@cmd: $?";
push @result, $_ while (<$out>);
close $out;
print @result;

В качестве теста я создал программу, которая просто спит 60 секунд, печатает строку до stdout и завершает работу. Когда я пытаюсь запустить его с помощью приведенного выше кода, он зависает на 60 секунд (вместо 10 секунд, как указано в тайм-ауте) и прерывается с причудливой ошибкой: 

IPC::Run: timeout on timer #1 at C:/Bin/Unix/Perl/site/lib/IPC/Run.pm line 2956

Затем я нашел другой модуль, Proc :: Reliable . Из описания, похоже, делаю именно то, что хочу. За исключением того, что это не работает! Я попробовал это: 

use strict;
use warnings;
use Proc::Reliable;

my $proc = Proc::Reliable->new ();
$proc->maxtime (10);
my $out = $proc->run ("prog arg");
print "$out\n";

Это действительно прерывает дочерний процесс через 10 секунд. Все идет нормально. Но затем я изменил внешнюю программу и заставил ее спать только 5 секунд. Это означает, что программа должна завершиться до 10-секундного тайм-аута, указанного в приведенном выше коде, и ее stdout вывод должен быть записан в переменную $out. Но это не так! Приведенный выше скрипт ничего не выводит.

Есть идеи, как это сделать правильно? (Исправление глючной внешней программы не вариант.) Заранее спасибо.

Ответы [ 3 ]

3 голосов
/ 22 февраля 2012

Попробуйте будильник бедняка 

my $pid;
if ($^O eq 'MSWin32') {
    $pid = system 1, "prog arg";    # Win32 only, run proc in background
} else {
    $pid = fork();
    if (defined($pid) && $pid == 0) {
        exec("proc arg");
    }
}

my $poor_mans_alarm = "sleep 1,kill(0,$pid)||exit for 1..$TIMEOUT;kill -9,$pid";
system($^X, "-e", $poor_mans_alarm);

Тревога бедняка работает в отдельном процессе. Каждую секунду он проверяет, активен ли процесс с идентификатором $ pid. Если процесс не активен, аварийный процесс завершается. Если процесс все еще активен через $ time секунд, он отправляет процессу сигнал отмены (я использовал 9, чтобы сделать его недоступным для захвата, и -9, чтобы вынуть все дерево подпроцесса, ваши потребности могут отличаться. kill 9,... также переносимо) .

Редактировать: Как вы фиксируете результаты процесса с тревогой бедного человека? Не с обратными галочками - тогда вы не можете получить идентификатор процесса, и вы можете потерять промежуточный вывод, если процесс остановится и будет убит. Альтернативы

1) отправить вывод в файл, прочитать файл после завершения процесса 

$pid = system 1, "proc arg > some_file";
... start poor man's alarm, wait for program to finish ...
open my $fh, '<', 'some_file';
my @process_output = <$fh>;
...

2) использовать Perl open для запуска процесса 

$pid = open my $proc, '-|', 'proc arg';
if (fork() == 0) {
    # run poor man's alarm in a background process
    exec($^X, '-e', "sleep 1,kill 0,$pid||exit ...");
}
my @process_output = ();
while (<$proc>) {
   push @process_output, $_;
}

Цикл while завершится, когда процесс завершится, естественным или неестественным.

1 голос
/ 25 февраля 2012

Это лучшее, что я мог сделать.Будем благодарны за любые идеи о том, как избежать использования временного файла в Windows. 

#!/usr/bin/perl

use strict;
use warnings;
use File::Temp;
use Win32::Process qw(STILL_ACTIVE NORMAL_PRIORITY_CLASS);

my $pid;
my $timeout = 10;
my $prog = "prog arg";
my @output;

if ($^O eq "MSWin32")
{
    my $exitcode;
    my $fh = File::Temp->new ();
    my $output_file = $fh->filename;
    close ($fh);
    open (OLDOUT, ">&STDOUT");
    open (STDOUT, ">$output_file" ) || die ("Unable to redirect STDOUT to $output_file.\n");
    Win32::Process::Create ($pid, $^X, $prog, 1, NORMAL_PRIORITY_CLASS, '.') or die Win32::FormatMessage (Win32::GetLastError ());
    for (1 .. $timeout)
    {
        $pid->GetExitCode ($exitcode);
        last if ($exitcode != STILL_ACTIVE);
        sleep 1;
    }
    $pid->GetExitCode ($exitcode);
    $pid->Kill (0) or die "Cannot kill '$pid'" if ($exitcode == STILL_ACTIVE);
    close (STDOUT);
    open (STDOUT, ">&OLDOUT");
    close (OLDOUT);
    open (FILE, "<$output_file");
    push @output, $_ while (<FILE>);
    close (FILE);
}
else
{
    $pid = open my $proc, "-|", $prog;
    exec ($^X, "-e", "sleep 1, kill (0, $pid) || exit for 1..$timeout; kill -9, $pid") unless (fork ());
    push @output, $_ while (<$proc>);
    close ($proc);
}
print "Output:\n";
print @output;
0 голосов
/ 04 октября 2013

Вы можете использовать системный вызов будильника, как в perldoc -f alarm.

...