How can I timeout a forked process that might hang?

Question

I am writing a Perl script that will write some inputs and send those inputs to an external program. There is a small but non-zero chance that this program will hang, and I want to time it out:

my $pid = fork;
if ($pid > 0){
    eval{
        local $SIG{ALRM} = sub { die "TIMEOUT!"};
        alarm $num_secs_to_timeout;
        waitpid($pid, 0);
        alarm 0;
    };
}
elsif ($pid == 0){
    exec('echo blahblah | program_of_interest');
    exit(0);
}

As it stands now, after $num_secs_to_timeout, program_of_interest still persists. I tried to kill it in the anonymous subroutine for $SIG{ALRM} as follows:

local $SIG{ALRM} = sub{kill 9, $pid; die "TIMEOUT!"}

but this doesn't do anything. program_of_interest is still persisting. How do I go about killing this process?

Answer 1

I was able to successfully kill my exec()ed process by killing the process group, as shown as the answer to question In perl, killing child and its children when child was created using open. I modified my code as follows:

my $pid = fork;
if ($pid > 0){
    eval{
        local $SIG{ALRM} = sub {kill 9, -$PID; die "TIMEOUT!"};
        alarm $num_secs_to_timeout;
        waitpid($pid, 0);
        alarm 0;
    };
}
elsif ($pid == 0){
    setpgrp(0,0);
    exec('echo blahblah | program_of_interest');
    exit(0);
}

After timeout, program_of_interest is successfully killed.

Answer 2

The above code (by strictlyrude27) didn't work out of the box, because -$PID is spelt in capitals. (BTW: there's also: http://www.gnu.org/software/coreutils/manual/html_node/timeout-invocation.html)

Here's an example with test:

#!/usr/bin/perl
use strict;
use warnings;
use File::Basename;

my $prg = basename $0;
my $num_secs_sleep = 2;
my $num_secs_to_timeout = 1;
my $orig_program = "sleep $num_secs_sleep; echo \"Look ma, survived!\"";
my $program = $orig_program;
my $expect = "";

if (@ARGV){
  if($ARGV[0] eq "test"){
    test();
    exit 0;
  } elsif (@ARGV == 1) {
    $num_secs_to_timeout = $ARGV[0];
  } elsif (@ARGV == 2) {
    $program = $ARGV[0];
    $num_secs_to_timeout = $ARGV[1];
  } else {
    die "Usage: $prg [ \"test\" | [program] seconds ] "
  }
}

if($orig_program eq $program) {
  if(@ARGV < 2) {
    $expect = $num_secs_to_timeout > $num_secs_sleep ?
      "(we expected to survive.)" : "(we expected to TIME OUT!)";
  }
  print STDERR "sleeping: $num_secs_sleep seconds$/";
}

print STDERR <<END;
  timeout after: $num_secs_to_timeout seconds,
  running program: '$program'
END

if($orig_program eq $program) {
  print STDERR "$expect$/";
}

exit Timed::timed($program, $num_secs_to_timeout);

sub test {
  eval "use Test::More qw(no_plan);";
  my $stdout;
  close STDOUT;
  open STDOUT, '>', \$stdout or die "Can't open STDOUT: $!";
  Timed::timed("sleep 1", 3);
  is($stdout, undef);
  Timed::timed("sleep 2", 1);
  is($stdout, "TIME OUT!$/");
}

################################################################################
package Timed;
use strict;
use warnings;

sub timed {
  my $retval;
  my ($program, $num_secs_to_timeout) = @_;
  my $pid = fork;
  if ($pid > 0){ # parent process
    eval{
      local $SIG{ALRM} = 
        sub {kill 9, -$pid; print STDOUT "TIME OUT!$/"; $retval = 124;};
      alarm $num_secs_to_timeout;
      waitpid($pid, 0);
      alarm 0;
    };
    return defined($retval) ? $retval : $?>>8;
  }
  elsif ($pid == 0){ # child process
    setpgrp(0,0);
    exec($program);
  } else { # forking not successful
  }
}