How to optionally kill a child, and capture status if not killed.

[joelr]

Monks,

I am looking for a method to fork a child process (the command string is passed in), capture the status to report complete/not_complete, and also provide a mechanism to abort the process.

I have come up with 2 forked processes, one for the passed in command, and another for the abort prompt. If the command completes, it kills the abort prompt. If the user selects the abort prompt, the command process is killed. My only problem at this point is to capture the status of the command when it is allowed to complete (which was not a problem before I added the abort prompt).

I realize that the child process is a copy of the parent, and does not share variable space. What is the best way for the parent to capture the status from the child?

I have condensed the problem in my code: (The target is a Perl/TK program, so the abort prompt will be done in TK.) I will also attach a sample command to show intended command status options.

Thanks in advance.

For reference, I have updated the program to show a working example. Thanks for the help.

#!/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)# $p
+rocess_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 ACQK
+NOWLEDGED\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 w
+ork.\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/KIL
+L\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 wor
+k.\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);
}

Here is my example command, "prompt.pl", with return status:

#!/usr/bin/perl5.87 -w

# ==================================================================
# Prompt
# GUI to ask user to confirm an action.
# ==================================================================

use strict;
use Tk;

if (defined $ARGV[0]) {
    $0 =~ s/.pl$//;
    die "Confirm:\n".
        "Useage: $0\n";
}

my $GUI;
my $mw;
my $message = "Please verify that the task is complete.";
$mw = MainWindow->new(-title => 'Confirm');
$mw->minsize('50','50');
$mw->protocol('WM_DELETE_WINDOW' => sub {print "0"; exit(0);});

my $bf = $mw->Frame->pack(qw/-side bottom -fill x/);
$mw->Message(-text => $message,
    -width => 600)
        ->pack(qw/-anchor center -side top -fill x -expand 1/);
$bf->Button(-text => 'NOT COMPLETE',
    -command => sub {exit(0);})
        ->pack(qw/-side left -fill x -expand 1/);
$bf->Button(-text => 'COMPLETE',
    -command => sub {exit(1);})
        ->pack(qw/-side left -fill x -expand 1/);
$mw->Popup;

MainLoop;

##############################################################
# End of main program
##############################################################

[pc88mxer]

The value of $? is associated with the last successful waitpid call. In your case things are complicated because you are calling waitpid in two places: your main program and the SIGCHLD handler. I wouldn't be surprised if the SIGCHLD handler is causing $? to get clobbered (with respect to the waitpid call in your main program.)

I would get rid of the SIGCHLD handler, and structure your code to look something like this:

my $script_pid = fork();
...launch script process...

my $abort_pid = fork();
...launch abort button process..,

my $pid = wait; # see who finishes first
my $st = $?; # save status
if ($pid == $script_pid) {
  # script finished
  kill 9, $abort_pid;
} else { # assume $pid == $abort_pid, or check it
  # abort button finished
  kill 9, $script_pid;
}

[joelr]

Thanks pc88mxer!

Great tips.

The key was to wait for either process to finish in the parent, and to use "exec" instead of "system" to not consume the status read by "$?". Before that, I could not get "$?" to reflect the status.

I will update the example for any future searches.

[sgifford]

For the status, are you looking for just the exit status you get from wait? If so, have the monitor process read the exit status from the child process, then just call exit to exit with the same status. Things get a bit more complicated if you want to keep all of the information returned by wait, such as whether the process was killed by the signal and whether it dumped core, but often you don't.

[gloryhack]

You might have a look at IPC::Run as I believe it's the wheel you're trying to reinvent. Can't blame you for that, as CPAN is large and difficult to digest.

[mr_mischief]

I'm unclear on your exact problem, and that's a lot of code for me to look through to figure it out.

Is your main problem that you're not sure where the child process's status ends up once wait returns? The docs say it ends up in $?.

[zentara]

If you need alot of communication between process, you might be better off using threads and shared variables. The drawback to threads is that it may retain system resources (gain ram) if not done properly. A neat way to avoid that, is to make a thread to do your forking. You can then detect the status of the forked process( running, finished, returned errors, ets) in the thread, and stuff them in shared variables( with the pid of the forked process), so you can kill it from the main thread whenever you want. You can reuse the launcher thread, and pass in strings to be eval'd and forked off.