Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Detecting when a child process is killed unexpectedly

by rlb3 (Deacon)
on Oct 16, 2009 at 20:28 UTC ( #801643=perlquestion: print w/ replies, xml ) Need Help??
rlb3 has asked for the wisdom of the Perl Monks concerning the following question:

Monks,

There are three processes.

  1. The parent
  2. A child that cats a tarball to stdout. A reader
  3. A child that redirects STDIN to the other child and untars the stream from that child. A writer

What I am having trouble with is getting the parent to detect if the writer has exited early. So if I start it running get the pid of writer and kill -9 that pid SIGCHLD doesn't seem to be executed. If the reader is killed SIGCHLD is executed.

I don't understand what is going on. Why isn't SIGCHLD signaling when I kill the writer.

use Data::Dumper; my %child_status; sub reaper { my $child; while (($child=waitpid(-1,WNOHANG))>0) { $child_status{$child} = $? >> 8; } } sub copy { my $file = shift; my $dir = shift; local $SIG{CHLD} = \&reaper; my $reader_pid = open( my $reader, '-|' ); if ($reader_pid) { } else { exec '/bin/cat', $file; exit; } my $writer_pid; if ($writer_pid = fork()) { } else { chdir($dir); open( STDIN, "<&=" . fileno($reader) ); exec '/bin/tar', '-x', '-p', '-f', '-'; exit; } while (1) { sleep 1; next if !%child_status; foreach my $pid ($reader_pid, $writer_pid) { if ($child_status{$pid} != 0) { print Dumper \%child_status; %child_status = (); die "failed tar\n"; } } if (exists $child_status{$writer_pid} && exists $child_status{ +$reader_pid}) { last; } } }

Thanks for any help you can give...

Comment on Detecting when a child process is killed unexpectedly
Download Code
Re: Detecting when a child process is killed unexpectedly
by jakobi (Pilgrim) on Oct 16, 2009 at 21:04 UTC

    With these fixes, killed children at least are reported correctly for my setup.

    • check this scope: if(my $writer_pid=fork...) makes a rather short-lived variable
    • it might be preferable to use keys %child_status when testing the hash.
    • error: check your process-id variable naming: _pid or nothing (incl. a clash with your FH naming)?

    Notes

    • I just used sleep 301/sleep 302 and added a copy invocation plus some warn() e.g. when checking or setting child_status to arrive at the above list.
    • As I used sleep, I didn't check filehandles and actual cat/tar.
    • paranoia: missing or die() after open, fork, exec
    • paranoia: consider killing the surviving process on error after a short grace period like sleep 5 or another few iterations

    HTH,
    Peter

    Update: Did this catch all errors :) ?

    Update 2: appended the working variant above to track down remaining errors (+ /msg'ed).

      Thanks... I was just correcting some of those problems before I saw you post. I try your other suggestions as well.



      Unfortunately no. Even with the corrections I'm still seeing the same behavior.



Re: Detecting when a child process is killed unexpectedly
by gmargo (Hermit) on Oct 17, 2009 at 06:17 UTC

    Two main problems that I see:
    1) A faulty assumption that the process exit code covers the 'death by signal' case.
    2) Missing parentheses on the exists statements, giving the wrong precedence.

    Here is code which covers all cases hopefully:

    #!/usr/bin/perl use strict; use warnings; use diagnostics; use POSIX ":sys_wait_h"; use Data::Dumper; my %child_status; sub reaper { my $child; while (($child=waitpid(-1,WNOHANG))>0) { # See waitpid(2) and POSIX(3perl) my $status = $?; my $wifexited = WIFEXITED($status); my $wexitstatus = $wifexited ? WEXITSTATUS($status) : undef; my $wifsignaled = WIFSIGNALED($status); my $wtermsig = $wifsignaled ? WTERMSIG($status) : undef; my $wifstopped = WIFSTOPPED($status); my $wstopsig = $wifstopped ? WSTOPSIG($status) : undef; $child_status{$child} = { status => $status, wifexited => $wifexited, wexitstatus => $wexitstatus, wifsignaled => $wifsignaled, wtermsig => $wtermsig, wifstopped => $wifstopped, wstopsig => $wstopsig, }; print STDERR "reaper: reaped child=$child" ." status=$status" ." wifexited=$wifexited" ." wexitstatus=".(defined($wexitstatus) ? $wexitstatus : " +undef") ." wifsignaled=$wifsignaled" ." wtermsig=".(defined($wtermsig) ? $wtermsig : "undef") ." wifstopped=$wifstopped" ." wstopsig=".(defined($wstopsig) ? $wstopsig : "undef") ."\n"; } } sub copy { my $file = shift; my $dir = shift; local $SIG{CHLD} = \&reaper; my $reader_pid = open( my $reader, '-|' ); if ($reader_pid) { print STDERR "copy: spawned reader child=\"$reader_pid\"\n"; } else { exec '/bin/cat', $file; exit; } my $writer_pid; if ($writer_pid = fork()) { print STDERR "copy: spawned writer child=\"$writer_pid\"\n"; } else { chdir($dir); open( STDIN, "<&=" . fileno($reader) ); exec '/bin/tar', '-x', '-p', '-f', '-'; exit; } while (1) { sleep 1; next if !%child_status; foreach my $pid ($reader_pid, $writer_pid) { if (exists $child_status{$pid}) { my $st = $child_status{$pid}; # check for non-zero exit status # check for death by signal if (($st->{wifexited} && $st->{wexitstatus} != 0) || $st->{wifsignaled}) { print Dumper \%child_status; die "failed ".($pid == $writer_pid ? "tar" : "rea +der"); } } } if (exists($child_status{$writer_pid}) && exists($child_status +{$reader_pid})) { last; } } } copy("/home/tmp/quotes.tar","."); exit 0;

      > 1) A faulty assumption that the process exit code covers the 'death by signal' case.

      SIGSTOP e.g. is indeed something to skip later-on in detecting when to terminate.

      But there's still an issue: ignored child state changes must be either ignored in the reaper or in the loop exit condition, otherwise we exit the loop on e.g. SIGSTOP as well.

      > 2) Missing parentheses on the exists statements, giving the wrong precedence.

      Here I got curious, as the test script behaved as expected when I killed my sleep child processes with zap sleep.3.

      perl -MO=Deparse -e '%a=("a",1,"b",2); print "ok" if exists $a{a} && 1 ++exists $a{b}' # (%a) = ('a', 1, 'b', 2); # print 'ok' if exists $a{'a'} and 1 + exists($a{'b'}); # NOTE above interesting and _misleading_ choice of parens, _plus_ tra +nslation to 'and' perl -MO=Deparse -e '%a=("a",1,"b",2); print "ok" if exists($a{a} && 1 ++exists $a{b})' # exists argument is not a HASH or ARRAY element at -e line 1. # NOTE same error of course w/o Deparse, also when I move ')' behind ' +1'.

      While 'and' surely makes the condition more readable, it doesn't look like '&&' leads to an unintended precedence. Which you'd normally expect with '&&' (when using it yourself intentionally). Why this? ->

      perl -MO=Deparse -e 'sub f {warn join "\n",@_,"",""};%a=("a",1,"b",2); + print "ok" if f $a{a} && 5+f $a{b}' # print 'ok' if f $a{'a'} && 5 + f($a{'b'}); # output 2 6 (* with sub f ($), it's 1 2) perl -MO=Deparse -e 'sub f {warn join "\n",@_,"",""};%a=("a",1,"b",2); + print "ok" if f($a{a} && 5+f $a{b})' # print 'ok' if f $a{'a'} && 5 + f($a{'b'}); # output 5 2 perl -MO=Deparse -e 'sub f {warn join "\n",@_,"",""};%a=("a",1,"b",2); + print "ok" if f($a{a} && 5)+f $a{b}' # print 'ok' if f($a{'a'} && 5) + f($a{'b'}); perl -e 'sub f {warn join "\n",@_,"",""};%a=("a",1,"b",2); print "ok" +if f($a{a}) && 5+f($a{b})' # output 1 2 perl -e 'sub f {warn join "\n",@_,"",""};%a=("a",1,"b",2); print "ok" +if f $a{a} and 5+f $a{b}' # output 1 2

      (I'd naively expected Deparse to be a bit more explicit in its rephrasing. Anyway:)

      After reading man perlop, exists() is a named unary operator, and thus has precedence over both '&&' and 'and'. The function f in contrast is a 'list operator (rightward)', with a precedence lower than '&&'.

      So the precedence in the statement was correct. And considering the three of us, this loop exit statement is well on it's way to become a future maintenance trap :).

      Suggestion: Consider replacing '&&' with the more normal/readable 'and'.

      Note that using parens is still required to protect against e.g. prototypes overturning naive precedence expectations wrt e.g. comparison operators:

      f 3 >= 5
      What is the argument here to a previous sub f?
      And in case of sub f($)?
      And what about &f 3 >= 5 for both cases?

      Perlish prototypes != C prototypes in use and semantics: (tye)Re: A question of style, &f vs f(), Gratuitous use of Perl Prototypes and finally USAGE OF Prototype.

      /me leaves to fetch an Arkansas stone and some honing oil in order to remove the embarassing nicks out of /my paranoia.

        Regarding SIGSTOP (& SIGCONT), they are not an issue since waitpid() will only return stop/cont indications if called with the WUNTRACED argument. I should not have checked WIFSTOPPED at all.

        Regarding the usage of "exists", you are quite correct, and I am humbled.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://801643]
Approved by zwon
Front-paged by planetscape
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (8)
As of 2014-11-28 00:33 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (191 votes), past polls