#!/usr/bin/perl -w

###### Configuration #########################################################

my %defaults = ( # default values for command-line options

    'h' => 0,          # Show help then exit
    'V' => 0,          # Show version then exit

    'v' => 0,          # Verbosity level - see docs for details

    'e' => '1w',       # expiry time
    'r' => '300s',     # timed-out request retry delay
    'a' => '0.5h',     # failed lookup retry delay
    't' => '60s',      # Lookup timeout

    'c' => 32,         # Number of children
    'q' => 4096,       # Maximum queue length per stream
    'w' => 512,        # sort window size
    'x' => 64,         # sort window dump chunk

    'd' => '/tmp/logresolve.cache', # DB cache file
    # 'D' => '/tmp/logresolve.debug', # Debug out - STDERR if undef

    'i' => '-',        # input file
    'o' => '-',        # output file
    'b' => undef,      # Total bytecount file
    's' => undef,      # IP stats file

    'f' => undef,      # I/O mapping file
    'm' => undef,      # I/O mapping list
);

my %extensions = ( # how to compress/uncompress various compression formats
  # extension    compress command   uncompress command
    'Z'     => [ 'compress -c',     'uncompress -c' ],
    'gz'    => [ 'gzip -9 -',       'gunzip -'      ],
    'bz2'   => [ 'bzip2 -9 -',      'bunzip2 -'     ],
);

###### Documentation #########################################################

=head1 NAME

logresolve.pl - log file reverse nameservice resolver

=head1 SYNOPSIS

logresolve.pl
[B<-h>]
[B<-V>]
[B<-v>]
S<[B<-e> time]>
S<[B<-r> time]>
S<[B<-a> time]>
S<[B<-t> time]>
S<[B<-c> #]>
S<[B<-q> #]>
S<[B<-w> #]>
S<[B<-x> #]>
S<[B<-d> file]>
S<[B<-i> file]>
S<[B<-o> file]>
S<[B<-b> file]>
S<[B<-s> [file]]>
S<[B<-f> file]>
S<[B<-m> input,output,[bytecount],[stats] ...]>

=head1 DESCRIPTION

I<logresolve> performs reverse nameservice lookups on long lists of IP
addresses. Its primary intent and most common use is to resolve IP addresses
recorded in HTTP daemon log files to their more human-readable domain names.
This typically makes the statistics generated from such log files much more
useful.

Most HTTP daemons do have the capability of performing reverse nameservice on
the fly, and some will cache the results so that subsequent lookups are
instantaneous. However, very few do it B<asynchronously>, so the initial
request from any given IP number is delayed slightly while the server waits for
the reverse lookup to complete. Thus, turning off reverse lookups can increase
performance, especially on highly loaded web servers.

I<logresolve> allows server administrators to reduce the load on their servers
by deferring these reverse lookups to a more convenient time, network, or
machine.

I<logresolve> can cache the results of its lookups in a local database file so
that multiple runs of I<logresolve> can share reverse lookup information. This
minimizes the impact of logresolve on your local nameserver. I<logresolve> can
be configured to cache these results for longer than the expiry date on the DNS
record. Because few reverse nameservice records change very often, this can
give increased performance with minimal degradation in the accuracy of results.

=head1 OPTIONS

The defaults for all options can be set in the B<Configuration> section,
found at the top of B<logresolve.pl>.

Any B<file> option can be specified as a filename or B<-> for STDIN/STDOUT,
or B<=> for STDERR (where applicable).

Any B<time> option can be specified as a non-negative floating point number
with a suffix of B<s> for seconds (the default), B<m> for minutes, B<h> for
hours, B<d> for days, or B<w> for weeks.

=over 4

=item B<-h> Display a help & usage message, and exit.

=item B<-V> Display the version of logresolve, and exit.

=item B<-v> Provide verbose output to STDERR; repeat to increment verbosity.
See L<"DIAGNOSTICS"> for details of what each verbosity level displays.

=item B<-e time> expiry time after which a cached reverse lookup should be
performed again.

=item B<-r time> time after which a timed-out lookup should be tried again

=item B<-a time> time after which a failed lookup should be tried again

=item B<-t time> time after which we give up on a lookup

=item B<-c #> number of children to use for lookups

=item B<-q #> maximum number of lines to queue in per stream

=item B<-w #> maximum number of lines to queue out per stream

=item B<-x #> number of lines to dump from -w window

=item B<-d dbfile> DB file for persistent cache

=item B<-D debugfile> File for debug output; defaults to STDERR unless.

=item B<-i file> Input file; defaults to STDIN. Handles compressed files as
defined in %extensions (at top of source file).

=item B<-o file> Output file; defaults to STDOUT. Handles compressed files as
defined in %extensions (at top of source file).

=item B<-b file> Bytecount file to be B<appended>

=item B<-s [file]> Request statistics, and optionally specify output file
- defaults to STDERR

=item B<-f> I/O mapping file - one mapping per line

=item B<-m> All non-options are to be interpreted as mappings in the form
input,output,

=back

=head1 DIAGNOSTICS

Verbosity levels start at 0 and can be incremented by use of the B<-v> option.

=over 4

=item B<0:> Error reports only

=item B<1:> Brief startup/shutdown diagnostics

=item B<2:> Detailed startup/shutdown diagnostics

=item B<3:> File stream diagnostics

=item B<4:> Brief lookup diagnostics

=item B<5:> Huge lookup diagnostics

=item B<6:> Cache checking diagnostics

=back

=head1 SEE ALSO

Comments in code eluciate internal structures.

=head1 BUGS

IP numbers are stored as text rather than as 4 bytes in cache keys. Data
records necessary for options e, r, and a are not stored in cache values.

Options e, r, a, and s are unimplemented. Reverse lookups are cached forever,
and no statistics are collected.

The stock gethostbyaddr() function is used to perform lookups; using the
Net::DNS::Resolver would allow users to specify multiple nameservers at run
time. Net::DNS could also eliminate the need for children because it can
perform asynchronous lookups.

=head1 AUTHOR

Tom Rathborne <tomr@aceldama.com>

=head1 NOTES

Notes.

=cut

####### Program ##############################################################

### pedantic things
require 5.004;
$| = 1;         # autoflush STDOUT
$^W = 1;        # warnings on
use strict;

### modules to use
use DB_File;
use Socket;
use Getopt::Long;
use IO::File;
use IO::Pipe;
use Time::Local;

### Global variables

use vars qw($VERSION $VERBOSITY $MAXQUEUE $DBCACHE %MONTHNUM $MAXWINDOW $WINDUMP $children $cache);

$VERSION = 'logresolve.pl 2.1.5 2002-09-30';
$DBCACHE = undef;

### Tuning for DB_File
$DB_HASH->{'cachesize'} = 1024;

%MONTHNUM = (
    Jan => 0, Feb => 1, Mar => 2, Apr => 3, May => 4,  Jun => 5,
    Jul => 6, Aug => 7, Sep => 8, Oct => 9, Nov => 10, Dec => 11
);

### Subroutines ##############################################################

# ProcessOpts uses Getopt::Long to process the command-line arguments. #######

sub ProcessOpts () {
    my %opts = ();
    my %tmult = qw( s 1 m 60 h 3600 d 86400 w 604800 ); # multiple->seconds

  # Fill in %opts from @ARGV

    Getopt::Long::Configure ( qw/ permute bundling /);
    Getopt::Long::GetOptions (\%opts,
    qw/ h V v+ e=s r=s a=s t=s u=s c=s q=i w=i d=s D=s i=s o=s b=s s:s f=s m=s /)
        or die "Use\n    $0 -h\nor\n    perldoc $0\nfor help. Died";

  # A couple of ancillary local subroutines
    my $GrabDefaults = sub { # copy from %defaults to %opts where applicable
        my $force_define = shift;

        foreach (@_) {
            $opts{$_} = $defaults{$_} unless defined $opts{$_};
            $opts{$_} = '' unless defined $opts{$_} or !$force_define;
        }
    };

    my $TimeToSeconds = sub { # convert a length of time to seconds
        my $string = shift;
        my $seconds = 0;

        if ($string =~ /^([0-9]+(?:\.[0-9]+)?)([smhdw])?$/) {
            my $mod = (defined $2) ? $2 : 's';
            $seconds = int ($1 * (exists $tmult{$mod} ? $tmult{$mod} : 1));
        } else {
            return -1;
        }

        return $seconds;
    };

  # Munge options
    my @mappings = ();
    my $override = 0;

    if (defined $opts{'f'} ) { # read mappings from specified file
        $override = 1;
        open MAPFILE, "<$opts{'f'}" or die "Couldn't open mapfile $opts{'f'}";
        @mappings = <MAPFILE>;
        close MAPFILE;
    }

    if (defined $opts{'m'} ) { # use mapping from command line
        $override = 1;
        push @mappings, ($opts{'m'}, @ARGV); # use leftover arguments too
    }

    if (defined $opts{'i'} or defined $opts{'o'} or
        defined $opts{'b'} or defined $opts{'s'} or
        !$override) { # use options
       &$GrabDefaults (1, qw( i o b s ));
       push @mappings, (join ',', @opts{qw( i o b s )});
    }

    $opts{'m'} = \@mappings;

    &$GrabDefaults (0, qw( e r a t u c q w x ));

    $opts{'e'} = &$TimeToSeconds ($opts{'e'});
    $opts{'r'} = &$TimeToSeconds ($opts{'r'});
    $opts{'a'} = &$TimeToSeconds ($opts{'a'});
    $opts{'t'} = &$TimeToSeconds ($opts{'t'});

    $opts{'c'} = int $opts{'c'};

    $MAXQUEUE = $opts{'q'};
    $MAXWINDOW = $opts{'w'};
    $WINDUMP = $opts{'x'};
    $WINDUMP = ($MAXWINDOW / 2) if ($MAXWINDOW <= $WINDUMP);

    $VERBOSITY = $defaults{'v'};
    $VERBOSITY += int($opts{'v'}) if defined $opts{'v'}; # sum verbosity levels

    &$GrabDefaults (0, qw( h V d D )); # not handled, just passed through.

    return %opts;
}

# Debug - prints message to debug output (-D) if level <= verbosity (-v) #####

sub Debug ($$) {
    my ($level, $message) = @_;

    print ERRORLOG $message if $level <= $VERBOSITY;

}

# Child - sits around and does lookups #######################################

sub Child ($$$) {
    my ($ipipe, $opipe, $timeout) = @_;

  # finalize pipe settings
    $ipipe->reader;
    $opipe->writer;
    $opipe->autoflush;

  # Handle alarms caused by lookup timeouts
    $SIG{'ALRM'} = sub { die '_alarmed_' } if $timeout;

    my ($ip, $nip, $hostname, $line, @ins);

  # main loop - perform lookups until parent stops feeding them to us
    while (!($ipipe->eof) and ($ip = $ipipe->getline)) {
        chomp ($ip);            # remove newline
        $nip = inet_aton ($ip); # convert to 4-byte number
        $hostname = undef;      # clear hostname

        if ($timeout) {
            eval { # may die from a SIGALRM in here
                alarm ($timeout);
                $hostname = gethostbyaddr ($nip, AF_INET);
                alarm (0);
            };
            $hostname = $ip if $@ and $@ =~ /_alarmed_/; # timed out
        } else {
            $hostname = gethostbyaddr ($nip, AF_INET);
        }

        $line = sprintf ("%s|%s\n", $ip, defined $hostname ? $hostname : $ip);
        syswrite ($opipe, $line, length($line));
    }

  # clean up - note that this stuff may not happen if we get a SIGTERM
    $opipe->close;
    $ipipe->close;

    return 0;
}

# ForkChild ( t ) forks a child with timeout t, returns child info array #####

sub ForkChild ($) {
    my $timeout = shift;

    my $ipipe = new IO::Pipe;
    my $opipe = new IO::Pipe;

    my $pid = fork();

    exit Child ($ipipe, $opipe, $timeout) unless $pid;

  # implicit else!

    Debug (2, "[Forked $pid] ");

    $opipe->reader;    # output from child
    $ipipe->writer;    # input to child
    $ipipe->autoflush; # always flush stuff sent to child

    return { out => $opipe, in => $ipipe, pid => $pid, busy => 0 };
}

# ForkChildren ( c t ) forks c children with a timeout of t seconds for lookups

sub ForkChildren ($$) {
    my ($count, $timeout) = @_;
    my @children = ();

    Debug (1, "Forking children...\n");

    for (my $child = 0; $child < $count; $child++) {
        push @children, ForkChild ($timeout);
    }

    Debug (1, "\n...done forking children.\n");

    sleep 1; # give children a moment to start up

    return \@children;
}

# InitStreams - munges mappings into streams #################################

sub InitStreams ($) {
    my $mappings = shift;
    my @streams = ();

    my ($mapping, $in, $out, $byte, $stat);

    foreach $mapping (@$mappings) {
        ($in, $out, $byte, $stat) = split /,/, $mapping;

        push @streams, {
            'ifn' => $in,   'ifh' => undef, # input file name/handle
            'ofn' => $out,  'ofh' => undef, # output file name/handle
            'bcn' => $byte, 'bct' => 0,     # bytecount file/total
            'stn' => $stat, 'sti' => {},    # stats file and data
            'req' => [],                    # pending requests
            'win' => [],                    # windowsort output buffer
        };
    }

    return \@streams;
}

# InitCache - ties to a DBM file, or doesn't. ################################

sub InitCache ($) {
    my $db = shift;
    my %cache;

    if (defined $db and $db ne '') {
        Debug (2, "Tying to $db...\n");
        if($DBCACHE =
           tie (%cache, 'DB_File', $db, O_CREAT|O_RDWR, 0644, $DB_HASH)) {
           Debug (2, "...tied ok.\n");
        } else {
           Debug (2, "...tie failed.\n");
           $DBCACHE = undef;
           %cache = ();
        }
    } else {
        %cache = ();
    }

    return \%cache;
}

# GetReq - reads a single log line from a filehandle #########################

sub GetLogLine ($) {
    my $fh = shift;

    my $line = $fh->getline or return 0;
    chomp $line;

  # FIXME - Does this *really* match all extended log format lines?
    if ( $line =~ m#^(\S+)( \S+ \S+ \[(\d+)/(\S+)/(\d+):(\d+):(\d+):(\d+) .\d+\] ".+?" \d+ (-|\d+)( ".+" ".+")?)$# ) {
        return {
            'pf' => '',     # prefix
            'ip' => $1,     # IP# or hostname
            'sf' => $2,     # suffix
            'bc' => $9,     # bytecount
            'dt' => timelocal ($8, $7, $6, $3, $MONTHNUM{$4}, $5),
        };
    } else { # got an invalid line; pass it through!
        return {
            'pf' => '',     # prefix
            'ip' => $line,  # IP# or hostname
            'sf' => '',     # suffix
            'bc' => 0,      # bytecount
            'dt' => 0,      # date
        };
    }
}

# OpenStream - opens a file or pipe for reading or writing ###################

sub OpenStream ($) {
    my $file = shift;

    my $cmd = $file;
    my $mode = -1;

    my $foo = substr ($file, 0, 1);
    substr ($file, 0, 1) = '';

    if    ($foo eq '>') { $mode = 0 } # write
    elsif ($foo eq '<') { $mode = 1 } # read
    else  { die "OpenStream called with invalid file: $file" } # neither, BAD

    foreach $foo (keys %extensions) {
        if ($file =~ /\.$foo$/) {
            if ($mode == 0) { # write
                $cmd = "|$extensions{$foo}[0] > $file";
            } elsif ($mode == 1) { #read
                $cmd = "$extensions{$foo}[1] < $file|";
            } else { # neither, BAD
                die "OpenStream had no mode for file $file"
            }
        }
    }
    
    return IO::File->new($cmd);
}

# BufOut outputs a request through a stream, re-sorting by date in a window.

sub BufOut ($$$) {
    my ($stream, $dt, $line) = @_;

    if ($MAXWINDOW) {
        if (@{$stream->{'win'}}) {
            my $i = (@{$stream->{'win'}} - 1);
            while ($i >= 0 and $dt < $stream->{'win'}[$i][0]) { $i-- }
            $i++;

            splice @{$stream->{'win'}}, $i, 0, [$dt, $line];

        } else {
            @{$stream->{'win'}} = ([$dt, $line]);
        }

        if (@{$stream->{'win'}} > $MAXWINDOW) {
            foreach my $tl (splice @{$stream->{'win'}}, 0, $WINDUMP) {
                $stream->{'ofh'}->print ($tl->[1]);
                # TODO - track last-output time,
                #        verify monotonically increasing,
                #        warn if not
            }
        }
    } else {
        $stream->{'ofh'}->print ($line);
    }
}

# BufClear clears the sort window for a buffer.

sub BufClear ($) {
    my ($stream) = @_;

    if ($MAXWINDOW) {
        foreach my $tl (@{$stream->{'win'}}) {
            $stream->{'ofh'}->print ($tl->[1]);
            # TODO - track last-output time, verify monotonically increasing.
        }
        $stream->{'win'} = [];
    }
}

# GenReq reads from streams and adds requests to the lookups list ############

sub GenReq ($$$$$$) {
    my ($streams, $lookups, $pending, $count, $cache, $timeout) = @_;

    my ($stream, $req, $oldreqs, $newreqs, $blocked, $ip);

    my $num = 0; # active stream

  # main loop - fill up $lookups.
    while (scalar @$lookups < $count and scalar @$streams > $num) {

      # find next unresolved line, opening handles if necessary.

        do  { # find next stream
            $stream = $streams->[$num];

            if (!defined $stream->{'ifh'}) {
                Debug (3, "Resolving $stream->{'ifn'} to $stream->{'ofn'}\n");

                eval {
                    $stream->{'ifh'} = OpenStream ("<$stream->{'ifn'}")
                        or die "opening input stream $stream->{'ifn'}";
                    $stream->{'ofh'} = OpenStream (">$stream->{'ofn'}")
                        or die "opening output stream $stream->{'ofn'}";
                };

                if ($@) { # couldn't open input and/or output file
                    Debug (3, "Error $@\n");
                    splice @$streams, $num, 1;
                    $stream->{'ifh'} = undef; # just making sure to close it
                }
            }

            return scalar @$streams if (scalar @$streams == $num);

        } while (!defined $stream->{'ifh'});

      # $blocked is a flag indicating that the current stream is queueing
      # request lines, waiting for an unresolved lookup.
        $blocked = 0;
        
        $oldreqs = $stream->{'req'}; # lines previously queued up
        $newreqs = [];               # clear new queue

        while ((scalar @$lookups < $count) and
               (scalar @$newreqs < $MAXQUEUE) and
               ($req = ((shift @$oldreqs) or (GetLogLine $stream->{'ifh'}))) ) {

            $ip = $req->{'ip'}; # avoid dereferencing $req too much

            if ($ip =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/o) { # unresolved
                Debug (6, "IP $ip ");
                if (exists $cache->{$ip}) { # lookup already complete
                    Debug (6, "in cache: $cache->{$ip}\n");
                    $ip = $cache->{$ip}; # get cached lookup
                    $req->{'ip'} = $ip; # update request record
                } else { # lookup not yet complete - queue things up
                    Debug (6, "not in cache\n");
                    $blocked = 1;
                    push @$newreqs, $req; # remember this for next pass
                    push @$lookups, $ip # request lookup if not already pending
                        unless (grep /$ip/, @$lookups
                                or exists $pending->{$ip});
                }
            }

          # we _don't_ do an 'else' here since the above may resolve it
            
            if ($ip !~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/o
                or exists $cache->{$ip}) { # this line is resolved...
                if($blocked) { # ... but there is an unresolved line before it
                    push @$newreqs, $req;
                } else {       # ... and ready to be recorded
                  # record line
                    BufOut ($stream, $req->{'dt'},
                            "$req->{'pf'}$ip$req->{'sf'}\n");
                  # add bytecount
                    $stream->{'bct'} += $req->{'bc'} unless $req->{'bc'} eq '-';
                }
            }
        }

        if (scalar @$newreqs) { # this stream is still waiting on something
            Debug (4, (scalar @$newreqs) .
              " lines in $stream->{'ifn'} blocked on [$newreqs->[0]{'ip'}]\n");
            $stream->{'req'} = $newreqs;

            if (scalar @$newreqs >= $MAXQUEUE) { # don't eat too much memory
                $stream->{'ofh'}->flush; # may as well do this now
                $DBCACHE->sync if defined $DBCACHE;
                if (scalar keys %$pending) {
                    my $sleeps = $timeout
                        ? int(log($timeout/((scalar keys %$pending) + 1) + 1) + 1) + 1
                        : 2;
                    Debug(4, "Sleeping ${sleeps}s to let children catch up.\n");
                    sleep $sleeps;
                }
            }

            $num++; # go on to next stream

        } else { # close this stream and write bytecount
            Debug (3, "Done with $stream->{'ifn'}\n");
            $stream->{'ifh'}->close;
            BufClear ($stream);
            $stream->{'ofh'}->close;

            if (defined $stream->{'bcn'} and $stream->{'bcn'} ne '') {
                if (my $bcf = new IO::File ">>$stream->{'bcn'}") {
                    $bcf->print ("$stream->{'bct'}\n");
                    $bcf->close;
                } else {
                    Debug (3, "Couldn't open $stream->{'bcn'} bytecount\n");
                }
            }

            splice @$streams, $num, 1;
        }
    }

    return scalar @$streams;
}

# Lookup feeds things from the lookups list to the children ##################

sub Lookup ($$$$$) {
    my ($children, $lookups, $pending, $cache, $timeout) = @_;

    Debug (4, 'Queued lookup count: ' . scalar @$lookups . "\n");

    my ($chnum, $child, $ip, $hostname, $found, $tl,
        $rbin, $rout, $eout, $line, $ch, %rev);

    Debug (5,
        (join "\n", 'Pending lookups:',
            (map "$pending->{$_}\t$_",
                (sort {$pending->{$a} <=> $pending->{$b}} keys %$pending)),
            ('Total: ' . scalar keys %$pending)) . "\n");

    do { # main lookup loop - feed to children, then wait for responses
        $rbin = ''; # select bits start empty

      # feed lookups to children
        for ($chnum = 0; $chnum < scalar @$children; $chnum++) {
            $child = $children->[$chnum];

            if (scalar @$lookups and !$child->{'busy'}) {
                $ip = shift @$lookups;
                $line = "$ip\n";
                syswrite ($child->{'in'}, $line, length($line));
                $child->{'busy'} = 1;
                $pending->{$ip} = $chnum; # mark as pending
                Debug (4, "Asked child $chnum about $ip\n");
            }
  
            vec ($rbin, $child->{'out'}->fileno, 1) = $child->{'busy'};
        }

      # note that we use syswrite() and sysread() because the buffered
      # stuff like getline() can apparently interfere with select().
        ($found, $tl) = select ($rout=$rbin, undef, $eout=$rbin, $timeout-1);

        Debug (4, "Select found: $found error: ${\(0+$!)} '$!'\n");

        if ($found == 0) {
            my $sleeps = $timeout ? int($timeout/3 + 1) : 2;
            Debug (4, "No children ready, sleeping for $sleeps s.\n");
            sleep $timeout;
        } else {
            for ($chnum = 0; $chnum < scalar @$children; $chnum++) {
                $child = $children->[$chnum];

                if (vec ($rbin, $child->{'out'}->fileno, 1)) {
                    if (vec ($eout, $child->{'out'}->fileno, 1)) { # catch errs
                        vec($rout, $child->{'out'}->fileno, 1) = 0;
                        Debug (4, "Select error: $chnum ($child->{'pid'}): $!\n");
                        vec($rout, $child->{'out'}->fileno, 1) = 0;
                        $child->{'out'}->close;
                        $child->{'in'}->close;

                        Debug (4, "Killing child...\n");
                        kill (15, $child->{'pid'});
                        waitpid ($child->{'pid'}, 0);
                        Debug (4, "...child died.\n");

                      # make sure it goes away
                        $children->[$chnum] = undef;
                        undef $child;

                        Debug (4, "Replacing child.\n");
                        $children->[$chnum] = ForkChild($timeout);

                      # retry lookup for whatever that child was doing
                        foreach $ip (keys %$pending) {
                            if ($pending->{$ip} == $chnum) {
                                Debug (4, "Retrying lookup: $ip.\n");
                                unshift @$lookups, $ip;
                                delete $pending->{$ip};
                            }
                        }

                      ### Another way to do this re-lookup:
                        # %rev = (reverse %$pending);
                        # Debug (4, "Retrying lookup: $rev{$chnum}...\n");
                        # unshift @$lookups, $rev{$chnum};
                        # delete $pending->{$rev{$chnum}};

                    } elsif (vec ($rout, $child->{'out'}->fileno, 1)) {
                        $line = '';
                        $line .= $ch while (sysread ($child->{'out'}, $ch, 1)
                                            and $ch ne "\n");
                        ($ip, $hostname) = split (/\|/, $line, 2);
                        Debug (4, "Child $chnum reports: $ip => $hostname\n");
                        $cache->{$ip} = $hostname;
                        
                        Debug (0, "Error: $ip wasn't in pending\n")
                            unless exists $pending->{$ip};
                        Debug (0, "Error: child $chnum but pending $pending->{$ip}\n")
                            unless $pending->{$ip} == $chnum;
                        delete $pending->{$ip};
                        Debug (0, "Error: $ip stayed in pending\n")
                            if exists $pending->{$ip};

                        $child->{'busy'}= 0; # mark this child not busy
                    } else {
                        Debug (5, "Child $chnum ($child->{'pid'}) not ready\n");
                    }
                }
            }
        }
    } while (scalar @$lookups and !(scalar %$pending));

    return;
}

# Cleanup - kills children and closes db cache ###############################

sub Cleanup () {
    my $child;

    if (defined $DBCACHE) { # Close db file if necessary
        untie $cache;
        undef $DBCACHE;
    }

    Debug (2, "Killing children...\n");

    foreach $child (@$children) { # Kill children
        $child->{'out'}->close;
        $child->{'in'}->close;
        kill (15, $child->{'pid'}); # [2] is pid, of course.
    }

    Debug (2, "...done killing children\n");

    return;
}

### Mainline #################################################################

# get command-line options
my %options = ProcessOpts (); # merge defaults and command-line options

# open error stream
if (exists $options{'D'} and defined $options{'D'}) {
    open ERRORLOG, ">$options{'D'}"
        or die "Couldn't open debug log $options{'D'} for write";
} else {
    *ERRORLOG = *STDERR;
}

select (ERRORLOG); $| = 1; select (STDOUT); # autoflush error stream

Debug (0, "Verbosity level $VERBOSITY\n") if $VERBOSITY > 0;

if ($VERBOSITY > 2) { # dump options
    Debug (2, "Options:");
    for (sort {$a cmp $b} keys %options) {
        Debug (2, "  $_ => "
                  . (defined $options{$_} ? $options{$_} : '(undef)')
                  . "\n");
    }
}

if ($options{'h'}) {
    print STDERR <<"EOF";
This is $VERSION

Usage:
    $0 [-h] [-V] [-v]
    [-e time] [-r time] [-a time] [-t time] [-c #] [-d file]
    [-i file] [-o file] [-b file] [-s [file]]
    [-f file]
    [-m input,output,[bytecount],[stats] ...]

For more detailed help, read:
    perldoc $0
EOF
    exit 0;
} elsif ($options{'V'}) {
    print STDERR "$VERSION\n";
    exit 0;
}

# note that $children and $cache are global so Cleanup can see them.
$children = ForkChildren ($options{'c'}, $options{'t'});
$cache = InitCache ($options{'d'}); # Tie to DBM, or not.

$SIG{'KILL'} = $SIG{'INT'} = $SIG{'PIPE'} = sub { Cleanup; exit; };

my $streams = InitStreams ($options{'m'}); # make list of processing options
my $lookups = [];
my $pending = {};
my $timeout = $options{'t'};
my $fillcount = $options{'c'}*2;

Lookup ($children, $lookups, $pending, $cache, $timeout)
    while (GenReq ($streams, $lookups, $pending,
                   $fillcount, $cache, $timeout));

Cleanup;

exit (0);

####### EOF ##################################################################