Timeout for launching a bash command in perl

Question

I have a usecase where I have to fire a bash command from perl and need that command to exit within a specified timeout Currently I am using this moudle

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

(As timeout is necessary I am not using system() to make the call)

This function returns 1 if shell script exitted with non-zero exit code or the command timed out.

Issues

1. This function returns just 1 / 0 based on the command passed or failed(I need the exact exit code of the bash script)
2. If it is 1, I do not get to know if script exitted with a non-zero exit code OR there was a timeout(Distinguish between a timeout and shell script failure)
3. pid of called process is unknown (so that if the scipt fails due to timeout, I need to kill it)

It is important for me to satisfy both of the above criteria(I know very well how to do this in python, but could not get a solution for perl)

I do not know if forking a current process in perl and then monitoring it with SIGALRM will help (Forking will give me pid of the forked process and NOT the bash script which I have launched from that fork. Will killing the fork, also kill the bash process it launched?)

Thanks for the help

Answer 1

For advanced tasks when running external commands, IPC::Run is a fairly good choice. The following should cover all the cases you mentioned. (I admit that using a regex on the error message is not the most elegant solution, but the point here was to demo the possibilities with this module.)

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

Output (slightly redacted):

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

I would recommend the approaches by @mr_ron and @haukex in the other answers. Using a well tested module like IPC::Run or IPC::Cmd is the safe approach. Anyway, I have experimented a little bit with a more low level approach here:

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

Your system might have the gnu timeout command which sets an exit code of 124 if it kills the child process with timeout and returns the command exit code otherwise. If you don't have gnu timeout, you did mention you have bash which means you could use my bash emulator for gnu timeout, https://github.com/ronaldxs/bash-timeout, and I would happily look forward to any feedback. Looking at the source code for System::Timeout, it is based on CPAN module IPC::Cmd which suggests the following as another starting point:

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

OUTPUT:

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