Тайм-аут для запуска команды bash в perl

Question

У меня есть сценарий использования, когда мне нужно запустить команду bash из perl, и мне нужна эта команда для выхода в течение указанного времени В настоящее время я использую этот moudle

use System::Timeout qw(timeout);
timeout(10, "my bash script")

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

Эта функция возвращает 1, если скрипт оболочки завершил работу с ненулевым кодом завершения или время ожидания команды истекло.

Вопросы

1. Эта функция возвращает только 1/0 в зависимости от пройденной или не выполненной команды (мне нужен точный код завершения сценария bash)
2. Если это 1, я не узнаю, был ли скрипт завершен с ненулевым кодом завершения ИЛИ был ли тайм-аут (Различают тайм-аут и сбой скрипта оболочки)
3. pid вызываемого процесса неизвестен (поэтому, если scipt не удается из-за тайм-аута, мне нужно его убить)

Для меня важно выполнить оба вышеперечисленных критерия (я очень хорошо знаю, как это сделать на python, но не смог найти решение для perl)

Я не знаю, поможет ли разветвление текущего процесса в perl и последующее наблюдение за ним с помощью SIGALRM (Форкинг даст мне pid разветвленного процесса, а НЕ сценария bash, который я запустил с этой вилки. Будет ли уничтожать вилку, а также уничтожать запущенный ею процесс bash?)

Спасибо за помощь

Answer 1

Для сложных задач при запуске внешних команд IPC::Run является довольно хорошим выбором. Следующее должно охватывать все случаи, которые вы упомянули. (Я признаю, что использование регулярного выражения в сообщении об ошибке - не самое элегантное решение, но цель здесь заключалась в демонстрации возможностей этого модуля.)

use warnings;
use strict;
use IPC::Run qw/ start timeout /;
use Try::Tiny;

my @commands = (
        ['perl','-e','sleep 1'], # success
        ['perl','-e','sleep 10'], # failure due to timeout
        ['perl','-e','exit 123'], # failure due to nonzero exit code
        ['perl','-e','kill "INT", $$'], # process exits due to signal
        ['this_command_doesnt_exist'], # other failure
    );

for my $cmd (@commands) {
    my $h;
    try {
        print "\nRunning ",join(' ',@$cmd),"\n";
        $h = start $cmd, timeout(2);
        $h->finish or die "finish with \$?=$?";
        print "Success\n";
    }
    catch {
        if (/timeout/i) {
            warn "Timeout Error: $_";
            warn "killing child process\n";
            defined $h && $h->kill_kill;
        }
        elsif (/\$\?/) {
            warn "Exit Code Error: $_";
            # from http://perldoc.perl.org/functions/system.html
            if ($? == -1) { print "failed to execute: $!\n" }
            elsif ($? & 127)
                { printf "child died with signal %d, %s coredump\n",
                    ($? & 127),  ($? & 128) ? 'with' : 'without' }
            else { printf "child exited with value %d\n", $? >> 8 }
        }
        else { warn "Other Error: $_" }
    };
}

Вывод (слегка отредактирован):

Running perl -e sleep 1
Success

Running perl -e sleep 10
Timeout Error: IPC::Run: timeout on timer #2 at ...
killing child process

Running perl -e exit 123
Exit Code Error: finish with $?=31488 at ...
child exited with value 123

Running perl -e kill "INT", $$
Exit Code Error: finish with $?=2 at ...
child died with signal 2, without coredump

Running this_command_doesnt_exist
Other Error: Command 'this_command_doesnt_exist' not found in ... at ...

Answer 2

Я бы порекомендовал подходы @mr_ron и @haukex в других ответах. Использование хорошо проверенного модуля, такого как IPC::Run или IPC::Cmd, является безопасным подходом. Во всяком случае, я немного поэкспериментировал с подходом более низкого уровня:

#! /usr/bin/env perl

use feature qw(say);
use strict;
use warnings;
use IO::Select;
use IPC::Open3;
use Symbol 'gensym';

# specify a command and a timeout
my $cmd = 'echo Hello; sleep 5; echo Bye; exit 2';
my $timeout = 3;

# Run the command with the given timeout:
local $SIG{CHLD} = 'IGNORE'; # Automatically reap dead children
my $cmd_err = gensym;
my $cmd_pid = open3( my $cmd_in, my $cmd_out, $cmd_err, $cmd );
say "Command PID: ", $cmd_pid;
my $timer_err = gensym;
my $timer_pid = open3( my $timer_in, my $timer_out, $timer_err, "sleep $timeout" );

my $timed_out = 0;
# We only use STDOUT here for simplicity, if needed you can also add
#  the STDERR handle of the command to the select loop..
my $select = IO::Select->new($cmd_out, $timer_out);
OUTER: while (1) {
    my @ready = $select->can_read;
    for my $fh (@ready) {
        my $fd   = $fh->fileno();
        if ( $fd == $timer_out->fileno() ) {
            say "Timed out";
            $timed_out = 1;
            last OUTER;
        }
        else { # The command handle is ready for reading..
            my $line = <$fh>;
            # An undefined value for $line, signals that the command processes
            #  has finished..
            last OUTER if !defined $line;
            print $line; # echo the line from the command to our STDOUT
        }
    }
}
if ( $timed_out ) {
    kill 'KILL', $cmd_pid;
}
else { # The command finished first, the timer may still be running..
    kill 'KILL', $timer_pid;
    waitpid( $cmd_pid, 0 );  # Reap the child, and get exit code
    my $child_exit_status = $? >> 8;
    say "Exit code: ", $child_exit_status;
}

Answer 3

В вашей системе может быть команда gnu timeout, которая устанавливает код завершения 124, если она убивает дочерний процесс с истечением времени ожидания, и возвращает код завершения команды в противном случае. Если у вас нет gnu timeout, вы упомянули, что у вас есть bash, что означает, что вы можете использовать мой эмулятор bash для gnu timeout, https://github.com/ronaldxs/bash-timeout,, и я с радостью с нетерпением буду ждать любых отзывов. Глядя на исходный код System::Timeout, он основан на модуле CPAN IPC::Cmd, который предлагает следующее в качестве еще одной отправной точки:

#!/usr/bin/env perl

use Modern::Perl;
use Data::Dump;

use IPC::Cmd 'run_forked';

my $rc = run_forked('sleep 5; exit 3', { timeout => 2 });

dd $rc;

ВЫВОД:

{
  child_pgid       => 69066,
  err_msg          => "ran more than [2] seconds\n",
  exit_code        => 0,
  ...
  timeout          => 2,
}