Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask

Timing and timing out Unix commands

by eyepopslikeamosquito (Archbishop)
on Nov 23, 2003 at 01:18 UTC ( #309205=perlquestion: print w/replies, xml ) Need Help??

eyepopslikeamosquito has asked for the wisdom of the Perl Monks concerning the following question:

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.

Replies are listed 'Best First'.
Re: Timing and timing out Unix commands
by Zaxo (Archbishop) on Nov 23, 2003 at 03:13 UTC

    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.

    After Compline,

Re: Timing and timing out Unix commands
by revdiablo (Prior) on Nov 23, 2003 at 02:58 UTC

    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.)

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://309205]
Approved by Roger
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others contemplating the Monastery: (3)
As of 2023-12-08 03:32 GMT
Find Nodes?
    Voting Booth?
    What's your preferred 'use VERSION' for new CPAN modules in 2023?

    Results (35 votes). Check out past polls.