Команда времени ожидания Perl в Windows и Linux

Question

Я пишу Perl-скрипт, который должен работать в Windows и Linux, который будет запускать процесс, тайм-аут, если это займет слишком много времени, вернуть код завершения, если он не истек, и вернуть stdout, предполагая, что код выхода равен нулю, и это не так. Тайм-аут Мне не нужны STDIN или STDERR. Я пытался использовать IPC::run но не мог заставить его работать.

Ближайшее, что у меня есть, IPC::Open3 а также waitpid($pid, WNOHANG), Но я наткнулся на препятствие. Я вижу разные результаты на Windows и Linux. В приведенном ниже коде я даю open3 команда, которая потерпит неудачу (ping не имеет аргументов -z). В Linux этот код немедленно возвращает отрицательный код выхода. На окнах команда истекает. Бег ping google.com -z в командной строке Windows немедленно возвращает сообщение о том, что такого аргумента нет. Почему ``waitpid` возвращает ноль?

use strict;
use warnings;
use POSIX ":sys_wait_h";
use IPC::Open3;

my $inFH;
my $outFH;
my @cmd = ("ping", "google.com", "-z");
my $pid = open3( $inFH, $outFH, 0, @cmd);
my $counter=0;
my $waitret;
my $exitcode;
do{
    $counter++;
    $waitret = waitpid($pid,WNOHANG);   
    $exitcode = $?;
}while( !$waitret and ($counter < 4_000_000));

if ($counter >= 4_000_000) {
    print "Command timed out\n";
    kill(9, $pid);
} else {
    print "Exit Code: $exitcode\n";
}

Другие решения приветствуются. Единственная причина, по которой я использую waitpid с nohang, - это завершение процесса, если он занимает слишком много времени. У меня нет никакой другой обработки, которую я должен сделать тем временем. Я использую Windows 10 клубника Perl 5.28 портативных на Windows. У моей машины с Debian есть Perl 5.24.

Answer 1

IPC:: Run поддерживает различные таймауты и таймеры, которые также должны работать на Win32.

Основные:

use warnings;
use strict;
use feature 'say';

use IPC::Run qw(run timeout);

my $out;

eval {
    run [ qw(sleep 20) ], \undef, \$out, timeout(2) or die "Can't run: $?"
};  
if ($@) { 
    die $@ if $@ !~ /^IPC::Run: timeout/;
    say "Eval: $@";
}

Я повторно выбрасываю исключение, если пойманный не вызван IPC::RunТаймер - используя то, что версия модуля в моей системе печатает в сообщении, строка начинается с IPC:: Run: timeout. Пожалуйста, проверьте, что это в вашей системе.

Хотя некоторые вещи не работают в Windows, таймеры должны, я думаю. Я не могу проверить прямо сейчас.

timeout выдает исключение, таким образом, eval, Существуют и другие таймеры с более тонким и управляемым поведением. Пожалуйста, смотрите документацию.

---

Сообщается, что, хотя вышесказанное работает, с более значимой командой SIGBREAK (21) выбрасывается по истечении времени ожидания, и как только он обрабатывается, процесс остается без изменений.

В этом случае завершите его вручную в обработчике

use warnings;
use strict;
use feature 'say';
use IPC::Run qw(run harness timeout);

my $out;
my @cmd = qw(sleep 20);

my $h = harness \@cmd, \undef, \$out, timeout(2);

HANDLE_RUN: {
    local $SIG{BREAK} = sub {
        say "Got $_[0]. Terminate IPC::Run's process";
        $h->kill_kill;
    };  

    eval { run $h };  
    if ($@) { 
        die $@ if $@ !~ /^IPC::Run: timeout/;
        say "Eval: $@";
    }
};

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

Другой способ - найти идентификатор процесса (с помощью Win32::Process::Info или Win32:: Process:: List) и завершить его с помощью killили Win32:: Process, или TASKKILL, Смотрите этот пост (вторая половина).

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

Обратите внимание, что в Windows нет сигналов POSIX и что Perl эмулирует только несколько очень простых сигналов UNIX, а также специфичные для Windows SIGBREAK,