#!/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.5 2000/01/04 19:31:52 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.
#

#
#  Configuration settings.
#

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


#
#  Modules
#

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

# 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.
undef $lfino;				# Inode of $logfile when we opened it.
undef $lfbuf;				# Buffer for data from $lffd.
undef @addrs;				# List of IP addresses to add.
undef $lasttimeout;			# Last time we did a timeout.

#
#  Subroutines
#

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_EXCL, 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 (sort(keys(%db))) {
	if ($db{$key} < $to)  {
	    delete $db{$key};
	}
    }
}

# getlogline()
#
# Return the next line from $logfile, or undef if one isn't currently ready.
#
# XXX Note that there's a bug in this routine that causes it to ignore
# blank lines. I kinda like this behaviour, so I've not fixed it.
#
sub getlogline {
    my $junk;
    my $ino;
    my $foundeof = 0;
    my $buf;
    my $count;

    # The first time we're called; open the logfile, skip to the end,
    # and remember the inode we opened.
    if (!defined($lffd))  {
	$lffd = POSIX::open($logfile, O_RDONLY|O_NONBLOCK, 0);
	if (!defined($lffd))  {
	    die "Can't open $logfile\n";
	}
	if (POSIX::lseek($lffd, 0, &POSIX::SEEK_END) == -1)  {
	    die "Can't seek to end of $logfile\n";
	}
	($junk, $lfino, $junk) = POSIX::fstat($lffd);
    }

    # Append new data, if available, to our buffer.
    $count = POSIX::read($lffd, $buf, 1024);
    if ($count)  {
	$lfbuf = $lfbuf . $buf;
    }

    # Return a line, if we have one.
    if ($lfbuf =~ m/\n/m)  {
	($buf, $lfbuf) = split(/\n/m, $lfbuf, 2);
	return $buf;
    }

    # Check the inode number of $logfile; if it's not the saved one,
    # the logfile has been rotated and we need to reopen.
    ($junk, $ino, $junk) = POSIX::stat($logfile);
    if ($ino != $lfino)  {
	POSIX::close($lf_fd);
	undef($lf_fd);
	$lffd = POSIX::open($logfile, O_RDONLY|O_NONBLOCK, 0);
	if (!defined($lffd))  {
	    die "Can't open $logfile\n";
	}
	($junk, $lfino, $junk) = POSIX::fstat($lffd);
    }

    return undef;
}

# 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/ Login user=/)  {
      ($junk, $s) = ($s=~ m/host=(\S+) .(\d+\.\d+\.\d+\.\d+)./);
      return $s;
    }
    return ();
}

#  cleanup
#
#  Clean up and exit; executed on receipt of a sighup.
#
sub cleanup {
    unlink $pidfile;
    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("/");

    # Main loop.
    $lasttimeout = 0;
    while (1)  {
	# Build list of addresses of recent authentications.
	while ($line = getlogline)  {
	    undef $ret;
	    if ($ret = scanaddr($line))  {
		push(@addrs, $ret);
	    }
	}
	# Add this list to current set.
	opendb_write;
	while ($addr = pop(@addrs))  {
	    adddb($addr);
	}
	# Timeout entries if we haven't for a minute.
	if ((time - $lasttimeout) > 60)  {
	    $lasttimeout = time;
	    timeoutdb(60 * $timeout_minutes);
	}
	closedb;
	sleep $log_wait_interval;
    }
}

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