# This config file is a perl library that can override various aspects
+ of the
# pop-before-smtp script's setup.  Install it as /etc/pop-before-smtp-
+conf.pl

# There's quite a bit of sample stuff after the options, so you probab
+ly don't
# need to read through all of this.  If you're using Postfix and UW PO
+P/IMAP,
# you can likely just use the default setup without any changes.  The 
+most
# common changes needed are to pick the right $pat variable for your P
+OP/IMAP
# software, ensure that the mail-log name is right, and perhaps uncomm
+ent a
# section with the support for a different SMTP (other than Postfix). 
+ See the
# contrib/README.QUICKSTART file for step-by-step instructions on how 
+to
# install and test your setup.

use strict;
use vars qw(
    $pat $out_pat $write $flock $debug $reprocess $grace $logto %file_
+tail
    @mynets %db $dbfile $dbvalue $logtime_pat
    $mynet_func $tie_func $flock_func $add_func $del_func $sync_func
    $tail_init_func $tail_getline_func $log_func
    $PID_pat $IP_pat $OK_pat $FAIL_pat $OUT_pat
);

#
# Override the default options here (or use the command-line options):
#

# Clear to avoid our exclusive file locking when updating the DB.
#$flock = 0;

# Set $debug to output some extra log messages (if logging is enabled)
+.
#$debug = 1;
#$logto = '-'; # Log to stdout.
#$logto = '/var/log/pop-before-smtp';

# Override the DB hash file we will create/update (".db" gets appended
+).
$dbfile = '/etc/postfix/pop-before-smtp';

# Override the value that gets put into the DB hash.
$dbvalue = 'ok';

# A 30-minute grace period before the IP address is expired.
$grace = 30*60;

# Set the log file we will watch for pop3d/imapd records.
$file_tail{'name'} = '/var/log/popb4smtp.log';
#$file_tail{'name'} = '/Library/Logs/MailService/AppleMailServer.IMAP.
+log';

# ... or we'll try to figure it out for you.
if (!-f $file_tail{'name'}) {
    foreach (qw( /var/log/mail/info /var/log/mail.log
         /var/log/messages /var/adm/messages )) {
    if (-f $_) {
        $file_tail{'name'} = $_;
        last;
    }
    }
}

# If you need to define a custom PATH (for instance, if you're using P
+ostfix
# and postconf is someplace wierd), uncomment and customize this.
#$ENV{'PATH'} = '/usr/sbin:/usr/bin:/sbin:/bin:/usr/local/sbin:/usr/lo
+cal/bin';

# These parameters control how closely the watcher tries to follow the
# logfile, which affects how much resources it consumes, and how quick
+ly
# people can smtp after they have popped.  These values are documented
+ in
# the File::Tail pod (run "perldoc File::Tail" to find out details).
# These commented-out values are the ones Daniel Roesen prefers.

$file_tail{'maxinterval'} = 2;
$file_tail{'interval'} = 1;
$file_tail{'adjustafter'} = 3;
$file_tail{'resetafter'} = 30;
$file_tail{'tail'} = -1;

=cut #============================ syslog ============================
+=START=
# If you want to output a log file of what pop-before-smtp is doing, y
+ou have
# a few choices: either set $logto above, comment-out the two surround
+ing
# =cut lines to use this syslog section, or put a reference to your ow
+n
# custom logging function into $log_func.

use Sys::Syslog qw(:DEFAULT setlogsock);
# Try uncommenting this if you get no syslog output:
#setlogsock('unix');  # Valid arg values: inet, unix, stream, console.
openlog('pop-before-smtp', 'pid', 'mail');
$log_func = \&syslog;
=cut #============================ syslog ============================
+===END=

=cut #-------------------------- File::Tail --------------------------
+-START-
# If you want to use the File::Tail module to read the logfile, commen
+t-out
# the two surrounding =cut lines.  (By default pop-before-smtp now use
+s its
# own, simpler file-tailing functions.)

use File::Tail;

$tail_init_func = \&init_FileTail;
$tail_getline_func = \&getline_FileTail;

sub init_FileTail
{
    $::ft_handle = File::Tail->new(%file_tail);
}

sub getline_FileTail
{
    $::ft_handle->read;
}

=cut #-------------------------- File::Tail --------------------------
+---END-

############################# START OF PATTERNS ######################
+#######
#
# Pick one of these values for the $pat variable OR define a subroutin
+e
# named "custom_match" to handle a more complex match scenario (there'
+s
# an example below).  Feel free to delete all the stuff you don't need
+.
#
# To enable an entry, just delete the "#" at the start of all the line
+s
# *after* the initial comment line(s).  If the entry of your choice al
+so
# provides $out_pat, you should uncomment that variable as well, which
# allows us to keep track of users who are still connected to the serv
+er
# (e.g. Thunderbird caches open IMAP connections).
#
# Note also that the servers that require multiple log lines be read t
+o
# get all the needed info have a setup with 3 $NAME_pat variables inst
+ead
# of a single "$pat" variable.  Uncomment all 3 and we'll define a mul
+ti-
# line-matching custom_match() subroutine for you.
#
# Technical:  if you want to define a new $pat regex, make sure that y
+ou
# include the string "[LOGTIME]" near the start because this string wi
+ll
# be replaced by the final value of the $logtime_pat variable, and thi
+s
# handles the matching and returning of the first value the code needs
+:
# the line's timestamp.  There must also be a 2nd value returned from 
+the
# regular expression:  the IP number.
#
############################# START OF PATTERNS ######################
+#######

# If your logfile has a non-standard time-stamp, you may need to defin
+e the
# $logtime_pat value here, or use one of the known variations included
+ next
# to the relevant patterns.  The value should include parentheses, and
+ (for
# maximum flexibility) should be able to match the time on any log lin
+e.
# This defaults to "(\w\w\w +\d+ \d+:\d+:\d+)" if left undefined.

#$logtime_pat = '(\d\d\d\d-\d\d-\d\d \d+:\d+:\d+)';

# For UW POP/IMAP. This is the DEFAULT $pat (without an $out_pat, by d
+efault).
#$pat = '^[LOGTIME] \S+ (?:ipop3s?d|imaps?d)\[\d+\]: ' .
#    '(?:Login|Authenticated|Auth|APOP) user=\S+ ' .
#    'host=(?:\S+ )?\[(\d+\.\d+\.\d+\.\d+)\]';
#$out_pat = '^[LOGTIME] \S+ (?:ipop3s?d|imaps?d)\[\d+\]: ' .
#    '(?:Logout|Autologout|Killed.*?|Command stream end of file.*?) us
+er=\S+ host=(?:\S+ )?\[(\d+\.\d+\.\d+\.\d+)\]';

# Some folks need a little different match for UW ipop3d/imapd:
#$pat = '^[LOGTIME] \S+ (?:ipop3s?d|imaps?d)\[\d+\]: \[[^]]+\]' .
#    '(?:Login|Authenticated|Auth|APOP) user=\S+ ' .
#    'host=(?:\S+ )?\[(\d+\.\d+\.\d+\.\d+)\]';

# For GNU pop3d
#$pat = '^[LOGTIME] \S+ gnu-pop3d\[\d+\]: ' .
#    'User .+ logged in with mailbox .+ from (\d+\.\d+\.\d+\.\d+)';

# A fairly modern Qpopper pattern, when using syslog.
#$pat = '^[LOGTIME] \S+ (?:in\.q|q)?popper[^[]*\[\d+\]: \([^)]*\) ' .
#    'POP login by user "[^"]+" at \([^)]+\) (\d+\.\d+\.\d+\.\d+)';

# The same Qpopper pattern as above, but matches Qpopper's own logging
+.
#$pat = '^[LOGTIME] \[popper\] \([^)]*\) ' .
#    'POP login by user (?:"[^"]+"|\S+) at \([^)]+\) (\d+\.\d+\.\d+\.\
+d+)';

# For Qpopper POP/APOP Server (matches in.qpopper, qpopper, and popper
+).
#$pat = '^[LOGTIME] \S+ (?:in\.q|q)?popper\[\d+\]: Stats: \S+ ' .
#    '\d+ \d+ \d+ \d+ (?:\S+ )?(\d+\.\d+\.\d+\.\d+)';

# Chris D.Halverson's pattern for Qpopper 3.0b29 on Solaris 2.6
#$logtime_pat = '(... ... .. \d+:\d+:\d+ \d{4})';
#$pat = '^[LOGTIME] \[\d+\] Stats:\s+\w+ ' .
#    '\d \d \d \d [\w\.]+ (\d+\.\d+\.\d+\.\d+)';

# For Cyrus (including a tweak for IP addrs that don't resolve):
#$pat = '^[LOGTIME] \S+ (?:cyrus/)?(?:pop3|imap)[ds]?\[\d+\]: ' .
#    'login: .*?\[[:f]*(\d+\.\d+\.\d+\.\d+)\]';

# For Courier-POP3 and Courier-IMAP:
#$pat = '^[LOGTIME] (?:\[|\S+ )(?:pop3|imap|couriertcp)(?:d|d-ssl|logi
+n)\]?: ' .
#    'LOGIN, user=\S+, ip=\[[:f]*(\d+\.\d+\.\d+\.\d+)\]';
#$out_pat = '^[LOGTIME] (?:\[|\S+ )(?:pop3|imap|couriertcp)(?:d|d-ssl|
+login)\]?: ' .
#    '(?:LOGOUT|DISCONNECTED), user=\S+, ip=\[[:f]*(\d+\.\d+\.\d+\.\d+
+)\]';

# For qmail's pop3d:
#$pat = '^[LOGTIME] \S+ vpopmail\[\d+\]: vchkpw: ' .
#    'login \[\S+\] from (\d+\.\d+\.\d+\.\d+)';

# For cucipop, matching a sample from Daniel Roesen:
#$pat = '^[LOGTIME] \S+ cucipop\[\d+\]: \S+ ' .
#    '(\d+\.\d+\.\d+\.\d+) \d+, \d+ \(\d+\), \d+ \(\d+\)';

# A Modern vm-pop3d can use a normal, 1-line pattern:
#$pat = '^[LOGTIME] \S+ vm-pop3d\[\d+\]: ' .
#    'User .+? logged in from (\d+\.\d+\.\d+\.\d+)';

# Older vm-pop3d -- needs to match 2 log entries (uncomment all 3 *_pa
+t lines).
#$PID_pat = '^[LOGTIME] \S+ vm-pop3d\[(\d+)\]: ';
#$IP_pat = $PID_pat . 'Connect from (\d+\.\d+\.\d+\.\d+)';
#$OK_pat = $PID_pat . 'User .+? logged in';

# For popa3d -- needs to match 2 log entries (uncomment all 3 *_pat li
+nes).
#$PID_pat = '^[LOGTIME] \S+ popa3d\[(\d+)\]: ';
#$IP_pat = $PID_pat . 'Session from (\d+\.\d+\.\d+\.\d+)';
#$OK_pat = $PID_pat . 'Authentication passed for ';

# For *patched* popa3d (see the patch in the contrib/popa3d dir).
#$pat = '^[LOGTIME] \S+ popa3d\[\d+\]: ' .
#    'Authentication passed for \S+ -- \[(\d+\.\d+\.\d+\.\d+)\]';

# A Perdition pattern.
#$pat = '^[LOGTIME] \S+ perdition\[\d+\]: ' .
#    'Auth: (\d+\.\d+\.\d+\.\d+)\-\>\d+\.\d+\.\d+\.\d+ ' .
#    'user=\"\S+\" server=\"\S+\" port=\"\S+\" status=\"ok\"';

# For solidpop3d (aka spop3d) ** if configured with --enable-logextend
+! **
#$pat = '^[LOGTIME] \S+ spop3d\[\d+\]: ' .
#    'user \S+ authenticated - (\d+\.\d+\.\d+\.\d+)';

# For spop3d w/o --enabled-logextend (uncomment all 3 *_pat lines).
#$PID_pat = '^[LOGTIME] \S+ spop3d\[(\d+)\]: ';
#$IP_pat = $PID_pat . 'connect from (\d+\.\d+\.\d+\.\d+)';
#$OK_pat = $PID_pat . 'user \S+ authenticated';

# Pattern for teapop (http://www.toontown.org/teapop/) by Patrick Pras
+se.
#$pat = '^[LOGTIME] \S+ teapop\[\d+\]: ' .
#    'Successful login for .+? \[(\d+\.\d+\.\d+\.\d+)\]';

# For Dovecot POP3/IMAP when using syslog.
#$pat = '^[LOGTIME] \S+ (?:dovecot: )?(?:imap|pop3)-login: ' .
#    'Login: .*? (?:\[|rip=)[:f]*(\d+\.\d+\.\d+\.\d+)[],]';
#$pat = '^[LOGTIME] \S+ (?:imap|pop3)-login: ' .
#    'Login: .*? (?:\[|rip=)[:f]*(\d+\.\d+\.\d+\.\d+)[],]';
#$out_pat = '^[LOGTIME] \S+ (?:dovecot: )?(?:imap|pop3)-login: ' .
#    'Disconnected.*? (?:\[|rip=)[:f]*(\d+\.\d+\.\d+\.\d+)[],]';

# For Dovecot POP3/IMAP when it does its own logging.
#$logtime_pat = '(\d\d\d\d-\d+-\d+ \d+:\d+:\d+)';
#$pat = '^dovecot: [LOGTIME] Info: (?:imap|pop3)-login: ' .
#    'Login: .+? rip=[:f]*(\d+\.\d+\.\d+\.\d+),';
#$out_pat = '^dovecot: [LOGTIME] Info: (?:imap|pop3)-login: ' .
#    'Disconnected.*? rip=[:f]*(\d+\.\d+\.\d+\.\d+),';

# For older Dovecot POP3/IMAP when it does its own logging.
#$pat = '^(?:imap|pop3)-login: [LOGTIME] Info: ' .
#    'Login: \S+ \[[:f]*(\d+\.\d+\.\d+\.\d+)\]';
#$out_pat = '^(?:imap|pop3)-login: [LOGTIME] Info: ' .
#    'Disconnected.*? \[[:f]*(\d+\.\d+\.\d+\.\d+)\]';

# Custom Dovecot

#$pat = '^(... .. ..:..:..) \S+ (?:pop3|imap)-login: Login: .+ \[(\d+\
+.\d+\.\d+\.\d+)\]';

while(<$file_tail{'name'}>){
   push @pat, (split /, /, $_)[2];
 }

# For Apple IMAP MAIL Server
#$logtime_pat = '(\w\w\w +\d+ \d\d\d\d \d+:\d+:\d+)';
#$pat = '^[LOGTIME].* IMAP User "[^"]+" ' .
#    'log on successful from (\d+\.\d+\.\d+\.\d+)';

############################## END OF PATTERNS #######################
+#######


=cut #====================== Match Many Patterns =====================
+=START=
# Comment-out (or remove) the two surrounding =cut lines to use this f
+unction.

# This is an example of using the custom_match() function to match
# several patterns (allowing you to match multiple pop/imap servers
# at the same time).  Note that you can define logout patterns for
# some, all, or none of the login patterns, as needed.

my(@login, @logout);

$login[0] = $pat;
#$logout[0] = $out_pat;

$login[1] = '... define an extra login pattern here ...';
#$logout[1] = '... define an extra logout pattern, if needed ...';

# ... plus any other patterns you want to define ...

foreach (@login, @logout) {
    next unless defined $_;
    $_ = qr/$_/;    # Pre-compile the regular expressions.
}

# The mail-log line to match is in $_.
sub custom_match
{
    my($timestamp, $ipaddr);
    foreach my $regex (@logout) {
    if (defined($regex) && (($timestamp, $ipaddr) = /$regex/)) {
        return ($timestamp, $ipaddr, -1);
    }
    }
    my $j = 0;
    foreach my $regex (@login) {
    if (($timestamp, $ipaddr) = /$regex/) {
        my $increment = defined($logout[$j]) ? 1 : 0;
        return ($timestamp, $ipaddr, $increment);
    }
    $j++;
    }
    ( );
}
=cut #====================== Match Many Patterns =====================
+===END=

######################### Alternate DB/SMTP support ##################
+#######
#
# If you need to use something other than DB_File, define your own tie
+,
# sync, and (optionally) flock functions.
#
######################### Alternate DB/SMTP support ##################
+#######

=cut #----------------------- Postfix NDBM_File ----------------------
+-START-
# If you comment-out (or remove) the two surrounding =cut lines, we'll
+ use
# NDBM_File instead of DB_File.

use Fcntl;
use NDBM_File;

#$mynet_func = \&mynet_postfix; # Use the default
$tie_func = \&tie_NDBM;
$sync_func = sub { };
$flock = 0;

# We must tie the global %db using the global $dbfile.
sub tie_NDBM
{
    tie %db, 'NDBM_File', $dbfile, O_RDWR|O_CREAT, 0664
    or die "$0: cannot dbopen $dbfile: $!\n";
}
=cut #----------------------- Postfix NDBM_File ----------------------
+---END-

=cut #====================== Postfix BerkeleyDB ======================
+=START=
# If you comment-out (or remove) the two surrounding =cut lines, we'll
+ use
# BerkeleyDB instead of DB_File.

use BerkeleyDB;

#$mynet_func = \&mynet_postfix; # Use the default
$tie_func = \&tie_BerkeleyDB;
$sync_func = \&sync_BerkeleyDB;
$flock = 0;

my $dbh;

# We must tie the global %db using the global $dbfile.  Also sets $dbh
+ for
# our sync function.
sub tie_BerkeleyDB
{
    $dbh = tie %db,'BerkeleyDB::Hash',-Filename=>"$dbfile.db",-Flags=>
+DB_CREATE
    or die "$0: cannot dbopen $dbfile: $!\n";
}

sub sync_BerkeleyDB
{
    $dbh->db_sync and die "$0: sync $dbfile: $!\n";
}
=cut #====================== Postfix BerkeleyDB ======================
+===END=

=cut #------------------------ qmail tcprules ------------------------
+-START-
# If you comment-out (or remove) the two surrounding =cut lines, we'll
+ use
# the tcprules program instead of maintaining a DB_File hash.

my $TCPRULES = '/usr/local/bin/tcprules';

$mynet_func = \&mynet_tcprules;
$tie_func = \&tie_tcprules;
$sync_func = \&sync_tcprules;
$flock = 0;

sub mynet_tcprules
{
    # You'll probably want to edit this (it specifies IP ranges to ign
+ore).
    '127.0.0.0/8 192.168.1.1/24';
}

my @qnets;

# We leave the global %db as an untied hash and setup a @qnets array.
sub tie_tcprules
{
    # convert 10.1.3.0/28 to 10.1.3.0-15 
    #     and 10.1.0.0/16 to 10.1.
    # because tcprules doesn't understand nnn.nnn.nnn.nnn/bb netmask f
+ormats
    foreach (@mynets) {
    if (m#(.*)/(\d+)#) { 
        $_ = $1; 
        my $netbits = (32 - $2);
        while (int($netbits / 8)) { # for every 8 bits, chop a quad
        s/\.[^.]*$//; 
        $netbits -= 8; 
        }
        s/(\d+)$/$1.sprintf("-%d",$1 + (2**$netbits) - 1)/e if $netbit
+s > 0;
        /(\..*){3}/ or s/$/./;
    } 
    push @qnets, $_;
    }
}

sub sync_tcprules
{
    open(RULES, "|$TCPRULES $dbfile $dbfile.tmp") or die "forking tcpr
+ules: $!";
    map { print RULES "$_:allow,RELAYCLIENT=''\n" } @qnets, keys %db;
    print RULES ":allow\n";
    close RULES or die "closing tcprules pipe: $!";
    $log_func->('debug', "wrote tcp rules to $dbfile") if $debug;
}
=cut #------------------------ qmail tcprules ------------------------
+---END-

=cut #========================= Courier SMTP =========================
+=START=
# If you comment-out (or remove) the two surrounding =cut lines, we'll
# interface with Courier SMTP using DB_File.

my $ESMTPD = '/usr/lib/courier/sbin/esmtpd';

use Fcntl qw(:DEFAULT :flock);
use DB_File;

$dbfile = '/etc/courier/smtpaccess'; # DB hash to write
$dbvalue = 'allow,RELAYCLIENT';

$mynet_func = \&mynet_courier;
$tie_func = \&tie_courier;
$sync_func = \&sync_courier;
$flock_func = \&flock_courier;

sub mynet_courier
{
    '';
}

my $dbh;

sub tie_courier
{
    $dbh = tie %db, 'DB_File', "$dbfile.dat", O_CREAT|O_RDWR, 0666, $D
+B_HASH
    or die "$0: cannot dbopen $dbfile: $!\n";
    if ($flock) {
    my $fd = $dbh->fd;
    open(DB_FH,"+<&=$fd") or die "$0: cannot open $dbfile filehandle: 
+$!\n";
    }
}

sub flock_courier
{
    my($locking) = @_;
    flock(DB_FH, $locking ? LOCK_EX : LOCK_UN)
    or die "$0: flock_courier($locking) failed: $!\n";
}

sub sync_courier
{
    $dbh->sync and die "$0: sync $dbfile: $!\n" if $write;

    # Reload SMTP Daemon (isn't there a better way to do this?)
    system "$ESMTPD stop; $ESMTPD start";
}
=cut #========================= Courier SMTP =========================
+===END=

=cut #------------------------- Sendmail SMTP ------------------------
+-START-
# If you comment-out (or remove) the two surrounding =cut lines, we'll
# interface with Sendmail SMTP using DB_File.  See the quickstart guid
+e for
# the sendmail.cf changes you'll need to make.  If you find that Sendm
+ail
# isn't recognizing the changes to the DB file, set $signal_sendmail t
+o 1.

use Fcntl qw(:DEFAULT :flock :seek);
use DB_File;

$dbfile = '/etc/mail/popauth'; # DB hash to write

$mynet_func = \&mynet_sendmail;
$tie_func = \&tie_sendmail;
$sync_func = \&sync_sendmail;
$flock_func = \&flock_sendmail;
#$flock_func = \&fcntl_sendmail;

my $signal_sendmail = 0;
my($pid_file, $sendmail_pid);

if ($signal_sendmail) {
    $pid_file = '/var/run/sendmail.pid';
    open(PID, $pid_file) || die "Unable to open $pid_file: $!";
    $_ = <PID>;
    ($sendmail_pid) = /(\d+)/;
    close PID;
}

sub mynet_sendmail
{
    # You'll probably want to edit this (it specifies IP ranges to ign
+ore).
    '127.0.0.0/8 192.168.1.1/24';
}

my $dbh;

# We set the global %db to the opened database hash.  We also set $dbh
+ for
# our sync function, and DB_FH for our flock_DB function.
sub tie_sendmail
{
    $dbh = tie %db, 'DB_File', "$dbfile.db", O_CREAT|O_RDWR, 0666, $DB
+_HASH
    or die "$0: cannot dbopen $dbfile: $!\n";
    if ($flock) {
    my $fd = $dbh->fd;
    open(DB_FH,"+<&=$fd") or die "$0: cannot open $dbfile filehandle: 
+$!\n";
    }
}

sub sync_sendmail
{
    $dbh->sync and die "$0: sync $dbfile: $!\n";

    while ($signal_sendmail && !kill(1, $sendmail_pid)) {
    open(PID, $pid_file) || die "Unable to open $pid_file: $!";
    $_ = <PID>;
    my($new_pid) = /(\d+)/;
    close PID;
    if ($new_pid == $sendmail_pid) {
        die "Unable to signal sendmail to reread the database.\n";
    }
    $sendmail_pid = $new_pid;
    }
}

# Only 1 of these 2 locking functions is used (look for $flock_func ab
+ove).
sub flock_sendmail
{
    my($locking) = @_;
    flock(DB_FH, $locking ? LOCK_EX : LOCK_UN)
    or die "$0: flock_sendmail($locking) failed: $!\n";
}

sub fcntl_sendmail
{
    my($locking) = @_;
    my $lock = pack('s s l l i', $locking ? F_WRLCK : F_UNLCK, SEEK_SE
+T, 0, 0, 0);
    fcntl(DB_FH, F_SETLKW, $lock)
    or die "$0: fcntl_sendmail($locking) failed: $!\n";
}
=cut #------------------------- Sendmail SMTP ------------------------
+---END-

=cut #========================= CDB_File SMTP ========================
+=START=
# If you comment-out (or remove) the two surrounding =cut lines, we'll
+ use
# CDB_File instead od DB_File.

use CDB_File;

$tie_func = \&tie_CDB;
$sync_func = \&sync_CDB;
$flock = 0;

# We leave the global %db as an untied hash.
sub tie_CDB
{
}

sub sync_CDB
{
    my $cdb = CDB_File->new($dbfile, "$dbfile.tmp") or die;
    foreach (keys %db) {
    $cdb->insert($_, $dbvalue);
    }
    $cdb->finish;
}
=cut #========================= CDB_File SMTP ========================
+===END=

############################# Support Routines #######################
+#######

# This section takes care of defining a multi-line-match custom_match(
+)
# subroutine, but only if the user configured our 3 required patterns.

if (defined($PID_pat) && defined($IP_pat) && defined($OK_pat)) {
    eval <<'EOT';
# Some pop services don't put the IP on the line that lets us know tha
+t a
# user was properly authenticated.  For these programs, we scan the IP
+ off
# an earlier line and the check the validation by comparing the PID va
+lues.
# The regex $IP_pat is used to match the IP number and cache it.  The 
+regex
# $OK_pat is used to match a success message that follows from the sam
+e PID.
# If $FAIL_pat is not defined, there can be no intermediate log messag
+es
# with the same PID prior to the $OK_pat.  If $FAIL_pat is defined, we
+'ll
# continue trying to match the $OK_pat value on matching PID lines unt
+il we
# either match the $FAIL_pat (in which case the IP is ignored) or the 
+$OK_pat
# (in which case the IP is accepted).  Thus, $FAIL_pat can be either a
# failure log line or a this-PID-is-finished log line common to both s
+uccess
# and failure.  Finally, an optional $OUT_pat may be defined if you wa
+nt to
# track active connections -- when defined, any PID that matches the $
+OK_pat
# will be considered connected until we find a match for $OUT_pat.  It
+ is
# fine if lines that match $OUT_pat would also match $FAIL_pat (such a
+s a
# disconnect message) -- this won't confuse the code.
#
# Keep in mind that $IP_pat, $OK_pat, $OUT_pat, and $FAIL_pat will onl
+y be
# applied to lines that match the $PID_pat regex.

    my(%popIPs, %popConnected);

    $FAIL_pat = '.' if !defined $FAIL_pat;
    foreach ($PID_pat, $IP_pat, $OK_pat, $FAIL_pat, $OUT_pat) {
    s/\[LOGTIME\]/$logtime_pat/g if defined $_;
    }

    # The mail-log line to match is in $_.
    sub custom_match
    {
    if (/$PID_pat/o) {
        my($ts, $pid) = ($1, $2);
        if (/$IP_pat/o) {
        $popIPs{$pid} = $3;
        } else {
        my $ip = $popIPs{$pid};
        if (defined $ip) {
            if ($popConnected{$pid}) {
            if (/$OUT_pat/o) {
                delete $popConnected{$pid};
                delete $popIPs{$pid};
                return ($ts, $ip, -1);
            }
            } else {
            if (/$OK_pat/o) {
                if (defined $OUT_pat) {
                $popConnected{$pid} = 1;
                return ($ts, $ip, 1);
                }
                delete $popIPs{$pid};
                return ($ts, $ip, 0);
            }
            if (/$FAIL_pat/o) {
                delete $popIPs{$pid};
            }
            }
        }
        }
    }
    ( );
    }
EOT
}

1; ## THIS LINE MUST REMAIN LAST IN THE FILE! ##
[download]