#!/usr/bin/perl -w

# watch-maillog.pl
#
# (C) Copyright Craig Sanders <cas@taz.net.au> 2004
# 
# this program is licensed under the terms of the GNU General Public License.
#
# the latest version can always be found at http://taz.net.au/postfix/scripts
#
# $Id: watch-maillog.pl,v 1.9 2004/12/15 22:34:47 root Exp $
#
# HISTORY:
#
# v0.1  - initial version
#
# v0.2  - added more elsif clauses, moved iptables stuff to a subroutine,
#         added a whitelist to avoid blocking known good IP addresses.
# 
# v0.3  - logging via Unix::Syslog module.
#
# v0.4  - added support for monitoring TLS errors and updating tls_per_site
#         map.  this script is now a framework that can do more than just
#         manage iptables rules :)
#
# v0.5  - tidied up some stuff in add_iptables_rule, allowed option of
#         blocking entire class C if seen > 5 times.
#
# v1.0  - fixed a typo, now -> $now.
#
# v1.1  - added gluck.debian.org to whitelist.
#
# v1.2  - added very primitive pop-before-smtp support.  only works for 
#         dovecot pop/imapd at the moment.
#
# v1.3  - added signal trapping
#         SIGTERM to clean up when script is killed
#         SIGUSR1 to clear all iptables rules
#         SIGUSR2 to clear all iptables rules and wipe %SEEN
#
# v1.4  - don't need to escape "."s in whitelist IPs anymore.
#
# v1.5  - fixed some typos, tidied up the code.  commented out signal handling
#         stuff until i get time to get it working.
#
# v1.6  - changed $IPTABLES_t to $IPTCHECK. LIFO stack was a dumb idea,
#         don't know what i was thinking - it stopped even short lived rules
#         being deleted when $IPTABLES_t[0] is far in the future.
#         ditto for pop-before-smtp and @PBS_t[0], changed that to $POPCHECK.
#
# v1.7  - minor cosmetic changes
#
# v1.8  - changed to use SPAMMERS table rather than INPUT.  
#         use --syn when adding iptables rules, to avoid hanging smtpd processes
#
# v1.9  - added cyrus regexp for pop-before-smtp (thanks to Eddy Beliveau <eddy.beliveau@hec.ca>).
#         changed -I (insert) to -A (append) for iptables rules.  now that the rules live
#         in their own table, it makes sense to append them.  that way, override rules
#         can be -I inserted at the top of the table.
#
# the SPAMMERS table should be set up like this (BEFORE this script is run):
#
# # create SPAMMERS table
# iptables -F SPAMMERS 2>/dev/null
# iptables -X SPAMMERS 2>/dev/null
# iptables -N SPAMMERS 2>/dev/null
#
# # send all INPUT & FORWARD packets to the SPAMMERS table
# iptables -I INPUT -j SPAMMERS
# iptables -I FORWARD -j SPAMMERS
#
# FORWARD rule needed only on gateway/router boxes, not normal hosts.
#
# you could optionally create a SPAMDROP table too, which logged the packet
# with a "SPAMMERS" prefix before dropping it....but that kind of defeats the
# purpose of this script which is to remove spammer noise from the logs.
# 
# TODO/IDEAS:
#  - more elsif clauses ?
#  - add optional $reason arg to add_iptables_rule subroutine, for logging.
#  - log client fqdn (if any) as well as client IP.
#  - use strict; 
#  - move whitelist to a config file
#  - package for debian with an /etc/init.d/ start/stop script
#  - getopt for command-line args to enable/disable features 
#    like tls or tls monitoring, and to specify filenames.
#  - fix signals and pbs deletion.

$|=1;

use File::Tail;
use Unix::Syslog qw(:macros);  # Syslog macros
use Unix::Syslog qw(:subs);    # Syslog functions
use BerkeleyDB;
use diagnostics;

# start syslogging
openlog 'watch-maillog.pl', LOG_PID | LOG_CONS | LOG_NDELAY, LOG_MAIL;
syslog LOG_INFO, 'watch-maillog.pl starting up';


# configuration variables

# File::Tail variables
$debug = 0;
$logfile = '/var/log/mail.log' ;

# can optionally specify number of lines to tail, or any negative number
# to read entire file. 
my $tail = shift || 0;

# whitelist: never block any of these IP addresses:
# NOTE: escaping "." characters as "\." is optional.
my @whitelist = qw(127. 203.167.167 203.12.136 192.25.206.10);
$wl_regexp = '^(' . join('|',@whitelist) . ')' ;
$wl_regexp =~ s/\\././g;
$wl_regexp =~ s/\./\\./g;

# tls_per_site config variables
$tlsfile = '/etc/postfix/tls_per_site' ;


# pop-before-smtp config variables
my ($pbsfile,$pbstype,$pbsmap);

$pbsfile='/etc/postfix/pop-before-smtp';

$pbstype = 'Hash';
$pbsmap = $pbsfile . '.db';
# btree untested, but It Should Work<tm>
#$pbstype = 'Btree';
#$pbsmap = $pbsfile . '.dbm';


# bookkeeping and other non-configuration variables

# iptables vars
my (%IPTABLES, %SEEN);
my $IPTCHECK = time;

# pop-before-smtp vars
my (%POP);
my $POPCHECK = time;




# open mail.log
my $logref=tie(*LOG,'File::Tail',(name=>$logfile,debug=>$debug, tail=>$tail));

# set up signal trapping
#my $signal='';

#use sigtrap qw(die normal-signals);
##foreach $sig qw(INT TERM USR1 USR2) {
#foreach $sig qw(USR1 USR2) {
#	$SIG{$sig} = sub { $signal = $sig };
#} ;

END {
  untie $logref ;
  syslog LOG_INFO, 'watch-maillog.pl shutting down';
  closelog;
};


# main program loop
while (<LOG>) {
  my($ip,$site,$user);
  chomp;

  if (/too many errors after RCPT/io) {
    ($ip = $_) =~ s/.*\[([0-9.]*)\].*/$1/;
    next if $IPTABLES{$ip};
    # block for one hour
    add_iptables_rule($ip,3600);

  } elsif (/This address never existed/io) {
    ($ip = $_) =~ s/.*\[([^]]+)\].*/$1/;
    next if $IPTABLES{$ip};
    # block for 1 minute
    add_iptables_rule($ip,60);

  } elsif (/User unknown in local recipient table/io) {
    ($ip = $_) =~ s/.*\[([^]]+)\].*/$1/;
    next if $IPTABLES{$ip};
    # block for 1 minute
    add_iptables_rule($ip,60);

  } elsif (/Relay access denied|dynamic IP trespass spam rejected/io) {
    ($ip = $_) =~ s/.*\[([^]]+)\].*/$1/;
    next if $IPTABLES{$ip};
    # block for 10 minutes
    add_iptables_rule($ip,600);

  } elsif (/Helo command rejected|Sender address rejected/io) {
    ($ip = $_) =~ s/.*\[([^]]+)\].*/$1/;
    next if $IPTABLES{$ip};
    # block for 10 minutes
    add_iptables_rule($ip,600);

  } elsif (/blocked using .*\.blackholes\.us/io) {
    ($ip = $_) =~ s/.*\[([^]]+)\].*/$1/;
    next if $IPTABLES{$ip};
    # block for 10 minutes
    add_iptables_rule($ip,600);
  }

  # TLS error found, add site to tls_per_site map.
  elsif (/\(Could not start TLS/) {
    ($site = $_) =~ s/.*relay=(.*)\[.*/$1/ ;
    add_tls_per_site($site);
  }

  # POP/IMAP client logged in, add to pop-before-smtp map
  # note: regexp only works for dovecot.  rules for other pop/imap daemons
  # are welcome.
  # /(pop3|imap)-login: Login: USER [ip.ip.ip.ip]/
  elsif (/(pop3|imap)-login: Login:/) {
    ($ip = $_) =~ s/.*\[([^]]+)\].*/$1/i;
    ($user = $_) =~ s/.*Login: (\w+) .*/$1/i;
    add_pbs($ip,$user);
  }

  # cyrus regexp courtesy of Eddy Beliveau <eddy.beliveau@hec.ca>
  #
  # (pop3d|imapd)[pid]: login: [ip.ip.ip.ip] USER method  
  elsif (/(?:pop3d|imapd)\[\d+\]: login: \[([0-9.])\] (\w+) \w+/) {
    $ip = $1;
    $user = $2;
    add_pbs($ip,$user);
  } ;
  


  # now check for stuff to clean up.
  #check_for_signals() if ($signal);
  delete_stale_iptables_rules() ;
  delete_stale_pbs() ;

};

#sub check_for_signals {
#  	syslog LOG_NOTICE, 'received signal \'%s\'', $signal;
#	if    ($signal eq 'TERM') { exit 0 } 
#	elsif ($signal eq 'INT')  { exit 0 } 
#	elsif ($signal eq 'USR1') { delete_all_iptables_rules() }
#	elsif ($signal eq 'USR2') { delete_all_iptables_rules() ; clear_old_iptables_rules() }
#	$signal='';
#};

sub add_iptables_rule {
  my($ip,$dtime) = (@_);

  return if ($ip =~ m/$wl_regexp/o);

  my $now = time; 

  ## quick & dirty exp. backoff.  double time blocked each time an IP
  ## (or /24) is seen.    1x, 2x, 4x, 8x, 16x, ... .
  ##
  ## uncomment following two lines to increase time for the IP
  ## if it has been seen before.
  ##
  if (defined($SEEN{$ip})) { $dtime *= (2 ** $SEEN{$ip}) };
  $SEEN{$ip}++;

  ## or uncomment following 4 lines to increase time for the entire 
  ## /24 if it has been seen before.  you probably want to decrease 
  ## the base $dtime to 300 or 600 secs (5 or 10 minutes) for this case.
  ##
  #my $C = $ip ;
  #$C =~ s/\.\d+$//;
  #if (defined($SEEN{$C})) { $dtime *= (2 ** $SEEN{$C}) };
  #$SEEN{$C}++;
  ##
  ## optionally block entire class C rather than just IP if seen more than 5 times
  #if ($SEEN{$C} >= 5) {
  #  $ip = "$C.0/24" 
  #  # and optionally divide $dtime by 10
  #  #$dtime /= 10;
  #};

  # calculate when rule should be deleted
  my $t = $dtime + $now;

  # keep track of when to next check for iptables rules to delete  
  $IPTCHECK = $t if ($IPTCHECK > $t);

  # schedule rule for deletion at appropriate time
  $IPTABLES{$ip} = $t;

  system('/sbin/iptables','-A','SPAMMERS','-j','DROP','-s',$ip,'-p','TCP','--dport',25,'--syn');

  syslog LOG_NOTICE, 'blocked %s for %i seconds (IP seen %i times)', $ip,$dtime,$SEEN{$ip};
  #syslog LOG_NOTICE, 'blocked %s for %i seconds (/24 seen %i times)', $ip,$dtime,$SEEN{$C};
};

sub delete_stale_iptables_rules {
  my $now = time;
  my ($ip,$notice);

  # check if it's time to remove any iptables rules
  return unless ($now >= $IPTCHECK);
  $IPTCHECK = $now + 600;

  $notice='';
  # delete any rules whose time has expired
  foreach $ip (keys %IPTABLES) {
    if (($now >= $IPTABLES{$ip})) {
      system('/sbin/iptables','-D','SPAMMERS','-j','DROP','-s',$ip,'-p','TCP','--dport',25,'--syn');
      $notice .= " $ip";
      delete $IPTABLES{$ip};
    };
  };
  syslog(LOG_NOTICE, 'unblocked:%s', $notice) if ($notice);
};

#sub delete_all_iptables_rules {
#  # delete all iptables rules
#  my $notice = 'unblocked all: ';
#  foreach $ip (keys %IPTABLES) {
#    #system('/sbin/iptables','-D','SPAMMERS','-j','DROP','-s',$ip,'-p','TCP','--dport',25,'--syn');
#    $notice .= " $ip";
#  };
#  system('/sbin/iptables','-F','SPAMMERS');
#  
#  %IPTABLES=();
#  syslog LOG_NOTICE, $notice;
#};
#
#sub clear_old_iptables_rules {
#  # delete all record of IP addresses that have been seen 
#  %SEEN=();
#  syslog LOG_NOTICE, 'cleared seen list';
#};

sub add_tls_per_site {
  my ($site) = $_;

  if(open(TLSPERSITE, ">>$tlsfile")) {
    print TLSPERSITE "$site\tNONE\n";
    close(TLSPERSITE) ;
    syslog LOG_NOTICE, 'added %s to %s', $site,$tlsfile;
    system('/usr/sbin/postmap',$tlsfile);
  } else {
    syslog LOG_ERR, 'couldn\'t open %s for append: %s',$tlsfile,$! ;
  };
};


sub add_pbs {
  my ($ip,$user) = @_;
  my $now = time; 
  my $db;

  my $t = $now + 600;  # ten minutes

  # keep track of when to next check for pbs entries to delete  
  $POPCHECK = $t if ($POPCHECK > $t);

  if ($db = tie(%POP, "BerkeleyDB::$pbstype",
                   -Filename   => $pbsmap,
                   -Flags      => DB_CREATE)) {
    syslog LOG_NOTICE, 'adding %s to %s for %s (%i, %i)', $ip,$pbsmap,$user,$t,$POPCHECK;
    $POP{$ip} = $t;
    $db->db_sync();
  } else {
    syslog LOG_ERR, 'couldn\'t open database %s: %s',$pbsmap,"$! $BerkeleyDB::Error" ;
    return;
  } ;
  undef $db;
  untie(%POP);

};

sub delete_stale_pbs {
  my $now = time;
  my $db;

  # check if it's time to remove any pop-before-smtp entries
  return unless ($now >= $POPCHECK);
  $POPCHECK = $now + 600;

  if ($db = tie(%POP, "BerkeleyDB::$pbstype",
                   -Filename   => $pbsmap,
                   -Flags      => DB_CREATE)) {
    foreach my $ip (keys %POP) {
      if ($now >= $POP{$ip}) {
        syslog LOG_NOTICE, 'removing %s from %s (%i, %i)', $ip,$pbsmap, $now, $POP{$ip};
        delete($POP{$ip});
        $db->db_sync();
      } ;
    };
  } else {
    syslog LOG_ERR, 'couldn\'t open database %s: %s',$pbsmap,"$! $BerkeleyDB::Error";
    return;
  } ;
  undef $db;
  untie(%POP);
};