¿Cómo puedo terminar un comando del sistema con alarma en Perl?

system

Question

Estoy ejecutando el siguiente fragmento de código en Windows. El servidor comienza a escuchar continuamente después de leer del cliente. Quiero terminar este comando después de un período de tiempo.

Si uso la llamada a la función alarm () dentro de main.pl , entonces termina todo el programa Perl (aquí main.pl ), así que llamé a este comando del sistema colocándolo en un archivo Perl por separado y llamando a este archivo Perl ( alarm.pl ) en el archivo Perl original utilizando el comando del sistema .

Pero de esta forma no pude tomar la salida de este system() llamada ni en el archivo Perl original ni en un solo archivo llamado Perl.

¿Podría alguien decirme por favor la forma de finalizar una llamada al system() o tomar la salida de esa manera que utilicé anteriormente?

main.pl

my @output = system("alarm.pl");
print"one iperf completed/n";
open FILE, ">display.txt" or die $!;
print FILE @output_1;
close FILE;

alarm.pl

alarm 30;
my @output_1 = readpipe("adb shell cd /data/app; ./iperf -u -s -p 5001");
open FILE, ">display.txt" or die $!;
print FILE @output_1;
close FILE;

En ambos sentidos, display.txt siempre está vacío.

Answer 1

¿Qué demonios estaba pensando? No necesita un proceso en segundo plano para esta tarea. Solo necesita seguir el ejemplo en la función de perldoc -f alarm y ajustar su código sensible al tiempo en un bloque eval .

my $command = "adb shell cd /data/app; ./iperf -u -s -p 5001";
my @output;
eval {
local $SIG{ALRM} = sub { die "Timeout/n" };
alarm 30;
@output = `$command`;
alarm 0;
};
if ($@) {
warn "$command timed out./n";
} else {
print "$command successful. Output was:/n", @output;
}

Dentro del bloque eval , puede capturar su salida de la manera habitual (con readpipe o readpipe qx() o readpipe ). Aunque si la llamada expira, no habrá salida.

Si no necesita la salida (o no le importa piratear alguna comunicación entre procesos juntos), una alternativa a prueba de idiotas es configurar la alarma y ejecutar la llamada al system en un proceso secundario.

$command = "adb shell cd /data/app; ./iperf -u -s -p 5001";
if (($pid = fork()) == 0) {
# child process
$SIG{ALRM} = sub { die "Timeout/n" }; # handling SIGALRM in child is optional
alarm 30;
my $c = system($command);
alarm 0;
exit $c >> 8; # if you want to capture the exit status
}
# parent
waitpid $pid, 0;

waitpid volverá cuando waitpid el comando del system del niño, o cuando la alarma del niño se apague y mate al niño. $? mantendrá el código de salida de la llamada del sistema, o alguna otra cosa (142 en mi sistema) para un SIGALRM no controlado o 255 si su manejador SIGALRM llama a die .

Answer 2

Podría usar "timeout -n" para ajustar sus comandos si eso ya es común en su sistema.

Answer 3

Aquí hay algunos problemas separados.

Primero, para evitar que la alarma mate tu script, debes manejar la señal ALRM. Ver la documentación de la alarma . No deberías necesitar dos scripts para esto.

En segundo lugar, el sistema no captura la salida. Necesitas una de las variantes de retroceso o una tubería si quieres hacer eso. Ya hay respuestas para eso en .

En tercer lugar, si alarm.pl coloca algo en display.txt , lo descarta en main.pl cuando vuelve a abrir el archivo en modo de escritura. Solo necesita crear el archivo en un solo lugar. Cuando te deshagas del guión adicional, no tendrás este problema.

Recientemente tuve algunos problemas con la alarm y el system , pero el cambio a IPC :: System :: Simple solucionó eso.

Buena suerte, :)

Answer 4

Me encuentro con un problema similar que requiere:

• ejecutar un comando del sistema y obtener su resultado
• Agote el comando del sistema después de x segundos
• matar el proceso de comando del sistema y todos los procesos secundarios

Después de leer mucho sobre Perl IPC y manual fork & exec, salí con esta solución. Se implementa como una subrutina ''backtick'' simulada.

use Error qw(:try);
$SIG{ALRM} = sub {
my $sig_name = shift;
die "Timeout by signal [$sig_name]/n";
};
# example
my $command = "vmstat 1 1000000";
my $output = backtick(
command => $command,
timeout => 60,
verbose => 0
);
sub backtick {
my %arg = (
command => undef,
timeout => 900,
verbose => 1,
@_,
);
my @output;
defined( my $pid = open( KID, "-|" ) )
or die "Can''t fork: $!/n";
if ($pid) {
# parent
# print "parent: child pid [$pid]/n" if $arg{verbose};
try {
alarm( $arg{timeout} );
while (<KID>) {
chomp;
push @output, $_;
}
alarm(0);
}
catch Error with {
my $err = shift;
print $err->{-text} . "/n";
print "Killing child process [$pid] .../n" if $arg{verbose};
kill -9, $pid;
print "Killed/n" if $arg{verbose};
alarm(0);
}
finally {};
}
else {
# child
# set the child process to be a group leader, so that
# kill -9 will kill it and all its descendents
setpgrp( 0, 0 );
# print "child: pid [$pid]/n" if $arg{verbose};
exec $arg{command};
exit;
}
wantarray ? @output : join( "/n", @output );
}