Why isn't my Perl program reaping children processes after fork?

Question

I have been trying to write a bare-bones ping scanner using Perl for internal use. Since it scans a 24-bit CIDR network the script takes too long to run if it runs in a single thread. I have tried adding fork functionality to speed up the process but my first attempt was taking pretty much the same time since there was only one child process active at any given time.

I read up on child processes in the perlipc document and also in the Perl Cookbook and came up with the second version:

##Install the CHLD SIG handler
$SIG{CHLD} = \&REAPER;
sub REAPER {
    my $childPID;
    while (( $childPID = waitpid(-1, WNOHANG)) > 0) {
        print "$childPID exited\n";
    }
    $SIG{CHLD} = \&REAPER;
}

my $kidpid;
for (1 .. 254) {
    my $currIP = join ".", (@ipSubset[0,1,2], $_);

    die "Could not fork()\n" unless defined ($kidpid = fork);
    if ($kidpid) {
        #Parent process
        #Does nothing
    } 
    else {
        #Child process
        my $pingConn = Net::Ping->new();    #TCP
        say "$currIP up" if $pingConn->ping($currIP);
        $pingConn->close(); 

        #Nothing else to do
        exit;
    }
}

say "Finished scanning $ipRange/24";

When I scan my internal network the output is:

$perl pingrng2.pl 192.168.1.1
192.168.1.2 up
5380 exited
192.168.1.102 up
192.168.1.100 up
5478 exited
5480 exited
Finished scanning 192.168.1.1/24

As can be seen in the result, the threads which do a successful scan print the "up" message, exit cleanly and are reaped by the parent process. The other 251 threads meanwhile are left dangling attached to '/sbin/init' as can be seen by a quick 'ps -ef' listing. If I add a 'print "Child: $currIP ending\n"' in the child processing block just before the exit statement I get the output from the remaining 251 processes on my terminal "after" my perl script has exited.

What's going on here? I thought that the $SIG{CHLD} subroutine coupled with the waitpid loop would reap all the child processes and ensure that no zombies/dangling processes were left in the system.

In the same breath I would also like to be able to run a specific number of child processes at any given time, say for example, 'n' children running concurrently, whenever one exits the parent process starts another child if needed but has no more than 'n' children at any given moment. Is this possible? If yes could I get some pseudo-code to help guide me?

Answer 1

It looks like your parent process is finishing before the children (and therefore never getting a chance to reap them). Try this instead:

#!/usr/bin/perl

use 5.010;
use strict;
use warnings;

use Net::Ping;

my @ipSubset = (192, 168, 10);

my $i = 0;
my @pids;
for my $octet (1 .. 254) {
    my $currIP = join ".", @ipSubset[0 .. 2], $octet;

    die "Could not fork()\n" unless defined (my $pid = fork);

    #parent saves chlidren's pids and loops again
    if ($pid) {
        push @pids, $pid;
        next;
    } 

    #child process
    my $pingConn = Net::Ping->new;
    say "$currIP up" if $pingConn->ping($currIP);
    $pingConn->close(); 
    exit;
}

#wait on the children
for my $pid (@pids) {
    waitpid $pid, 0;
}