#!/usr/bin/perl
#
#  poprelayd - update /etc/mail/popip based on POP logins
#
#  This code was written by Curt Sampson <cjs@cynic.net> and placed into
#  the public domain in 1998 by Western Internet Portal Services, Inc.
#  $Id: poprelayd,v 1.1.1.1 2000/07/27 03:10:31 cjs Exp $
#
#  Usage:
#	poprelayd -d
#	poprelayd -p
#	poprelayd -a <ip>
#	poprelayd -r <ip>
#
#  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.
#
# BUGS:
# Race condition between processes in opendb_*

#
#  Configuration settings.
#

$logfile = "/var/log/maillog";		# POP3 daemon log.
$pidfile = "/var/run/poprelayd.pid";	# Where we put our PID.
$dbfile = "/etc/mail/popip.db";		# Sendmail map to update.
$dbtype = "DB_HASH";
$timeout_minutes = 15;			# Minutes an entry lasts.
$log_wait_interval = 0.5;		# Number of seconds between checks
					# of the log file (float).


#
#  Modules
#

use Getopt::Std;
use Fcntl;
use DB_File;
use POSIX;
use File::Tail;

# You may need to uncomment this if your fcntl.ph doesn't export it.
sub O_EXLOCK { 0x20 };

#
#  Variables
#

undef $pid;				# Process ID.
undef %db;				# Hash into database file.
undef $lffd;				# $logfile file descriptor.

#
#  Subroutines
#

sub opendb_read {
    tie(%db, "DB_File", $dbfile, O_RDONLY, 0, $$dbtype) ||\
	die "Can't open $dbfile";
}

sub opendb_write {
    my $count=0;
    unless (tie(%db, "DB_File", $dbfile, O_RDWR|O_EXLOCK, 0, $$dbtype) ||
            $count ++ < 5) {
      sleep 5;
    }
    if (! ($count < 5)) {
	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 (sort(keys(%db))) {
	if ($db{$key} < $to)  {
	    delete $db{$key};
	}
    }
}

# getlogline()
#
# Return the next line from $logfile, or block until one is ready.
# Relies on File::Tail
#
sub getlogline {
    

    # The first time we're called; open the logfile, skip to the end,
    # and remember the inode we opened.
    if (!defined($lffd)) {
       $lffd = File::Tail->new(name=>$logfile, maxinterval=>5, interval=>$log_wait_interval);
       if (!defined($lffd)) {
          die "Can't open $logfile\n";
       }
    }
    return $lffd->read;
}

# scanaddr($line)
#
# Scan $line to see if it's a log of a successful POP3 authentication.
# Return an array of the addresses that authenticated.
#
sub scanaddr ($) {
    my $s = $_[0];
    my @paddrs;		# Packed IP addresses.
    my @addrs;		# ASCII addresses.
    my $junk;

    if ($s =~ m/i(pop2|pop3|map)d\[[0-9]+\]: Login user=/)  {
	$s =~ s/.*host=(\S+).*/$1/;
	chomp ($s);
	($junk, $junk, $junk, $junk, @paddrs) = gethostbyname($s);
	while (@paddrs)  {
	    push(@addrs, join('.', unpack('C4', shift(@paddrs))));
	}
	return @addrs;
    }
    return ();
}

#  cleanup
#
#  Clean up and exit; executed on receipt of a sighup.
#
sub cleanup {
    unlink $pidfile;
    kill TERM, $pid;
    exit 0;
}
sub cleanup_child {
    kill TERM, getppid;
    exit 0;
}


#
#  Main Program
#

$countopts = 0;
getopts('a:dpr:t:') || \
    die "Usage: poprelayd [-p] [-a <ip>] [-r <ip>] [-d]\n";

# Add an address.
if ($opt_a)  {
    $countopts++;
    opendb_write;
    adddb($opt_a);
    closedb;
}

# Remove an address.
if ($opt_r)  {
    $countopts++;
    opendb_write;
    removedb($opt_r);
    closedb;
}

# Timeout entries.
if ($opt_t)  {
    $countopts++;
    die "Invalid timeout value: $opt_t.\n" unless $opt_t > 0;
    opendb_write;
    timeoutdb($opt_t);
    closedb;
}

# Print address list.
if ($opt_p)  {
    $countopts++;
    opendb_read;
    foreach $key (sort(keys(%db))) {
	print "$key\t", time - $db{$key}, "\n";
    }
    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;

    # 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("/");

    # Fork timeout process
    if ($pid = fork) {
      # parent
      while ($line = getlogline) {
        undef @ret;
	if (@ret = scanaddr($line)) {
	  opendb_write;
	  while  (@ret) {
	    adddb(shift(@ret));
	  }
	  closedb;
	}
      }
      die "Can't get line.\n";
    } elsif (defined($pid)) {
      # child
      $SIG{INT} = \&cleanup_child;
      $SIG{TERM} = \&cleanup_child;
      $SIG{HUP} = \&cleanup_child;
      $lasttimeout = 0;
      while (1) {
	# Timeout entries if we haven't for a minute.
	opendb_write;
	if ((time - $lasttimeout) > 60)  {
	    $lasttimeout = time;
	    timeoutdb(60 * $timeout_minutes);
	}
	closedb;
	sleep 60;
      }
    } else {
      die "Can't fork: $!\n";
    }
}

if (! $countopts)  {
    die "Usage: poprelayd [-p] [-a <ip>] [-r <ip>] [-d]\n";
}