Kill a niño colgado proceso

Question

Mi script Perl ejecuta un programa externo (que toma un solo parámetro de línea de comandos) y procesa su resultado. Originalmente, yo estaba haciendo esto:

my @result = `prog arg`; 

Sin embargo, resulta que el programa está libre de errores y se cuelga de forma impredecible en casos raros. ¿Cómo puedo matar el programa si no ha salido después de una cierta cantidad de tiempo? La secuencia de comandos debe funcionar tanto en Windows como en Linux, y entiendo que las alarmas y las horquillas no funcionan bien (o no funcionan) en Windows.

Encontré un módulo llamado IPC::Run pero no puedo encontrar la forma de usarlo correctamente desde su documentación. :-(He intentado esto:

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; 

Como prueba, he creado un programa que solo duerme 60 segundos, imprime una cadena a stdout y salidas Cuando intento funcionar con el código anterior, se cuelga para. 60 segundos (en lugar de 10 segundos, según se especifica en el tiempo de espera) y aborta con un error extraño:

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

Entonces me encontré con otro módulo, Proc::Reliable por la descripción, parece que hacer precisamente lo que quiero.. ¡Excepto que no funciona! Intenté esto:

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

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

De hecho, aborta el proceso secundario después de 10 segundos. Hasta aquí todo bien. Pero luego modifiqué el programa externo y lo hice dormir por solo 5 segundos. Esto significa que el programa debe finalizar antes del tiempo de espera de 10 segundos especificado en el código anterior y su salida stdout debe capturarse en la variable $out. ¡Pero no lo es! La secuencia de comandos anterior no muestra nada.

¿Alguna idea de cómo hacerlo correctamente? (Reparar el error del programa externo no es una opción.) Gracias de antemano.

Answer 1

Trate de alarma del pobre

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); 

de alarma de la pobre hombre se ejecuta en un proceso separado. Cada segundo, verifica si el proceso con el identificador $ pid sigue vivo. Si el proceso no está activo, el proceso de alarma se cierra. Si el proceso sigue vivo después de $ segundos de tiempo, envía una señal de muerte al proceso (utilicé 9 para hacerlo imposible de procesar y -9 para extraer todo el árbol de subprocesos, sus necesidades pueden variar. kill 9,... también es portátil).

Edit: ¿Cómo captura la salida del proceso con la alarma del hombre pobre? No con backticks: entonces no se puede obtener el ID del proceso y puede perder el resultado intermedio si el proceso expira y se mata. Las alternativas son

1) enviar la salida a un archivo, leer el archivo cuando el proceso se realiza

$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) utilizar Perl de open para iniciar el proceso

$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, $_; 
} 

El bucle while se finaliza cuando el proceso finaliza, ya sea natural o no natural.

Answer 2

Esto es lo mejor que podría hacer.Cualquier idea sobre cómo evitar el uso de un archivo temporal en Windows sería apreciada.

#!/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

Es posible que desee utilizar la llamada al sistema de alarma como en perldoc -f alarma.