殺死一個懸掛的子進程

Question

我的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秒超時之前完成，並且其輸出應該被捕獲到變量$out中。但事實並非如此！上面的腳本不輸出任何東西。

任何想法如何正確地做到這一點？ （修復有問題的外部程序不是一個選項。）在此先感謝。

Answer 1

嘗試窮人的報警

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秒後仍然活着，它會向進程發送一個kill信號（我使用了9來使其不可用，而-9用來取出整個子進程樹，您的需求可能會有所不同，kill 9,...也是可移植的）。

編輯：您如何捕捉與窮人的警報過程的輸出？ 不反引號 - 那麼你不能得到進程ID，如果進程超時並被殺死，你可能會失去中間輸出。該方案是

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循環將當過程結束時自然或不自然地結束。

Answer 2

這是我能做的最好的。任何想法如何避免在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; 

Answer 3

您可能希望使用報警系統調用，如在perldoc -f報警中。