#!/usr/local/bin/perl5 # # poprelayd NG #2 - update /etc/mail/popip based on POP logins # # This code was written by Curt Sampson 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 $ # # Updated by J. Briggs, james@ActiveMessage.com on 2000 10 18: # # - added support for both UW imap-2000 Login and Authenticated log entries # - added UW imap-2000 Logout support # - code cleanup, more error handling # - safer signal handling # - moved alternative imap log parsers into program as comments # # Updated by J. Briggs, james@ActiveMessage.com on 2000 10 28: # # - added UW imap-2000 AutoLogout support # # Usage: # poprelayd -d # poprelayd -p # poprelayd -a # poprelayd -r # # 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. # use strict; use diagnostics; use vars qw / $opt_a $opt_d $opt_r $opt_p $opt_t /; my $logfile = "/var/log/maillog"; # POP3 daemon log. my $pidfile = "/var/run/poprelayd.pid"; # Where we put our PID. my $dbfile = "/etc/mail/popip.db"; # Sendmail map to update. my $dbtype = ""; # obsolete my $timeout_minutes = 15; # Minutes an entry lasts. my $log_wait_interval = 5; # Number of seconds between checks # of the log file. # # 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. #{ local $^W = 0; eval "sub O_EXLOCK { 0x20 };"; } # # Variables # my $pid; # Process ID. my %db; # Hash into database file. my $lffd; # $logfile file descriptor. my $lfino; # Inode of $logfile when we opened it. my $lfbuf; # Buffer for data from $lffd. my @addrs_add; # List of IP addresses to add. my @addrs_del; # List of IP addresses to delete. my $lasttimeout; # Last time we did a timeout. my $flag_signal; # Time to die from a signal. # # Subroutines # sub opendb_read { tie(%db, "DB_File", $dbfile, O_RDONLY, 0, $DB_HASH) || die "Can't open $dbfile for reading: $!"; } sub opendb_write { tie(%db, "DB_File", $dbfile, O_RDWR|O_EXLOCK, 0, $DB_HASH) || die "Can't open $dbfile for writing: $!"; } sub closedb { untie %db; } sub adddb { my ($addr) = @_; $db{$addr} = time; } sub removedb { my ($addr) = @_; 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]; my $key; foreach $key (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 $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"; } (undef, $lfino, undef) = 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. (undef, $ino, undef) = POSIX::stat($logfile); if ($ino != $lfino) { POSIX::close($lffd); undef($lffd); $lffd = POSIX::open($logfile, O_RDONLY|O_NONBLOCK, 0); if (!defined($lffd)) { die "Can't open $logfile: $!\n"; } (undef, $lfino, undef) = 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. # # What would be really nice is a way to extend the session based on activity, # instead of timing out the session blindly a fixed interval after login! sub scanaddr { my ($s) = @_; # untested qpopper 2.53 parser: # if ($s =~ /(popper).*?POP (login).*?(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/o) { # untested Cubic Circle POP3 daemon (cucipop) parser: # if ($s =~ /(cucipop)\[\d+\]:\s+(\w+)\s+(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/o) { # tested UW imap parser: if ($s =~ /i(pop2|pop3|map)d\[[0-9]+\]: (Authenticated|Login|Logout) user=.*?\[([^]]*)\]$/io) { if (lc($2) eq 'logout') { # could be Logout or Autologout return('',$3) } else { return($3,'') } } return ('',''); } # cleanup # # Clean up and exit; executed on receipt of a sighup. # sub cleanup { $flag_signal = 1; } # # Main Program # my $help_opts = "Usage: poprelayd [-p] [-a ] [-r ] [-d]\n"; my $countopts = 0; getopts('a:dpr:t:') || die $help_opts; # 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(); my $key; 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 and set $flag_signal for later cleanup since # Perl5 does not have safe signal handling $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) or die "Can't close file $pidfile: $!\n"; chmod(0644, $pidfile) or warn "Can't chmod file $pidfile: $!"; # Detach from terminal, etc. setpgrp(0, 0); close(STDIN); close(STDOUT); close(STDERR); chdir("/"); # Main loop. $lasttimeout = 0; my $line = ''; while (1) { if ($flag_signal) { unlink $pidfile or die "Can't unlink file $pidfile: $!\n"; exit 0; } # Build list of addresses of recent authentications. while ($line = getlogline()) { if (my ($add, $del) = scanaddr($line)) { push(@addrs_add, $add) if $add ne ''; push(@addrs_del, $del) if $del ne ''; } } # Add or delete this list from current set. opendb_write(); my $addr; while ($addr = pop @addrs_add) { adddb($addr); } while ($addr = pop @addrs_del) { removedb($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; } } die $help_opts if !$countopts;