This was a script DaveBrown and I hacked while working at InternetAlaska. We started off with the Perl daemon by Curt Sampson (mailto:cjs@cynic.net) and then refined and simplified it quite a bit (it wouldn't deal with the number of mail requests we were getting due to some logic bugs).
The current project (differnt from ours) is now at SourceForge, though I think it's basically dead.
Download sources here: poprelayd.pl
#!/usr/bin/perl
# poprelayd - update popauthip.db based on POP logins
#
# This code was originally written by Curt Sampson <cjs@cynic.net> and
# placed into the public domain in 1998 by Western Internet Portal
# Services, Inc.
#
# poprelayd was modified in May 2000 by Dave Brown of Internet Alaska, Inc.
# to use File::Tail for more resilience to various log rolling
# methods. scanaddr was modified to only select IPs that fall outside
# a defined network block. poprelayd now checks for $pidfile before running
# in daemon mode. The print routine was also changed to sort output
# by the length of time in the database.
#
# Usage:
# poprelayd -d
# poprelayd -p
# poprelayd -a <ip>
# poprelayd -r <ip>
# poprelayd -t <time> removes entries older than <time>
#
# With the -d option this program goes into daemon mode. It will
# monitor /var/log/maillog (following rollovers by newsyslog)
# for successful POP3 logins. When it sees one, it will
# look up the IP address the login came from and add this to the
# popip sendmail map (the address as the key, the current time in
# seconds since the epoch as the datum). Every five minutes or so it
# will also remove any addresses older than a certain time from that
# file.
#
# If given the -p option, the program will not go into daemon mode,
# but will instead dump the current database, printing each IP address
# and its age.
#
# The -a option will add the IP address given.
#
# The -r option will delete the IP address given.
#
#
# Configuration settings.
#
$logfile = "/var/log/pop.log"; # POP3 daemon log.
$pidfile = "/var/run/poprelayd.pid"; # Where we put our PID.
$dbfile = "/share/etc/mail/popauthip.db"; # Sendmail map to update.
$dbtype = "DB_HASH";
$timeout_minutes = 60; # Minutes an entry lasts.
# checks of the log file.
#
# Modules
#
use Getopt::Std;
use Fcntl;
use DB_File;
use POSIX;
use File::Tail;
#
# Variables
#
undef $pid; # Process ID.
undef %db; # Hash into database file.
undef @addrs; # List of IP addresses to add.
undef $lasttimeout; # Last time we did a timeout.
#
# Subroutines
#
sub O_EXLOCK { 0x20 };
sub opendb_read {
tie(%db, "DB_File", $dbfile, O_RDONLY, 0, $$dbtype) ||\
die "Can't open $dbfile --$!";
}
sub opendb_write {
tie(%db, "DB_File", $dbfile, O_RDWR|O_EXLOCK, 0, $$dbtype) ||\
die "Can't open $dbfile";
}
sub closedb {
untie %db;
}
sub adddb {
my $addr = $_[0];
$db{$addr} = time;
}
sub removedb {
my $addr = $_[0];
delete $db{$addr};
}
#
# timeoutdb(secs)
# Remove all entries from %db more than secs seconds old.
#
sub timeoutdb {
# Convert timeout in secs to a time_t before which we delete.
my $to = time - $_[0];
foreach $key (keys(%db)) {
if ($db{$key} < $to) {
delete $db{$key};
}
}
}
#
# You need to make sure $s gets an ip address for a valid pop
# entry in your log file....
#
sub scanaddr ($) {
my $s = shift; # or $_[0] if you prefer
my $ip;
$s =~ m/cucipop\[\d+\]:(\s*lost)?\s+\S+\s+(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/;
$ip = $2;
if ( $ip ) {
($ip1, $ip2, $ip3) = (split /\./, $ip);
if ($ip1 != 209) {
return $ip;
}
elsif ($ip2 != 112) {
return $ip;
}
elsif (($ip3 < 128) or ($ip3 > 207)) {
return $ip;
}
else {
return ();
}
}
else {
return ();
}
}
#
# Clean up and exit; executed on receipt of a sighup.
#
sub cleanup {
unlink $pidfile;
exit 0;
}
#
# Main Program
#
if ($#ARGV == "-1") {
die "Usage: poprelayd [-t <time>] [-p] [-a <ip>] [-r <ip>] [-d]\n";
}
die "Usage: poprelayd [-t <time>] [-p] [-a <ip>] [-r <ip>] [-d]\n" if ! getopts('a:dpr:t:');
# Add an address.
if ($opt_a) {
opendb_write;
adddb($opt_a);
closedb;
}
# Remove an address.
if ($opt_r) {
opendb_write;
removedb($opt_r);
closedb;
}
# Timeout entries.
if ($opt_t) {
die "Invalid timeout value: $opt_t.\n" unless $opt_t > 0;
opendb_write;
timeoutdb($opt_t);
closedb;
}
# Print address list.
if ($opt_p) {
opendb_read;
my @biglist;
my $curtime;
foreach $key (keys(%db)) {
$curtime = time - $db{$key};
push(@biglist, "$curtime\t\t$key\n");
}
print (sort { $a <=> $b } @biglist);
closedb;
}
# Daemon mode.
if ($opt_d) {
# Check to see we can read/write the files we need.
die "Can't read $logfile: $!\n" if ! -r $logfile;
die "Can't write $dbfile: $!\n" if ! -w $dbfile;
die "Pidfile exists: $pidfile \n" if -f $pidfile;
# Become a daemon: fork, detach, cd /, set creation mode to 0.
if ($pid = fork) {
exit 0; # Parent.
} elsif (defined($pid)) {
$pid = getpid; # Child.
} else {
die "Can't fork: $!\n";
}
# Catch signals.
$SIG{INT} = \&cleanup;
$SIG{TERM} = \&cleanup;
$SIG{HUP} = \&cleanup;
# Write PID file.
open(PIDFILE, ">$pidfile") || die "Can't open PID file: $!\n";
print PIDFILE "$pid\n";
close(PIDFILE);
chmod(0644, $pidfile);
# Detach from terminal, etc.
setpgrp(0, 0);
close(STDIN); close(STDOUT); close(STDERR);
chdir("/");
# Main loop.
$lasttimeout = 0;
$file=File::Tail->new(name=>$logfile, interval=>2, maxinterval=>60, resetafter=>10);
while (defined($line=$file->read)) {
undef @ret;
if (@ret = scanaddr($line)) {
push(@addrs, @ret);
}
# Timeout entries if we haven't for 3 seconds and add new addresses to database
if ((time - $lasttimeout) > 3) {
opendb_write;
$lasttimeout = time;
timeoutdb(60 * $timeout_minutes);
foreach ( @addrs ) {
adddb($_);
}
@addrs = ();
closedb;
}
}
}
poprelayd.pl