#! /usr/bin/perl -w
# $Header: /auto/homes/pb22/pl/RCS/timeout.pl,v 1.6 2009/09/03 08:32:56 pb22 Exp $
# Use "pod2text" for info

=head1 NAME

timeout - run a command with a protective timeout

=head1 SYNOPSIS

B<timeout> [ --fork ] [ --verbose ] [ --minimum ] I<seconds> I<command and arguments>

=head1 OPTIONS

=over 4

=item B<--help>

generate help info.

=item B<--verbose>

show what's happening

=item B<--minimum>

wait up to I<seconds> and if not exited by then, exit with RC 3.
Implies B<--fork>.

=item B<--fork>

Fork a child process to run the command,
and send sucessively kill signals.

This is the default if the command name includes the work "fork", e.g. timeout-fork

=back

=head1 DESCRIPTION

Set an alarm for I<seconds> seconds, fork if B<--fork>, and exec the requested command.
If forking, arrange to send various kill signals to kill the child.

Based on timeout.c and timeout-fork.c in /global/src/usr.etc/src/

=cut

use Getopt::Long qw(:config require_order);
use Pod::Usage;

$fork = $ENV{'TIMEOUT_FORK'};
$verbose = $ENV{'TIMEOUT_VERBOSE'};
$fork = 1 if ! defined($fork) && $0 =~ /fork/;
$minimum = 0;

%opts = (
	"minimum|m"	=> \$minimum,
	"fork|f"	=> \$fork,
	"help|h"	=> \$help,
	"verbose|v"	=> \$verbose,
);

# Keep track of the signals to send, and how long to sleep
$stage = $[;
@sleeps	= ( 1, 1, 1, 1);
@sigs	= (14, 1, 2, 9); # ALRM, HUP, INT, KILL

# Decode supplied arguments
GetOptions (%opts) || pod2usage();
pod2usage(-verbose => 2) if $help;

# Expect at least a time interval and a command.
pod2usage() unless $#ARGV > 0;

# Check that ther time interval is an integer
$timeout = shift;
pod2usage() unless ($timeout =~ /^\d+$/ || $timeout =~ /^\d+\.\d+$/) && $timeout >= 1;

$fork = 1 if $minimum;

# Set the initial alarm, fork if requested, then run the command.
alarm($timeout);
unless ($fork  && ($id = fork)) {
	# setsid;
	print STDERR "# $$: exec '@ARGV'\n" if $verbose;
	exec(@ARGV);
	die("$0: exec of '@ARGV' failed: $!\n");
}

# ========= Only get here if this is the "watcher" process. ==================

# Catch ALRM
$SIG{'ALRM'} = 'sig_handler';

# Wait for the child which we just forked.
print STDERR "# $$: Parent -- wait for child $id ...\n" if $verbose;
while (($rc = wait()) > 0) {
	print STDERR "# $$: Parent -- wait gave $rc $?\n" if $verbose;
	last if $rc == $id;
}

$exitsig = $? & 0xff;
$exitrc = $? >> 8;

# Have found the expected child.
print STDERR "# $$: Parent -- waited for child $id ... $rc $? $exitsig $exitrc\n" if $verbose;


# Return how many signals were sent.
exit($exitrc || $exitsig || $stage);

# ----------------------------------------------------------------------------

# signal handler to reactivate the handler, kill the child, and set another alarm
sub sig_handler {
	if ($minimum) {
		print STDERR "# $$: sig_handler m=$minimum got signal @_: exit(3)\n" if $verbose;
		exit(3);
	}
	$SIG{'ALRM'} = 'sig_handler';
	print STDERR "# $$: sig_handler m=$minimum stage=$stage/$#sigs: got signal @_: kill $sigs[$stage] $id, then wait $sleeps[$stage]s\n" if $verbose;
	exit(1) if $stage > $#sigs;
	kill $sigs[$stage], $id;
	alarm($sleeps[$stage++]);
}
