#!/usr/bin/perl5.87 -w use strict; use POSIX ":sys_wait_h"; # For WNOHANG FLAG in waitpid use Carp; use Proc::Killfam; execute_script(); print "############################\n"; print "## Program EXIT ##\n"; print "############################\n"; ######################################################################## # End of main program ######################################################################## sub execute_script { my $DEBUG = 1; my $process_id; my $kill_proc_id; my $ret; my $full_cmd = "prompt.pl"; if ($DEBUG) {print "1:Running Execute Script PPID# $$\n";} ################################### # Fork the script command child ################################### if ($process_id = fork) { # Parent process if ($DEBUG) {print "2:CMD Parent START PPID# $$, CPID(CMD)# $process_id\n";} } elsif ($process_id == 0) { ################################ # Script Command Child process ################################ if ($DEBUG) {print "3:CMD Child START-running CMD. CPID(CMD)# $$\n";} # exec needed so as to not consume status for $? later exec("prompt.pl"); # Need exit in Child process (never reaches here) exit(0); } else { print "Can't fork for CMD Child: $!\n"; } if ($DEBUG) {sleep(1);} # Just to order debug messages ################################### # Fork the kill prompt child ################################### if ($kill_proc_id = fork) { # Parent process if ($DEBUG) {print "4:Kill Parent START PPID# $$, CPID(kill)# $kill_proc_id\n";} } elsif ($kill_proc_id == 0) { ############################# # Kill prompt Child process ############################# if ($DEBUG) {print "5:Kill Child START-waiting for 'k' command. CPID(CMD)# $process_id, CPID(kill)# $$\n";} # Wait for user input to kill script command child my $cget = getc; while ($cget ne 'k') { } if ($DEBUG) {print "\t5-Kill CMD Child now - ABORT BUTTON ACQKNOWLEDGED\n";} killfam '2',($process_id); sleep 1; # Required - do not remove unless (waitpid($process_id, WNOHANG)) { if ($DEBUG) {print "\t5-Kill CMD Child w/INT did not work.\n";} killfam '1',($process_id); sleep 1; unless (waitpid($process_id, WNOHANG)) { if ($DEBUG) {print "\t5-Kill CMD Child w/HUP did not work.\n";} killfam '15',($process_id); sleep 1; unless (waitpid($process_id, WNOHANG)) { if ($DEBUG) {print "\t5-Kill CMD Child w/TERM did not work.\n";} killfam '9',($process_id); sleep 1; unless (waitpid($process_id, WNOHANG)) { print "Could not kill CPID#:$process_id w/KILL\n"; } } } } if ($DEBUG) {print "\t5-Kill Child EXIT\n";} # Need exit in Child process exit(0); } else { if ($DEBUG) {print "Can't fork for Kill Child: $!\n";} } if ($DEBUG) {sleep(1);} # Just to order debug messages if ($DEBUG) {print "6:After Forks: PPID# $$\n";} ############################################## # Parent waits for script to end or be killed ############################################## waitpid($process_id, 0); if ($DEBUG) {print "7:Process $process_id terminated\n";}; $ret = $?; if ($DEBUG) {print "8:Kill Kill Process $kill_proc_id\n";} # kill w/INT (2) never works killfam '1',($kill_proc_id); sleep 1; # Required - do not remove unless (waitpid($kill_proc_id, WNOHANG)) { if ($DEBUG) {print "\t8-Kill Kill Child w/HUP did not work.\n";} killfam '15',($kill_proc_id); sleep 1; # Required - do not remove unless (waitpid($kill_proc_id, WNOHANG)) { if ($DEBUG) {print "\t8-Kill Kill Child w/TERM did not work.\n";} killfam '9',($kill_proc_id); sleep 1; # Required - do not remove unless (waitpid($kill_proc_id, WNOHANG)) { print "Could not kill CPID#:$kill_proc_id w/KILL\n"; } } } if (defined $ret) { my $ret1 = $ret >> 8; if ($DEBUG) {print "Return value:$ret,$ret1\n";} if ($ret1 == 1) { if ($DEBUG) {print "PASS\n";} } else { if ($DEBUG) {print "FAIL\n";} } return $ret1; } else { if ($DEBUG) {print "Return value not set. Last exit status:$?\n";} } return(0); }