#!/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 $
#
#  Flush and Usage handling by Will DeHaan <will@cobalt.com> 10/10/2000
#
#  Usage: see "sub usage"
#

#
#  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 = 30;			# Minutes an entry lasts.
$log_wait_interval = 5;			# Number of seconds between checks


#
#  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 usage {
    print <<EOF;
Usage: poprelayd [-p] [-a <ip>] [-r <ip>] [-d] [-f]\n

  -p          Displays a list of trusted IP addresses and their life in seconds.
  -a <ip>     Adds the specified IP address to the trusted pool.
  -r <ip>     Removes the specified IP address from the trusted pool.
  -f          Removes all members of the trusted pool.

poprelayd is used to enable temporary SMTP relaying trusts by monitoring POP 
and IMAP usage in the mail logfile, $logfile.

Every time a POP occurs, the client IP address will be added to the relay trust 
for $timeout_minutes minutes.  Every time an IMAP session is started, that client will
be added to the relay trust for the same amount of time.  IMAP sessions that last longer
than $timeout_minutes minutes will need to be restarted prior to sending mail.

EOF
    exit 0;
}

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 (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.

    # POP login by user "admin" at (10.9.28.29) 10.9.28.29
    # ensure line ends at IP address.  Filter on rejection codes
    if ($s =~ /POP login by user \"[\-\_\.\w]+\" at \(.+\) ([0-9\.]+)\s*$/)  {
        my $authuser = $1;
        return $authuser unless ($s =~ /reject=\d/i);
    }

    # imapd[11676]: Authenticated user=admin host=pyro.cobalt.com [10.9.28.29]
    # ensure line ends at IP address.  Filter on rejected syntax.
    if ($s =~ /(?:Authenticated|Login) user=\S+ host=(?:\S+ )*\[([\d\.]+)\]\s*$/) {
        my $authuser = $1;
        return $authuser unless ($s =~ /unknown command/i);
    }

    return ();
}

#  cleanup
#
#  Clean up and exit; executed on receipt of a sighup.
#
sub cleanup {
    unlink $pidfile;
    exit 0;
}


#
#  Main Program
#

$countopts = 0;
getopts('a:fdpr:t:') || &usage();

# 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;
}

# Flush the trusted relay IP list.
if ($opt_f)  {
    $countopts++;

    # cycle through the db blindly removing all entries
    my @trusts;
    opendb_write;
    foreach $key (sort(keys(%db))) {
	removedb($key);
    }
    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;
    }
}

&usage() unless ($countopts);

