#!@PERL@ -w
# -*- perl -*-
#
# run a program with a time limit and output limit
#
#  Usage:        % watchdog 10 400 foo bar baz
#
#  The "30" says that the program should be killed if thirty seconds
#  go by with no output.  The "400" says the program should be killed
#  if it produces more than four hundred lines of output.  The
#  remaining arguments are the command to run.
#
#  When a program misbehaves, we send it a SIGTERM, wait ten seconds,
#  and then send a SIGKILL.  The initial signal and delay should let
#  most programs shut down in an orderly manner, while the kill signal
#  will zap processes that are well and truly wedged.


use strict;
use IO::Handle;
use IO::Pipe;
use IO::Select;
use POSIX qw(SIGTERM SIGKILL WNOHANG);

use Data::Dumper;

$| = 1;


########################################################################


@ARGV >= 3 or die "Usage: $0 <timeout> <lines> <program> [<arg> <arg> ...]\n";
my $timeout = shift;
my $lines = shift;
my $lines_unlim = ($lines <= 0);
$lines += 1;


########################################################################


sub behead ($$) {
    my ($pid, $reason) = @_;
    my $retry;
    my $result;
    kill SIGTERM, $pid;
    $retry = 10;
    while ( (waitpid($pid, &WNOHANG), $result = $?) < 0) {
      sleep 1;
      last unless ($retry--);
    }
    if ($result < 0) {
      kill SIGKILL, $pid;
      $retry = 2;
      while ( (waitpid($pid, &WNOHANG), $result = $?) < 0) {
        sleep 1;
        last unless ($retry--);
      }
    }
    die "program killed: $reason\n";
}


########################################################################


my $out = new IO::Pipe;
my $err = new IO::Pipe;
my $pid = fork;

if ($pid) {
    $out->reader;
    $err->reader;
    my %route = ( $out => IO::Handle->new_from_fd(1, 'w'),
		  $err => IO::Handle->new_from_fd(2, 'w') );
    my $select = new IO::Select($out, $err);
    my @ready;

    while (@ready = $select->can_read($timeout)) {
	foreach (@ready) {
	    my $text = $_->getline;
	    if (defined $text) {
		behead $pid, "too much output" if (!$lines_unlim && !--$lines);
		#$route{$_}->print("$lines: $text");
		$route{$_}->print("$text");
		$route{$_}->flush;
	    } else {
		$select->remove($_);
	    }
	}
    }

    if ($select->count) {
      behead $pid, "timeout";
    }
    my $retry = 5;
    my $result;
    while ( (waitpid($pid, &WNOHANG), $result = $?) < 0) {
      #print "sleeping\n";
      sleep 1;
      last unless ($retry--);
    }
    #print "result=$result\n";
    exit (($result >> 8) || ($result & 127));
    
} else {
    $out->writer;
    $err->writer;
    open STDOUT, ">&=" . $out->fileno or die "cannot connect stdout: $!\n";
    open STDERR, ">&=" . $err->fileno or die "cannot connect stderr: $!\n";
    exec { $ARGV[0] } @ARGV or die "cannot exec $ARGV[0]: $!\n";
}