hope I got the merge wright...

[monitor.git] / tools / timeout.pl

diff --git a/tools/timeout.pl b/tools/timeout.pl
new file mode 100755 (executable)
index 0000000..7ce8367
--- /dev/null
+++ b/tools/timeout.pl
@@ -0,0 +1,275 @@
+#!/usr/bin/perl
+
+## timeout
+##
+## (c) 2004-2007 Piotr Roszatycki <dexter@debian.org>, GPL
+##
+## $Id: timeout.pl 4 2007-06-19 11:58:08Z piotr.roszatycki $
+
+=head1 NAME
+
+timeout - Run command with bounded time.
+
+=head1 SYNOPSIS
+
+B<timeout> S<B<-h>>
+
+B<timeout>
+S<[-I<signal>]>
+I<time>
+I<command>
+...
+
+=head1 README
+
+B<timeout> executes a command and imposes an elapsed time limit.  When the
+time limit is reached, B<timeout> sends a predefined signal to the target
+process.
+
+=cut
+
+
+use 5.006;
+use strict;
+
+use Config;
+use POSIX ();
+
+
+##############################################################################
+
+## Default values for constant variables
+##
+
+## Program name
+my $NAME = 'timeout';
+
+## Program version
+my $VERSION = '0.11';
+
+
+##############################################################################
+
+## 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() {
+    # Lazy loading for Pod::Usage
+    eval 'use Pod::Usage;';
+    die $@ if $@;
+
+    pod2usage(2);
+}
+
+
+## help()
+##
+## Prints help message.
+##
+sub help() {
+    # Lazy loading for Pod::Usage
+    eval 'use Pod::Usage;';
+    die $@ if $@;
+
+    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 ``%s'' with 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
+    POSIX::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);
+
+
+=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 PREREQUISITES
+
+=over
+
+=item *
+
+L<perl> >= 5.006
+
+=item *
+
+L<POSIX>
+
+=back
+
+=head1 COREQUISITES
+
+=over
+
+=item
+
+L<Pod::Usage>
+
+=back
+
+=head1 SCRIPT CATEGORIES
+
+UNIX/System_administration
+
+=head1 AUTHORS
+
+Piotr Roszatycki E<lt>dexter@debian.orgE<gt>
+
+=head1 LICENSE
+
+Copyright 2004-2007 by 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.