Viewing file: timeout.pl (4.14 KB) -rwxr-xr-x Select action/file-type: (+) | (+) | (+) | Code (+) | Session (+) | (+) | SDB (+) | (+) | (+) | (+) | (+) | (+) |
#!/usr/bin/perl
## timeout ## ## (c) 2004 Piotr Roszatycki <dexter@debian.org>, GPL ## ## $Id$
=head1 NAME
timeout - Run command with bounded time.
=head1 SYNOPSIS
B<timeout> S<B<-h>>
B<timeout> S<[-I<signal>]> I<time> I<command> ...
=cut
use 5.006; use strict; use Config; BEGIN { unless( eval "require Pod::Usage" ) { die "Please install the perl-modules package if you want this script to work\n"; } } use POSIX qw(setsid);
##############################################################################
## Default values for constant variables ##
## Program name my $NAME = "timeout";
## Program version my $VERSION = "0.1+he1";
##############################################################################
## Signals to handle ## my @signals = qw( HUP INT QUIT TERM SEGV PIPE XCPU XFSZ ALRM );
##############################################################################
## Signal to send after timeout. Default is KILL. my $signal = 'KILL';
## Time to wait my $time = 0;
## Command to execute as array of arguments my @command = ();
## PID for fork function my $child_pid;
## PID for wait function my $pid;
##############################################################################
## usage() ## ## Prints usage message. ## sub usage() { pod2usage(2); }
## help() ## ## Prints help message. ## sub help() { pod2usage(-verbose=>1, -message=>"$NAME $VERSION\n"); }
## signal_handler($sig) ## ## Handler for signals to clean up child processes ## sub signal_handler($) { my ($sig) = @_; if ($sig eq 'ALRM') { printf STDERR "Timeout: aborting command ``%s'' with signal SIG%s\n", join(' ', @command), $signal; } else { printf STDERR "Got signal SIG%s: aborting command ``%s'' with signal SIG%s\n", $sig, join(' ', @command), $signal; } kill $signal, -$child_pid; exit -1; }
##############################################################################
## Main subroutine ##
## Parse command line arguments my $arg = $ARGV[0]; if ($arg =~ /^-(.*)$/) { my $opt = $1; if ($arg eq '-h' || $arg eq '--help') { help(); } elsif ($opt =~ /^[A-Z0-9]+$/) { if ($opt =~ /^\d+/) { #Convert numeric signal to name by using the perl interpreter's #configuration: usage() unless defined $Config{sig_name}; $signal = (split(' ', $Config{sig_name}))[$opt]; } else { $opt =~ s/^SIG//; $signal = $opt; } shift @ARGV; } else { usage(); } }
usage() if @ARGV < 2;
$arg = $ARGV[0];
usage() unless $arg =~ /^\d+$/;
$time = $arg;
shift @ARGV;
@command = @ARGV;
## Fork for exec if (! defined($child_pid = fork)) { die "Could not fork: $!\n"; exit 1; } elsif ($child_pid == 0) { ## child
## Set new process group setsid; ## Execute command exec @command or die "Can not run command `" . join(' ', @command) . "': $!\n"; }
## parent
## Set the handle for signals foreach my $sig (@signals) { $SIG{$sig} = \&signal_handler; }
## Set the alarm alarm $time;
## Wait for child while (($pid = wait) != -1 && $pid != $child_pid) {}
## Clean exit exit ($pid == $child_pid ? $? >> 8 : -1);
__END__
=head1 DESCRIPTION
B<timeout> executes a command and imposes an elapsed time limit. The command is run in a separate POSIX process group so that the right thing happens with commands that spawn child processes.
=head1 OPTIONS
=over 8
=item -I<signal>
Specify an optional signal name to send to the controlled process. By default, B<timeout> sends B<KILL>, which cannot be caught or ignored.
=item I<time>
The elapsed time limit after which the command is terminated.
=item I<command>
The command to be executed.
=back
=head1 RETURN CODES
=over 8
=item 0..253
Return code from called command.
=item 254
Internal error. No return code could be fetched.
=item 255
The timeout was occured.
=back
=head1 AUTHOR
(c) 2004 Piotr Roszatycki E<lt>dexter@debian.orgE<gt>
Inspired by timeout.c that is part of The Coroner's Toolkit.
All rights reserved. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License, the latest version.
|