Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

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

by joelr (Novice)
on Apr 25, 2008 at 20:12 UTC ( #682903=perlquestion: print w/replies, xml ) Need Help??
joelr has asked for the wisdom of the Perl Monks concerning the following question:

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 ##############################################################

Replies are listed 'Best First'.
Re: How to optionally kill a child, and capture status if not killed.
by pc88mxer (Vicar) on Apr 25, 2008 at 20:48 UTC
    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; }
      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.

Re: How to optionally kill a child, and capture status if not killed.
by sgifford (Prior) on Apr 25, 2008 at 20:30 UTC
    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.
Re: How to optionally kill a child, and capture status if not killed.
by gloryhack (Deacon) on Apr 26, 2008 at 06:15 UTC
    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.
Re: How to optionally kill a child, and capture status if not killed.
by mr_mischief (Monsignor) on Apr 25, 2008 at 20:22 UTC
    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 $?.

Re: How to optionally kill a child, and capture status if not killed.
by zentara (Archbishop) on Apr 26, 2008 at 15:28 UTC
    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.

    I'm not really a human, but I play one on earth. Cogito ergo sum a bum

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://682903]
Approved by mr_mischief
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (5)
As of 2017-08-17 06:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Who is your favorite scientist and why?



























    Results (282 votes). Check out past polls.

    Notices?