#
# Copyright (c) 1993 The Ohio State University.
# All rights reserved.
#
# Redistribution and use in source and binary forms are permitted
# provided that: (1) source distributions retain this entire copyright
# notice and comment, and (2) distributions including binaries display
# the following acknowledgement:  ``This product includes software
# developed by The Ohio State University and its contributors''
# in the documentation or other materials provided with the distribution
# and in all advertising materials mentioning features or use of this
# software. Neither the name of the University nor the names of its
# contributors may be used to endorse or promote products derived
# from this software without specific prior written permission.
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#

#
# Uses:
#	main'DEBUG_PROC			which bit in opt_d indicates 
#					process debugging
#	main'default_dir_mode		default directory mode
#	main'opt_d			debugging flags
#

package deadman;

#
# Deadman switch processing.  &deadman(timeout, switch1, switch2...)
# forks a process.  The child returns to continue doing whatever the
# caller was doing.  The parent watches for a deadman switch to be set
# (files named switch1... in $deadman_dir).  Once it finds one, it sends
# a HUP to the child to kill it.  Once the child is dead the parent
# exits.  This provides a transparent way of killing processes.
#
# If timeout is not 0, then the parent will also kill the child once
# that elapsed time has been reached.  This can be used to set an
# upper limit on how long a child can run.
#

$child = 0;
$sleep_time  = 5;	# time to wait between checks.

require "sys/wait.ph";

sub main'deadman {
    local($timeout, @switches) = @_;
    local($child, $switch, $now, $wait_status, $status);

    $child = fork;
    push(@children, $child) if $child != 0;

    if ($child != 0) {
        # we are the parent

        $status = 1;
	$now = time;

	if (! -d $deadman_dir) {
	    mkdir($deadman_dir, $main'default_dir_mode) || 
	      die "error ($0): can't create '$deadman_dir' ($!)\n";
	}

	chdir($deadman_dir) ||
	  die "error ($0): can't cd to '$deadman_dir' ($!)\n";

main_loop:
        while (1) {
	    #
	    # if the timeout has expired, then kill the child
	    #
	    if ($timeout > 0 && (time - $now) > $timeout) {
		if ($child != 0) {
		    warn "error ($0): timed out after $timeout seconds\n";
		    print "$$: child timed out, sent HUP to $child\n" 
		      if $main'opt_d & $main'DEBUG_PROC;
		    last main_loop if kill 3, $child == 0;
		}
	    }

	    #
	    # one of the switches has been released,
	    # so send the child the QUIT signal and wait 
	    # for it to exit.
	    #
switch_loop:
	    foreach $switch (@switches) {
		if (-f $switch) {
		    if ($child != 0) {
			print "$$: sent HUP to $child\n" 
			  if $main'opt_d & $main'DEBUG_PROC;
			last main_loop if kill 3, $child == 0;
		    }
		    last switch_loop;
		}
	    }
	
	    #
	    # if the child is dead, then we must die
	    #
	    $result = waitpid($child, &WNOHANG);
	    $wait_status = $?;
	    print "$$: waitpid for $child: $result, $status\n" 
	      if $main'opt_d & $main'DEBUG_PROC;
	    if ($result == $child) {
		$status = $wait_status >> 8;
	        print "$$: the child is dead, so we are dying with status $status...\n" 
		  if $main'opt_d & $main'DEBUG_PROC;
	        last main_loop;
	    } elsif ($result == -1) {
		print "$$: waitpid returned -1, not sure what to do?" 
		  if $main'opt_d & $main'DEBUG_PROC;
		last main_loop;
	    }
	  
	    sleep($sleep_time);
	}

        exit($status);
    }
}