in reply to Re: Killing Forks
in thread Killing Forks

Thanks much! Simply moved a few things around and changed the kill to a 15 from a -15 and that seemed to do it. New Version:
#!/etrade/bin/perl for ($i=0; $i<=10; $i++) { wait_for_a_kid() if keys %pid_to_node > 3; $pid = fork; if ($pid) { ## parent does... $pid_to_node{$pid} = $i; } else { print "$i $$\n"; local $SIG {ALRM} = sub { print "\tKilled PID $$\n"; kill 15, $$ or die "kill: $!"}; # Just SIGTERM alarm 6; eval { ## child does... exit !&Test; waitpid $pid => 0; }; } } ## final reap: 1 while wait_for_a_kid(); sub wait_for_a_kid { my $pid = wait; return 0 if $pid < 0; delete $pid_to_node{$pid} or warn("Why did I see $pid ($?)\n") +, next; } sub Test { sleep 5; }

Replies are listed 'Best First'.
Re^3: Killing Forks
by jbert (Priest) on Aug 14, 2007 at 13:34 UTC
    Glad to know it's fixed.

    As I think about it a little, though, sending yourself a SIGTERM is a bit redundant, you could of course just 'die' or 'exit' in the SIGALRM handler.

    Also...you're calling 'waitpid' in the child (which is odd) after a call to exit (which is odder).

    The other way of doing this, of course, is to get the parent to periodically wake up (you can do this with waitpid and a sleep) and calculate if it should kill off a child (just store each pid's start time and kill off the old ones, maybe keeping them in a sorted list of age or something).

    One case where you might need to have the parent do it is if your long-running code calls out to some XS code which doesn't return up to perl when it receives a signal.

    Since perl 5.8, perl uses 'safe signals' by default, which means that your signal handlers only fire when control returns to the perl interpreter. This can be a long time (or never) when you call out of perl into C/XS code. (Safe signals are 'better', but you sometimes need to be aware of this issue when doing signal handling in perl).

      Thanks again. Like I mentioned in the original post, I wasn't quite sure what some of the stuff was doing. Not much "fork" experience and what I was using was just bits n pieces I found via google. Using your last post, this is what I came up with and still seems to work just fine. I like doing just the exit instead of the kill.
      #!/etrade/bin/perl for ($i=0; $i<=10; $i++) { wait_for_a_kid() if keys %pid_to_node > 3; $pid = fork; if ($pid) { ## parent does... $pid_to_node{$pid} = $i; } else { print "$i $$\n"; local $SIG {ALRM} = sub { print "\tKilled PID $$\n"; exit(1)}; alarm 2; eval { ## child does... &Test; }; } } ## final reap: 1 while wait_for_a_kid(); sub wait_for_a_kid { my $pid = wait; return 0 if $pid < 0; delete $pid_to_node{$pid} or warn("Why did I see $pid ($?)\n") +, next; } sub Test { sleep 5; }
      Hmm, thought it was working fine... But, the exit here seems to be necessary... I took it out and let it run and after getting back from getting my coffee I found that I had 1900+ processes running. Oops. Putting the exit back in before the call to the sub seems to stopped that from happening.
      else { local $SIG {ALRM} = sub { print "$node KILLED $$\n"; exit(1)}; alarm 20; eval { ## child does... exit !&GetSvrStatus($node); }; }
        Ah, yes, sorry if I wasn't clear.

        I meant you could replace the kill, with an exit, not that you could skip the existing call to exit. You've done this nicely.

        The problem with the code which spawned many processes is that each child continued on to run the parent code, going on to wait for children and possibly start their own.

        You pretty much always want a good solid, unconditional 'exit' in the child codepath after a fork, otherwise you have a case where the child can start running the parent code. (Sometimes this is what you want, of course).

        If you miss out the exit, the CHILD will go around the for loop again, and create more children like damn wabbits.
        The rule for inherited signal handlers is: DEFAULT and IGNORE will be inherited, anything else will not.