Windows 和 linux 中的 Perl 超时命令

Question

我正在编写一个需要在 windows 和 linux 中运行的 perl 脚本，它将运行一个进程，如果它需要太长时间，则超时，假设它没有超时返回退出代码，并假设退出代码为零并且它没有返回标准输出没有超时。我不需要 STDIN 或 STDERR。我尝试使用 IPC::run但无法让它工作。

我得到的最接近的是 IPC::Open3和 waitpid($pid, WNOHANG) .但我遇到了一个障碍。我在 windows 和 linux 上看到了不同的结果。在下面的代码中，我给出 open3将失败的命令(ping 没有任何参数 -z )。在 linux 上，代码立即返回一个否定的退出代码。在 Windows 上，命令超时。运行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";
}

欢迎其他解决方案。我使用带有 nohang 的 waitpid 的唯一原因是如果它花费的时间太长就终止该进程。在此期间，我没有任何其他需要做的处理。
我在 windows 上使用 windows 10 草莓 perl 5.28 便携版。我的 debian 机器有 perl 5.24。

Answer 1

IPC::Run支持各种timeouts and timers ，这也应该适用于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: $@";
}

timeout抛出异常，因此 eval .还有其他计时器，其行为更加微妙和易于管理。请参阅文档。

如果捕获的异常不是由 IPC::Run 引起的，则会重新抛出异常。的计时器——根据我系统上的模块版本在消息中打印的内容来判断，一个以 IPC::Run: timeout 开头的字符串。请检查您的系统上的内容。

虽然有些事情在 Windows 上不起作用，但我认为计时器应该。我现在无法测试。

据报道，虽然上述方法有效，但使用更有意义的命令 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触发时可以调用。

另一种方法是查找进程 ID(使用 Win32::Process::Info 或 Win32::Process::List )，
并用 kill 终止它, 或 Win32::Process , 或 TASKKILL .见 this post (下半场)。

仅将 block 添加到 local -ize 信号处理程序。在实际代码中，所有这些都可能以某种方式限定范围，因此可能不需要额外的 block 。

请注意，Windows 没有 POSIX 信号，Perl 只模拟一些非常基本的 UNIX 信号，以及 Windows 特定的 SIGBREAK。 .