#!/usr/bin/perl

use strict;
use warnings;


use version qw( qv );  our $VERSION = qv('1.0.0');


use Errno          qw( EINTR );
use File::Basename qw( basename );
use Getopt::Long   qw( );


# ---


# Populated by process_args from values from the command line.
my $prog;
my $opt_timeout;
my $opt_grace;
my $opt_quiet;
my $cmd;
my @args;


sub show_help {
   print("$prog $VERSION (Perl $])\n");
   print <<'__EOI__';

usage: $prog [<options>] [--] <command> [<args>]
       $prog [ -h | --help | -v | --version ]

Options:
 -t, --timeout=<timeout>  Terminate after this many seconds.     [requ
+ired]
 -g, --grace=<timeout>    Allow this many secondss to terminate. [defa
+ult=20]

 -q, --quiet              Silence informational messages.

 -v. --version            Show version info.
 -h, --help               Show usage informaion.
__EOI__
   exit( 0 );
}


sub show_version {
   print("$prog $VERSION (Perl $])\n");
   exit( 0 );
}


sub show_usage {
   my ( $msg ) = @_;
   warn( $msg ) if defined $msg;
   warn("\"$prog --help\" for usage help.\n");
   exit( 1 );
}


sub process_args {
   $prog = basename($0);

   local *make_validator = sub {
      my ( $opt_var, $seen_var, $validator ) = @_;

      return sub {
         my ( $opt, $val ) = @_;

         warn( "Option $opt already specified\n" )
            if $seen_var && $$seen_var++;

         die( "Invalid value for option $opt\n" )
            if $validator && !$validator->( $val );

         $$opt_var = $val;
      };
   };

   $opt_timeout = undef;
   $opt_grace   = 20;

   my $seen_t;
   my $seen_g;

   Getopt::Long::Configure(qw( posix_default ));

   Getopt::Long::GetOptions(
      'help|h|?'    => \&show_help,
      'version|v'   => \&show_version,
      'timeout|t=i' => make_validator( \$opt_timeout, \$seen_t, sub { 
+$_[0] =~ /^\d+\z/ && $_[0] > 0 } ),
      'grace|g=i'   => make_validator( \$opt_grace,   \$seen_g, sub { 
+$_[0] =~ /^\d+\z/ } ),
      'quiet|q'     => \$opt_quiet,
   )
      or show_usage();

   show_usage( "Timeout must be specified\n")
      if !$seen_t;

   show_usage( "Too few arguments\n" )
      if @ARGV < 1;

   ($cmd, @args) = @ARGV;
}


# ---


# Uninterruptable sleep
sub deep_sleep {
   my ($period) = @_;
   my $end = time() + $period;
   for (;;) {
      return 1 if $period <= 0;
      return 1 if sleep($period);
      return 0 if $! != EINTR;
      $period = $end - time();
   }
}


{
   process_args();

   $SIG{CHLD} = sub {
      wait();  # Grab status and clean up zombie
      exit( ($? & 127) ? 1 : ($? >> 8) );
   };

   defined( my $pid = fork() )
      or die("$prog: fork: $!\n");

   if (!$pid) {
      # Child
      exec { $cmd } $cmd, @args
         or die("$prog: exec: $!\n");
   }

   deep_sleep($opt_timeout);

   if ($opt_grace) {
      warn("$prog: Termination requested\n") if !$opt_quiet;
      kill(TERM => $pid);
      deep_sleep($opt_grace);
   }

   warn("$prog: Termination forced\n") if !$opt_quiet;
   kill(KILL => $pid);
   $SIG{CHLD} = 'IGNORE';
   exit(1);
}
[download]