=**************************************
= Name: LogResolve.pl script replacement
= Description:Drop-in replacement for the logresolve.pl script distributed
with the Apache web server that's approximately 10x faster
= By: Found on the World Wide Web
=**************************************
#!/usr/bin/perl -w
$CHILDREN = 40;# Number of children to spawn
$TIMEOUT= 30;# DNS timeout
$FLUSH = 3000; # Flush buffer every $FLUSH lines
$DEBUG = 0;
# ip2host v0.04 - Resolve IPs to hostnames in web server logs
# Maurice Aubrey <maurice@classmates.com>
#
# $Id: ip2host,v 1.1.1.4 2000/04/14 12:33:41 maurice Exp $
#
# CHANGES:
#
#0.05 Fri Apr 14 05:31:38 PDT 2000
#- Add POD to allow inclusion in CPAN
#
#0.04 Mon Nov 22 17:54:07 PST 1999
#- Check socketpair() return value
#- Updated documentation
#
#0.03 Thu Nov 18 16:57:53 PST 1999
#- Renamed $BUFFER to $FLUSH
#- Improved documentation
#
#0.02 Sat Oct 16 00:05:29 PDT 1999
#- Initial public release
use strict;
use vars qw( $CHILDREN $TIMEOUT $FLUSH $DEBUG %Buffer $Next_Line %Cache );
use Socket;
use IO::Handle;
use IO::Select;
my $cache_file = shift @ARGV;
if ($cache_file) { # Cache results to disk if asked
require DB_File;
tie %Cache, 'DB_File', $cache_file or die "unable to tie '$cache_file': $!";
}
# Write as many lines as we can until we come across one
# that's missing (that means it's still pending DNS).
sub flush_buffer {
for (; exists $Buffer{ $Next_Line }; $Next_Line++) {
print delete $Buffer{ $Next_Line };
}
}
# Spawn the children
my $read_select = new IO::Select;
my $write_select = new IO::Select;
for(my $child = 1; $child <= $CHILDREN; $child++) {
my($child_fh, $parent_fh) = (new IO::Handle, new IO::Handle);
socketpair($child_fh, $parent_fh, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
or die "socketpair failed: $!";
$child_fh->autoflush;
$parent_fh->autoflush;
if (my $pid = fork) {
close $parent_fh;
$write_select->add( $child_fh ); # Start out writing to all children
} else { # Child starts here
die "cannot fork: $!" unless defined $pid;
close $child_fh; close STDIN; close STDOUT;
$SIG{'ALRM'} = sub { die 'alarmed' };
while(defined(my $ip = <$parent_fh>)) { # Get IP to resolve
chomp($ip);
my $host = undef;
eval { # Try to resolve, but give up after $TIMEOUT seconds
alarm( $TIMEOUT );
my $ip_struct = inet_aton $ip;
$host = gethostbyaddr $ip_struct, AF_INET;
alarm(0);
};
# XXX Debug
if ($DEBUG and $@ =~ /alarm/) {
$host ||= 'TIMEOUT';
# print STDERR "Alarming ($ip)...\n";
}
$host ||= $ip;
print $parent_fh "$ip $host\n";
}
exit 0;
}
}
$Next_Line = 1;
my $lineno = 0;
my %pending = ();
while(1) {
# XXX Debug
# print STDERR "buff[", scalar keys %Buffer, "] pend[", scalar keys %pending,
# "] cache[", scalar keys %Cache, "]\n";
my($readable, $writable) =
IO::Select->select( $read_select, $write_select, undef );
if (@$writable) { # One or more children ready for an IP
my $line = '';
while(@$writable and defined($line = <STDIN>)) {
my($ip, $rest) = split / /, $line, 2;
flush_buffer if ++$lineno % $FLUSH == 0;
if (exists $Cache{ $ip }) { # We found this answer already
$Buffer{ $lineno } = "$Cache{ $ip } $rest";
} elsif (exists $pending{ $ip }) { # We're still looking
push @{ $pending{ $ip } }, [ $lineno, $rest ];
} else { # Send IP to child
my $write_fh = shift @$writable;
print $write_fh "$ip\n";
$pending{ $ip } = [ [ $lineno, $rest ] ];
$write_select->remove( $write_fh ); # Move to read set
$read_select->add( $write_fh );
}
}
defined $line or undef $write_select; # Are we done with input?
}
while (@$readable) { # One or more children have an answer
my $read_fh = shift @$readable;
my $str = <$read_fh>;
chomp($str);
my($ip, $host) = split / /, $str, 2;
$Cache{ $ip } = $host;
# Take all the lines that were pending for this IP and
# toss them into the output buffer
foreach my $pending (@{ $pending{ $ip } }) {
$Buffer{ $pending->[0] } = "$host $pending->[1]";
}
delete $pending{ $ip };
$read_select->remove( $read_fh ); # Move to write set
$write_select->add( $read_fh ) if defined $write_select;
}
last if not defined $write_select and not keys %pending;
}
flush_buffer;
=pod
=head1 NAME
ip2host - Resolve IPs to hostnames in web server logs
=head1 SYNOPSIS
ip2host [cache_file] < infile > outfile
infile - Web server log file. Any log format is acceptable,
as long as each line begins with the remote client's
IP address.
outfile - Same as input file, but with all of the IPs resolved
to hostnames.
=head1 DESCRIPTION
This script is a drop-in replacement for the logresolve.pl
script distributed with the Apache web server.
ip2host has the same basic design (fork children to handle
the DNS resolution in parallel), but multiplexes the communication.
This results in a significant speed improvement (approximately 10x
faster), and the performance degrades more gracefully as the DNS
timeout value ($TIMEOUT) is increased.
This script is reported to work under Linux, FreeBSD, Solaris,
Tru64, and IRIX.
=head1 AUTHOR
Maurice Aubrey E<lt>maurice@hevanet.comE<gt>
=head1 COPYRIGHT
Copyright 1999-2000, Maurice Aubrey E<lt>maurice@hevanet.comE<gt>.
All rights reserved.
This module is free software; you may redistribute it and/or
modify it under the same terms as Perl itself.
=head1 README
Drop-in replacement for the logresolve.pl script distributed
with the Apache web server that's approximately 10x faster.
=head1 SCRIPT CATEGORIES
Web
=cut
|
