[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[cobalt-users] RaQ3: Modified poprelayd script for qpopper 3.0.2

Hi friends,

if you run pop-before-smtp you might want to 
modify your poprelayd script. The new qpopper 
has a slightly different log-file format.
Feel free to use mine. Make a diff before 
you use it, you'll see the modifications 
in a glance (starting at line 177).

Mike 

P.S. wanted to send it as an attachment,
but that bounced .o). So you will have to
make up your tabs, or better modify the
script by hand - there are just a handful
of modfied lines anyway. :o)


#!/usr/bin/perl
#
#  poprelayd - update /etc/mail/popip based on POP logins
#
#  This code was written by Curt Sampson <cjs@xxxxxxxxx> and placed into
#  the public domain in 1998 by Western Internet Portal Services, Inc.
#  $Id: poprelayd,v 1.2 1999/01/27 22:19:28 cjs Exp $
#
#  Modified by zim@xxxxxxxx 2000-07-23 (added IMAP Logins, and qpopper 3.0.2)
#
#  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/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.


#
#  Modules
#

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

sub O_EXLOCK { 0x20 };			# XXX Fcntl doesn't export this!

#
#  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_CREATE, 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;

    ## Either finds lines of the POP login format, like:
    #  POP login for "zim" at (pC19EABB6.dip0.t-ipconnect.de) 193.158.171.182
    if ($s =~ /POP login for \"[\-\_\w]+\" at \(.+\) ([0-9\.]+)/)  {
	return $1;
	}
    #  POP login by user "zim" at (pC19EAB90.dip0.t-ipconnect.de) 193.158.171.144
    if ($s =~ /POP login by user \"[\-\_\w]+\" at \(.+\) ([0-9\.]+)/)  {
	return $1;
	}
    ## Or finds lines of the IMAP Login format, like:
    #  Login user=zim host=pC19EABB6.dip0.t-ipconnect.de [193.158.171.182]
    if ($s =~ /Login user=[^ ]+ host=[^ ]+ \[([0-9\.]+)\]/)  {
	return $1;
	}
    ## Nothing found; empty return.
    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 644, $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 5;
    }
}

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