#!/usr/bin/perl -w
use strict;

# pop-before-smtp 1.0 Bennett Todd <bet@rahul.net> Freely Redistributable
# 1.0 2000-01-04 first public release

# NB: As of this writing, I don't have a website available to publish updated
#     versions: if you grab this much after 2000-01-07 please drop an email to
#     <bet@rahul.net> asking if there's been an update, and let me know which
#     version you have. Thanks!

=head1 NAME

  pop-before-smtp --- watch log for POP/IMAP auth, update map allowing SMTP

=head1 SYNOPSIS

  nohup pop-before-smtp [--[no]write] [--[no]debug] \
	[--logfile=filename] \
	[--dbfile=filename] \
	[--grace=seconds] &

=head1 DESCRIPTION

pop-before-smtp watches /var/log/maillog for lines written by UW popd/imapd
describing successful login attempts, and installs entries for them in an
on-disk hash (DB) that is watched by postfix. It expires the entries after a
half-hour. The hash is named /etc/postfix/pop-before-smtp.db. The name, as
specified in the dbfile option, does not include the .db on the end, that's
tacked on to satisfy a wired-in assumption in postfix.

Internally, it keeps two data structures for all currently-allowed hosts; a
queue, and a hash. The queue contains [ipaddr, time] records, while the hash
contains ipaddr => time. Every time the daemon wakes up to deal with something
else from the File::Tail handle, it peeks a the front of the queue, and while
the timestamp of the record there has expired (is > 1800 seconds old) it
tosses it, and if the timestamp in the hash is also expired and equals the
timestamp in the queue it deletes the hash entry and the on-disk db file
entry.

Edit the source to change the wired-in filenames, grace period, logfile
format, etc.

When starting up, it builds an internal table of all netblocks natively
permitted by Postfix (it looks at the output of "postconf mynetworks"); before
adding each entry it checks to see if it would be permitted by that rule.

=head1 INSTALLATION

This daemon likes a couple of helpers. Here's a nice init script:

	#!/bin/sh
	progname=`basename $0`
	pgm=/usr/sbin/$progname
	log=/var/log/$progname
	pid=/var/run/$progname.pid
	die(){ echo "$progname: $*">&2; exit 1; }
	case "$1" in
	 start) $pgm >$log 2>&1 & echo $! >$pid;;
	  stop) p=`cat $pid`; test -n "$p" || exit 0
		kill $p || exit 0; sleep 1
		kill -9 $p 2>/dev/null || exit 0; sleep 1
		kill -0 $p && die "$pid won't die"
		;;
	esac

The integration in /etc/postfix/main.cf might look like this:

  smtpd_recipient_restrictions = permit_mynetworks,reject_non_fqdn_recipient,
	check_client_access hash:/etc/postfix/pop-before-smtp,
	check_relay_domains

=cut

use File::Tail;
use DB_File;
use Net::Netmask;
use Date::Parse;
use Getopt::Long;

##################################
#                                #
# Tuneable parameters start here #
#                                #
##################################

# Flags
my $write = 1;
my $debug = 0;

# File to watch for pop3d/imapd records
my $logfile = '/var/log/maillog';

# This regex pull the lines I'm interested in out of $logfile, and yanks out
# the timestamp and IP address
my $pat = '^(... .. ..:..:..) \S+ (?:ipop3d|imapd)\[\d+\]: ' .
          'Login user=\S+ host=\S+ \[(\d+\.\d+\.\d+\.\d+)\]';

my $dbfile = '/etc/postfix/pop-before-smtp'; # DB hash to write
my $grace = 1800; # 30 minutes --- grace period

GetOptions(
	"write!" => \$write,
	"debug!" => \$debug,
	"dbfile=s" => \$dbfile,
	"grace=i" => \$grace,
) or die "syntax: $0 [--[no]write] [--[no]debug] [--logfile=filename] " .
	"[--dbfile=filename] [--grace=seconds]\n";

# These parameters control how closely the watcher tries to follow the
# logfile, which affects how much resources it consumes, and how quickly
# people can smtp after they have popped.
my $fi = File::Tail->new(
	name => $logfile,
	maxinterval => 10,
	interval => 5,
	adjustafter => 3,
	tail => -1,
);

################################
#                              #
# Tuneable parameters end here #
#                              #
################################

my $mynets = `postconf mynetworks`;
for ($mynets) {
	s/^\s+//; s/\s+$//; s/\s+/ /g;
	s/^mynetworks\s*=\s*//;
}
Net::Netmask->new($_)->storeNetblock() for split /[,\s]+/, $mynets;

my (%t, @q);

use vars qw(%db);
my $dbh = tie %db, 'DB_File', "$dbfile.db", O_CREAT|O_RDWR, 0666, $DB_HASH or
	die "$0: cannot dbopen $dbfile: $!\n" if $write;
delete $db{$_} for keys %db;

$| = 1 if $debug;

while (1) {
	$_ = $fi->read;
	my ($timestamp, $ipaddr) = m/$pat/o or next;
	my $ts = str2time($timestamp) or next;
	$ts += $grace;
	next if $ts < time;
	print "read ts=$timestamp ip=$ipaddr\n" if $debug;
	next if findNetblock($ipaddr);
	print "\taccepted --- not in mynetworks\n" if $debug;
	push @q, [$ipaddr, $ts];
	$t{$ipaddr} = $ts;
	$db{$ipaddr} = "ok" if $write;
	$dbh->sync and die "$0: sync $dbfile: $!\n" if $write;
	print "\twritten ok\n" if $write and $debug;
	while ($q[0][1] < time) {
		print "purging ts=".localtime($q[0][1])." ip=$q[0][0]\n" if $debug;
		if ($q[0][1] == $t{$q[0][0]}) {
			delete $t{$q[0][0]};
			delete $db{$q[0][0]} if $write;
			$dbh->sync and die "$0: sync $dbfile: $!\n" if $write;
		}
		shift @q;
	}
}