In perl, killing child and its children when child was created using open

Question

Here's my code, with error handling and other stuff removed for clarity:

sub launch_and_monitor {  

    my ($script, $timeout) = @_;

    sub REAPER {
        while ((my $child = waitpid(-1, &WNOHANG)) > 0) {}
        $SIG{CHLD} = \&REAPER;
    }
    $SIG{CHLD} = \&REAPER;

    my $pid = fork;
    if (defined $pid) {
        if ($pid == 0) {
            # in child
            monitor($timeout);
        }
        else {
            launch($script);
        }
    }
}

The launch sub executes a shell script which in turn launches other processes, like so:

sub launch($) {

    my ($script) = @_;

    my $pid = open(PIPE, "$script|");

    # write pid to pidfile

    if ($pid != 0) {
        while(<PIPE>) {
            # do stuff with output
        }
        close(PIPE) or die $!;
    }
}

The monitor sub basically just waits for a specified period of time and then attempts to kill the shell script.

sub monitor($) {

    my ($timeout) = @_;

    sleep $timeout;

    # check if script is still running and if so get pid from pidfile
    if (...) {
        my $pid = getpid(...);        
        kill 9, $pid;
    }
}

This kills the script, however, it does not kill any of it's sub processes. How to fix?

Answer 1

In general, I don't think you can expect signals to be propagated into all child processes; this isn't specific to perl.

That said, you might be able to use the process group signal feature built into perl kill():

...if SIGNAL is negative, it kills process groups instead of processes...

You probably need to use setpgrp() on your (direct) child process, then change your kill call to something like:

kill -9, $pgrp;

Answer 2

Try adding:

use POSIX qw(setsid);
setsid;

at the top of your launch_and_monitor function. This will put your processes in a separate session, and cause things to exit when the session leader (i.e. the master) exits.

Answer 3

You can do this with process groups, if your operating system supports them. You need to make the script process become a process group leader. The child processes that it runs will inherit the process group from their parent. You can then use kill to send a signal to each process in the group at the same time.

In launch(), you will need to replace the open line with one that forks. Then in the child, you would call setpgrp() before exec'ing the command. Something like the following should work:

my $pid = open(PIPE, "-|");
if (0 == $pid) {
    setpgrp(0, 0);
    exec $script;
    die "exec failed: $!\n";
}
else {
    while(<PIPE>) {
        # do stuff with output
    }
    close(PIPE) or die $!;
}

Later, to kill the script process and its children, negate the process ID that you're signalling:

kill 9, -$pid;