Timing and timing out Unix commands

[eyepopslikeamosquito]

I want to run a series of Unix commands -- killing them if they take too long -- and timing how long each command takes to run. Below is my first attempt. It is very easy to have subtle bugs in these sorts of programs, so I would appreciate any advice on how to improve the code below.

use strict;
use warnings;
use POSIX ":sys_wait_h";
use Time::HiRes qw(time sleep);
use Benchmark;
# use Benchmark ':hireswallclock';    # 5.8 and above

select(STDERR);$|=1;select(STDOUT);$|=1;   # autoflush

sub slurp_file {
   my $file = shift; local $/;
   open(my $fh, $file) or die "error:open '$file': $!";
   <$fh>;
}

my $Pid;
my $Outf = "out-$$.tmp";
my $Errf = "err-$$.tmp";

sub write_result {
   my ($killsig, $elap, $user, $sys) = @_;
   my $rc  = $? >> 8;      # return code of command
   my $sig = $? & 127;     # signal it was killed with
   warn "pid=$Pid, rc=$rc sig=$sig (killsig=$killsig)\n";
   warn "  elapsed=$elap user=$user sys=$sys\n" if defined($elap);
   my $outstr = slurp_file($Outf);
   my $errstr = slurp_file($Errf);
   unlink($Outf) or die "error: unlink '$Outf': $!";
   unlink($Errf) or die "error: unlink '$Errf': $!";
   warn "cmd stdout='$outstr'\n";
   warn "cmd stderr='$errstr'\n";
}

sub run_cmd {
   my $cmd = shift;
   warn "\nrun_cmd '$cmd' at " . scalar(localtime) . "\n";
   my $b0 = Benchmark->new();
   my $t0 = time();
   defined($Pid = fork()) or die "error: fork: $!";
   if ($Pid == 0) {
      ### child
      open(STDOUT, '>'.$Outf) or die "error create '$Outf': $!";
      open(STDERR, '>'.$Errf) or die "error create '$Errf': $!";
      exec($cmd);
      # my @args = split(' ', $cmd); exec { $args[0] } @args;
      die "error: exec: $!";
   }
   ### parent
   warn "in run_cmd, waiting for pid=$Pid\n";
   waitpid($Pid, 0);
   my $t1 = time();
   my $b1 = Benchmark->new();
   my $bd = timediff($b1, $b0);
   my ($real, $child_user, $child_sys) = @$bd[0,3,4];
   write_result(0, $t1 - $t0, $child_user, $child_sys);
}

# Run command $cmd, timing out after $timeout seconds.
# See Perl Cookbook 2nd edition, Recipe 16.21
# See also perlfaq8 "How do I timeout a slow event".
# Return 1 if $cmd run ok, 0 if timed out.
sub run_for {
   my ($cmd, $timeout) = @_;
   my $diestr = 0;
   eval {
      local $SIG{ALRM} = sub { die "alarm clock restart" };
      alarm($timeout);    # schedule alarm in $timeout seconds
      eval { run_cmd($cmd) };
      $diestr = $@ if $@;
      alarm(0);           # cancel the alarm
   };
   $diestr = $@ if $@;
   alarm(0);              # race condition protection
   return 1 unless $diestr;
   return 0 if $diestr =~ /alarm clock restart/;
   die;
}

sub kill_it
{
   warn "kill_it: pid=$Pid\n";
   kill(0, $Pid) or warn("pid $Pid is not alive\n"), return;
   my $waitpid; my $killsig = 15;
   kill($killsig, $Pid); sleep(0.1);
   for (1..3) {
      $waitpid = waitpid($Pid, &WNOHANG);
      last if $waitpid == $Pid;
      sleep(1);
   }
   if ($waitpid != $Pid && kill(0, $Pid)) {
      $killsig = 9;
      warn "pid $Pid not responding, resorting to kill 9\n";
      kill($killsig, $Pid);
      waitpid($Pid, 0);
   }
   write_result($killsig);
}

my @cmds = (
   'ls -l',
   'sleep 15',
   'sleep 4',
   'echo hello-stdout; echo hello-stderr >&2',
);
for my $cmd (@cmds) { run_for($cmd, 10) or kill_it() }

Update: see also Timing Windows commands.

[Zaxo]

It may be tidier to send SIGINT instead of SIGKILL in sub kill_it. SIGKILL is kind of a crowbar. The named signals are more readable and portable, too.

[revdiablo]

Without delving too deep, this code looks to me like it will probably do as expected. The basic idea seems ok, and without actually testing it, it looks like things should work. Again, I haven't looked at it in depth, so there might be bugs lurking I didn't notice.

I would like to make a style suggestion, though: use some whitespace! Your code is very bunched up, not only horizontally, but also vertically. Unless you're trying to make it look intentionally dense and obfuish (is this even a word?), I would avoid writing code like this. It generally hurts readability. I think some carefully placed blank lines would do wonders in this case, and a few extra spaces between some operators would be nice as well [upon further inspection, there seems to be fairly good use of spacing. It's just the lack \n's that caught my attention].

(Another very minor niggle is the use of $Pid as a global. It's pretty easy to trace where it comes from in this case, but it would be just as easy to pass this around to the various subs as necessary, and would probably help some poor schmuck trying to understand the code a few months from now.)