Question

我有一个用例，我必须从perl触发bash命令并需要该命令在指定的超时内退出目前我正在使用这个模块

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

（由于需要超时，我没有使用system（）来进行调用）

如果shell脚本使用非零退出代码或命令超时，则此函数返回1.

问题

此函数仅根据传递或失败的命令返回1/0（我需要bash脚本的确切退出代码）
如果是1，我不知道脚本是否已退出非零退出代码或是否存在超时（区分超时和shell脚本失败）
调用进程的pid是未知的（因此如果scipt因超时而失败，我需要将其删除）

对我来说，满足上述两个标准非常重要（我非常清楚如何在python中执行此操作，但无法获得perl的解决方案）

我不知道是否在perl中分配当前进程，然后使用SIGALRM监视它将有所帮助（分叉会给我分叉进程的pid而不是我从那个分支启动的bash脚本。会杀掉fork，还会杀掉它启动的bash进程吗？）

感谢您的帮助

Answer 1

您的系统可能具有gnu timeout命令，如果它以超时方式终止子进程，则设置退出代码为124，否则返回命令退出代码。如果你没有gnu timeout，你确实提到你有bash，这意味着你可以将我的bash模拟器用于gnu System::Timeout，https://github.com/ronaldxs/bash-timeout，我很乐意期待任何反馈。查看IPC::Cmd的源代码，它基于CPAN模块#!/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,
}

输出：

fetch()

Answer 2

对于运行外部命令的高级任务，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 3

我会在其他答案中推荐@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;
}

在perl中启动bash命令的超时

3 个答案: