#!/usr/bin/perl
#
# readlog
# smtp-poplock package by David Harris <dharris@drh.net>
#

use IO::File;
use strict;

BEGIN: { require "/etc/smtp-poplock.conf" };

&main;

sub main
{
	my $feeder_pid;

	# Setup the TERM singal handler
	$SIG{'TERM'} = sub {
		unlink $Conf::readlog_pidfile if ( defined $Conf::readlog_pidfile );
		unlink $Conf::readlog_feeder_pidfile if ( defined $Conf::readlog_pidfile );
		kill("TERM", $feeder_pid) if ( defined $feeder_pid );
		exit 0;
	};

	# Toss our pid out there
	if ( defined $Conf::readlog_pidfile )
	{
		my $fh = new IO::File "> $Conf::readlog_pidfile"
			or die "could not open $Conf::readlog_pidfile for writing";
		print $fh "$$\n";
		undef $fh;
	}

	# Unlink the feeder_pidfile
	unlink $Conf::readlog_feeder_pidfile if ( defined $Conf::readlog_pidfile );

	# Read the database as it stands
	my $database;
	if ( -e $Conf::dbfile )
	{
		my $fh = new IO::File "< $Conf::dbfile" 
			or die "could not open $Conf::dbfile for reading";
		while ( <$fh> )
		{
			next unless /^(\S+)\s(\S+)$/;
			$database->{$1} = $2;
		}
	}

	# Open the readfile
	my $open_rv = open(READFH, $Conf::readfile);
	die "could not open $Conf::readfile for reading" if ( not defined $open_rv );

	# Setup the feeder_pid file
	if ( $open_rv != 1 ) {
		$feeder_pid = $open_rv;
		my $fh = new IO::File "> $Conf::readlog_feeder_pidfile"
			or die "could not open $Conf::readlog_feeder_pidfile for writing";
		print $fh "$feeder_pid\n";
		undef $fh;
	}

	# Loop for each line
	while ( <READFH> )
	{
		my $host;

		# Attempt to parse a hostname out of this line
		SWITCH:
		{
			# Format of qmail-pop3d as produced by logpopauth-*
			if ( /qmail-pop3d authenticated host:\s+(\S+)/i ) { $host = $1; last SWITCH; }

			# Call the sub to parse, if it is defined
			if ( defined $Conf::parse_log_sub )
			{
				$host = &$Conf::parse_log_sub($_);
				last SWITCH if defined $host;
			}
			else
			{
				# General catch-all
				if ( /(?:ipop3d|imapd)\[\d+\]: Login(?!\s*(?:failure|denied)).*\[(\d+\.\d+.\d+.\d+)\]/i ) { $host = $1; last SWITCH; }
				if ( /(?:pop3|imap).*\Wlogin(?!\s*(?:failure|denied)).*\D(\d+\.\d+\.\d+\.\d+)/i ) { $host = $1; last SWITCH; }
			}

			# NOTE: The lines matched by the first regular expression in the "catch-all"
			# section above should be a subset of the lines matched by the second regular
			# expression. But for some reason, some log lines matchd by the first, are not
			# by the second.. perhaps a problem with the regex backtracking? Well, to match
			# the imapd that ships with red hat 6.0, I've added the first regular rexpression.

			# Line did not match
			next;
		}

		# Translate from hostnames to ipaddrs
		my @ipaddrs = ();
		if ( $host =~ /\d+\.\d+\.\d+\.\d+/ )
		{
			@ipaddrs = ( $host );
		}
		elsif ( $host =~ /^[a-zA-Z0-9_.-]+$/ )
		{
			@ipaddrs = 
				map { join ".", unpack('C4',$_) }
				[ gethostbyname $host ]->[4];
		}

		# If we don't have a user, don't do anything
		next if ( @ipaddrs == 0 );

		# If the database has been truncated, respect that
		if ( -s $Conf::dbfile == 0 ) {
			$database = {};
		}

		# Add this user
		my $expires = time() + $Conf::access_time;
		foreach (@ipaddrs)
		{
			$database->{$_} = $expires;
		}

		# Remove old keys
		my $time = time();
		foreach ( keys %$database )
		{
			delete $database->{$_} 
				if ( $database->{$_} < $time );
		}

		# Update the database
		my $fh = new IO::File "> $Conf::dbfile.$$"
			or die "could not open $Conf::dbfile.$$ for reading";
		foreach ( keys %$database )
		{
			print $fh "$_ $database->{$_}\n";
		}
		undef $fh;
		rename("$Conf::dbfile.$$", $Conf::dbfile);
	}

	#
	# Unlink the pidfile and exit
	#

	unlink $Conf::readlog_pidfile if ( defined $Conf::readlog_pidfile );

	exit 0;
}