Как я могу завершить системную команду с тревогой в Perl?

Question

Я использую приведенный ниже фрагмент кода в Windows. Сервер начинает слушать непрерывно после чтения от клиента. Я хочу прекратить эту команду после определенного периода времени.

Если я использую alarm () вызов функции в пределах main.pl, то он завершает всю программу Perl (здесь main.pl), поэтому я вызвал эту команду system , поместив это в отдельном файле Perl и вызов этого файла Perl (alarm.pl) в исходном файле Perl с использованием команды system .

Но таким образом я не смог получить вывод этого вызова system() ни в исходном файле Perl, ни в вызываемом файле Perl.

Может кто-нибудь, пожалуйста, сообщите мне, как завершить system() вызов или взять вывод так, как я использовал выше?

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;

В обоих направлениях display.txt всегда пусто.

Answer 1

Здесь есть несколько отдельных вопросов.

Во-первых, чтобы сигнал тревоги не убил ваш сценарий, вам нужно обработать сигнал ALRM. См. Документацию alarm . Вам не нужно два скрипта для этого.

Во-вторых, система не захватывает вывод. Вам нужен один из вариантов backtick или конвейер, если вы хотите это сделать. Ответы на это уже есть в Stackoverflow.

В-третьих, если alarm.pl помещает что-либо в display.txt , вы отбрасываете его в main.pl при повторном открытии файла при записи Режим. Вам нужно всего лишь создать файл в одном месте. Когда вы избавитесь от лишнего сценария, у вас не будет этой проблемы.

У меня недавно были некоторые проблемы с alarm и system, но переключение на IPC :: System :: Simple исправило это.

Удачи,:)

Answer 2

О чем, черт возьми, я думал? Вам не нужен фоновый процесс для этой задачи. Вам просто нужно следовать примеру в функции perldoc -f alarm и обернуть свой чувствительный ко времени код в блок 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;
}

Внутри блока eval вы можете фиксировать выходные данные обычным способом (с помощью обратных кавычек или qx() или readpipe). Хотя, если время ожидания истекло, никакого вывода не будет.

Если вам не нужны выходные данные (или вы не против взломать какое-то межпроцессное взаимодействие), почти защищенная от дурака альтернатива - установить будильник и запустить вызов system в дочернем процессе.

$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 вернется, когда будет завершена команда ребенка system, или , когда сработает тревога ребенка и убьет ребенка. $? будет содержать код завершения системного вызова или что-то еще (142 в моей системе) для необработанного SIGALRM или 255, если ваш обработчик SIGALRM вызывает die.

Answer 3

Я сталкиваюсь с подобной проблемой, которая требует:

• запустите системную команду и получите ее вывод
• тайм-аут системной команды через x секунд
• уничтожить системный командный процесс и все дочерние процессы

После долгих чтений о Perl IPC и ручном fork & exec я предложил это решение. Он реализован как имитация подпрограммы 'backtick'.

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

Answer 4

Можно использовать «timeout -n» для переноса ваших команд, если это уже распространено в вашей системе.