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

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: $!
";
}
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;