#!/usr/local/bin/perl

#
## Anti Abuse v.991b2
## Copyright 2005-2010 Jeremy Kister http://jeremy.kister.net./
#
## Anti Abuse may be copied and distributed under the terms found in
## the Perl "Artistic License", found in the standard Perl distribution.
#
## Deter evil hosts from repetatively sending your server spam/viruses.
## works very well with:
##   qmail-1.03     + qmail-1.03.isp.patch
##   ucspi-tcp-0.88 + ucspi-tcp-0.88.isp.patch
##   simscan-1.[24] + stabilize.patch 
#
## only thing to watch out for is hosts that forward mail from mailboxes
## that they host to mailboxes you host -- spam goes to them, forwards
## to you, and they look like the abuser.
#

# To install:

# set up your database
#
#CREATE TABLE `abuse_rate` (
#  `ip` varchar(15) NOT NULL default '',
#  `ten_min` smallint(2) unsigned NOT NULL,
#  `one_hour` smallint(2) unsigned NOT NULL,
#  `one_day` smallint(2) unsigned NOT NULL,
#  `timestamp` int(4) unsigned NOT NULL,
#  `nextcheck` int(4) unsigned NOT NULL,
#  PRIMARY KEY  (`ip`),
#  KEY `ten_min` (`ten_min`),
#  KEY `one_hour` (`one_hour`),
#  KEY `one_day` (`one_day`),
#  KEY `timestamp` (`timestamp`),
#  KEY `nextcheck` (`nextcheck`)
#) TYPE=MyISAM;
#
#CREATE TABLE `abuse_events` (
#  `ip` varchar(15) NOT NULL,
#  `timestamp` int(4) unsigned NOT NULL,
#  `weight` tinyint(1) NOT NULL,
#  KEY `ip` (`ip`),
#  KEY `timestamp` (`timestamp`),
#  KEY `weight` (`weight`)
#) TYPE=MyISAM;

# decide if you're going to use rbldns, or /etc/tcp.smtp
# if tcp.smtp:
#  create your tcp.smtp.template:
#  (all lines above the last will be inserted before the abuse rules)
#  (the last line will be put last)
#
#  echo '127.:allow,RELAYCLIENT=""' > /etc/tcp.smtp.template
#  echo '192.168.0.:allow,RELAYCLIENT=""' >> /etc/tcp.smtp.template
#  echo ':allow' >> /etc/tcp.smtp.template

#  chmod ugo+x /usr/local/script/antiabuse.pl
#  mkdir -p /var/qmail/supervise/antiabuse/log
#  mkdir -p /var/log/antiabuse

# create a /var/qmail/supervise/antiabuse/run
# on ONE machine per database --- you can have
# all the machines you want sending data into
# the database, but only one relisting agent.
#
# #!/bin/sh
#
# exec /usr/local/script/antiabuse.pl --relister \
#  --verbose \ # optional, recommended
#  --tcprules_file="/etc/tcp.smtp" \ # optional
#  --rbldns_file="/etc/rbldns/root/data" \ # optional
#  --driver=mysql \
#  --dbserver=mysql.example.net \
#  --dbname=database_name \ # optional, depending on your setup
#  --dbun=database_useranme \
#  --dbpw=database_password 2>&1

# create a /var/qmail/supervise/antiabuse/log/run
#
# #!/bin/sh
# exec /usr/local/bin/setuidgid qmaill /usr/local/bin/multilog s2097152 n1 /var/log/antiabuse

# chmod ugo+x /var/qmail/supervise/antiabuse/run /var/qmail/supervise/antiabuse/log/run
# ln -s /var/qmail/supervise/antiabuse /service

# and modify your /service/qmail-smtp/log/run script:
#
# #!/bin/sh
# exec /usr/local/bin/setuidgid qmaill \
#  /usr/local/script/antiabuse.pl \
#   --verbose \ # optional, recommended
#   --trap=".+@example.com" \ # optional, invalid recipients matching this will be penalized more
#   --whitelist="172.24.12.0/22,10.0.0.0/24" \ # optional, local net recommended
#   --blockmsg='Blocked for abuse; See http://example.net/cgi-bin/abuse.pl?ip=' \ # optional
#   --driver=mysql --dbserver=mysql.example.net \
#   --dbname=database_name \ # optional
#   --dbun=database_username --dbpw=database_password -- \
#    /usr/local/bin/multilog t /var/log/qmail/smtpd

#  svc -du /service/qmail-smtpd/log

use strict;
use Getopt::Long;
use DBI;
use Net::CIDR::Lite;
use Sys::SigAction qw(set_sig_handler);

chdir('/');

my %opt;
GetOptions(\%opt,
           'relister',
           'honeypot',
           'blockmsg=s',
           'tcprules_file=s',
           'rbldns_file=s',
           'driver=s',
           'dbserver=s',
           'dbname=s',
           'dbun=s',
           'dbpw=s',
           'trap=s',
           'verbose',
           'whitelist=s') || die "GetOptions Error: $!\n";

for my $arg (qw/dbun dbpw dbserver/){
    if($opt{$arg}){
        for my $x (qw/dbun dbpw dbserver/){
	    die "specify --${arg}\n" unless($opt{$arg});
        }
        last;
    }
}

die "specify --driver\n" unless($opt{driver});


my $dsn = "DBI:$opt{driver}:";
if($opt{dbserver}){
    $dsn .= ($opt{driver} eq 'Sybase') ? 'server=' : 'host=';
    $dsn .= $opt{dbserver};
}
if($opt{dbname}){
    if($opt{driver} eq 'SQLite'){
        $dsn .= 'dbname=';
    }else{
        $dsn .= ';database=';
    }
    $dsn .= $opt{dbname};
}

verbose( "DSN: $dsn" );
my $dbh = DBI->connect($dsn, $opt{dbun}, $opt{dbpw}, {RaiseError => 1});
my $last_connect = time();
if($dbh){
	verbose( "antiabuse: connected to database" );
}else{
	verbose( "antiabuse: connect to database failed: $DBI::errstr" );
}

my %seconds = ('ten_min' => 600, 'one_hour' => 3600, 'one_day' => 86400);
my %threshold = ('ten_min' => 34, 'one_hour' => 72, 'one_day' => 150);

if($opt{relister}){
	# the relisting agent watches the database and rebuilds the data file

	if($opt{honeypot}){
		warn "cannot specify both honeypot and relister\n";
		sleep 10;
		die;
	}

	unless($opt{blockmsg}){
		$opt{blockmsg} = 'Blocked for abuse - IP address: ';
	}

	if($opt{tcprules_file} && $opt{rbldns_file}){
		warn "cannot specify both tcprules_file and rbldns_file\n";
		sleep 10;
		die;
	}
	unless($opt{tcprules_file} || $opt{rbldns_file}){
		warn "must specify either tcprules_file or rbldns_file\n";
		sleep 10;
		die;
	}
	my $rules_file = ($opt{tcprules_file}) ? $opt{tcprules_file} : $opt{rbldns_file};
	my $rbldir;
	if($opt{rbldns_file}){
		if($opt{rbldns_file} =~ /^(.+)\/data$/){
			$rbldir = $1;
		}else{
			warn "rbldns_file must end in /data - or rbldns-conf won't run\n";
			sleep 10;
			die;
		}
	}

	until(-w $rules_file){
		warn "cannot write to $rules_file - retry in 10 seconds\n";
		sleep 10;
	}

	my %memory;
	my $i = 0;
	my $lastrun = 0;
	while(dbping($dbh)){
		my $relist;
		# every now and then clean up the database
		if($i == 0 || $i == 59){
			# delete old events

			my $start = time();

			my $t = ($start - 600);
			my $h = ($start - 3600);
			my $d = ($start - 86400);

			my $sql = 'DELETE FROM abuse_events WHERE timestamp < ' . $dbh->quote($d);
			verbose( "sql: $sql" );
			my $sth = $dbh->prepare($sql);
			$sth->execute;

			#recalculate abuse_rates needing it
			$sql = 'SELECT ip,ten_min,one_hour,one_day FROM abuse_rate WHERE nextcheck <= ' . $start .
			       ' ORDER by ip';
			verbose( "sql: $sql" );
			$sth = $dbh->prepare($sql);
			$sth->execute;
			while(my $row=$sth->fetchrow_arrayref){
				my $ip = $row->[0];
				my %old = ('ten_min' => $row->[1],
				           'one_hour' => $row->[2],
				           'one_day' => $row->[3]);
				
				my %sum = (ten_min => 0, one_hour => 0, one_day => 0);
				my $sqla = 'SELECT timestamp,weight FROM abuse_events WHERE ip = ' . $dbh->quote($ip);
				$sqla .= ' ORDER BY timestamp DESC'; # for nextcheck prediction
				verbose( "sqla: $sqla" );
				my $stha = $dbh->prepare($sqla);
				$stha->execute;
				my %data;
				while(my $rowb=$stha->fetchrow_arrayref){
					$data{$rowb->[0]} += $rowb->[1];
					if($rowb->[0] >= $t){
						$sum{ten_min} += $rowb->[1];
						$sum{one_hour} += $rowb->[1];
						$sum{one_day} += $rowb->[1];
					}elsif($rowb->[0] >= $h){
						$sum{one_hour} += $rowb->[1];
						$sum{one_day} += $rowb->[1];
					}elsif($rowb->[0] >= $d){
						$sum{one_day} += $rowb->[1];
					}
				}


				my $sqlb = 'UPDATE abuse_rate SET';

				my ($update,$keeprow,$nextcheck);
				foreach my $field (qw/ten_min one_hour one_day/){
					if($sum{$field} >= $threshold{$field}){
						$keeprow = 1;
						$update = 1 if($sum{$field} != $old{$field});

						
						unless($nextcheck){
							my $total;
							foreach my $timestamp (reverse sort keys %data){
								$total += $data{$timestamp};
								foreach my $field (qw/one_day one_hour ten_min/){
									if($total >= $threshold{$field}){
										$nextcheck = ($timestamp + $seconds{$field});
										last;
									}
								}
								last if($nextcheck);
							}
						}
					}
					$sqlb .= " $field = " . $dbh->quote($sum{$field}) . ',';
				}
				if($keeprow && $update){
					$sqlb .= ' nextcheck = ' . $nextcheck . ' WHERE ip = ' . $dbh->quote($ip); # preceding comma above
				}elsif($keeprow){
					undef $sqlb;
				}else{
					$sqlb = 'DELETE FROM abuse_rate WHERE ip = ' . $dbh->quote($ip);
					verbose( "deleting $ip [$sum{ten_min}/$sum{one_hour}/$sum{one_day}]" );
					delete $memory{$ip};
					$relist=1;
				}
				if($sqlb){
					verbose( "sqlb: $sqlb" );
					my $sthb = $dbh->prepare($sqlb);
					$sthb->execute;
				}
			}

			# make sure everything we have in memory is in abuse_rate
			verbose( "tainting %memory..." );
			$sql = 'SELECT ip FROM abuse_rate';
			$sth = $dbh->prepare($sql);
			$sth->execute;
			my %current;
			while(my $row=$sth->fetchrow_arrayref){
				$current{$row->[0]} = 1;
			}
			foreach my $key (keys %memory){
				unless(exists($current{$key})){
					verbose( "deleting memory{$key} as per current" );
					delete $memory{$key};
				}
			}
			
			my $diff = (time() - $start);
			verbose( "REPROCESSED DATABASE in $diff seconds." );

			$i=1;
		}

		# find all new abusers
		my $delta = ($lastrun - 10);
		$lastrun = time();
		my $sql = 'SELECT ip FROM abuse_rate WHERE timestamp > ' . $dbh->quote($delta);
		verbose( "[$i] sql: $sql" );
		my $sth = $dbh->prepare($sql);
		$sth->execute;
		while(my $row=$sth->fetchrow_arrayref){
			next if($row->[0] == 0); ## bug??
			unless(exists($memory{$row->[0]})){
				$relist=1;
				$memory{$row->[0]} = time();
				verbose( "adding $row->[0]" );
			}
		}
   
		if($relist){
			my $num_hosts = (keys %memory);
			verbose( "rebuilding data file ($num_hosts hosts)" );

			if($opt{tcprules_file}){
				my @data;
				open(TEMPLATE, "$opt{tcprules_file}.template") || die "cannot open $opt{tcprules_file}.template: $!\n";
				open(DATA, ">$opt{tcprules_file}") || die "cannot open $opt{tcprules_file} for writing: $!\n";
				while(<TEMPLATE>){
					push @data, $_;
				}
				close TEMPLATE;
				my $lastline = pop(@data);
				foreach (@data){
					print DATA;
				}
				foreach my $ip (keys %memory){
					my $string = $ip . ':allow,MAXCONNIP="1",MAXCONNC="2",RBLSMTPD="' . $opt{blockmsg} . $ip . '"' . "\n";
					print DATA $string;
					push @data, $string;
				}
		
				print DATA $lastline; # remember below
				close DATA;
			
				open(TCPRULES, "| /usr/local/bin/tcprules $opt{tcprules_file}.cdb $opt{tcprules_file}.tmp 2>&1")
				  || die "cannot fork tcprules: $!\n";
				foreach (@data){
					print TCPRULES;
				}
				print TCPRULES $lastline; # remember above
				close TCPRULES;
			}else{
				open(DATA, ">$opt{rbldns_file}") || die "cannot open $opt{rbldns_file}: $!\n";
				foreach my $ip (keys %memory){
					print DATA "$ip\n";
				}
				print DATA ':127.0.0.2:' . $opt{blockmsg} . '$' . "\n";
				close DATA;
				if(chdir($rbldir)){
					system('/usr/local/bin/rbldns-data');
					chdir('/');
				}else{
					warn "could not chdir $rbldir: $!\n";
				}
			}
		}
		sleep 10;
		$i++;
	}
	verbose( "lost connection to db server!!" );
	sleep 30;
	die "exiting to reconnect to database\n";
}

$|=1;
my $command = join ' ', @ARGV;
open(LOG, "| $command") || die "could not fork $command: $!\n";
my $oldfh = select LOG;
$|=1;
select $oldfh;

if($opt{honeypot}){
	verbose( "HoneyPot mode ON!" );
}

if($opt{whitelist}){
	$opt{whitelist} .= ',127.0.0.0/8' unless($opt{whitelist} =~ /127\.0\.0\.0\/8/);
}else{
	$opt{whitelist} = '127.0.0.0/8';
}
verbose( "whitelist set: $opt{whitelist}" );

unless(-x $ARGV[0]){
	verbose( "cannot execute $ARGV[0]: $!" );
	sleep 2;
	exit 1;
}

my $cidr = Net::CIDR::Lite->new;
foreach my $network (split /,/, $opt{whitelist}){
	verbose( "will not blacklist $network" );
	$cidr->add($network);
}

my ($run,%memory,%trap);
while(<STDIN>){
    print LOG;
    
    $run++;
    if($run == 5000){
        verbose( "cleaning up %memory..." );
        my $time = time();
        for my $ip (keys %memory){
            for my $rcpt (keys %{$memory{$ip}}){
                for my $sender (keys %{$memory{$ip}{$rcpt}}){
                    for my $key (qw/time last/){
                        my $event = $memory{$ip}{$rcpt}{$sender}{$key};
                        my $age = ( $time - $event );
                        if( $age > 60 ){
                            verbose( "removing \$memory{$ip}{$rcpt}{$sender}{$key} (age: $age)" );
                            delete $memory{$ip}{$rcpt}{$sender}{$key};
                        }
                    }
                }
            }
        }
        verbose( "cleaning up %trap..." );
        for my $ip (keys %trap){
            my $event = $trap{$ip};
        
            if($event > ($time - 86400) ){
                verbose( "removing \$trap{$ip}" );
                delete $trap{$ip};
            }
        }
        $run = 1;
    }
	
	eval {
		my $h = set_sig_handler('ALRM', sub { die "TIMEOUT!"; } );
		alarm(3);

		my ($ip,$weight);
		if($opt{honeypot}){
			if(/tcpserver:\s+.+\s+:(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}):/ && $opt{honeypot}){
				$ip = $1;
				$weight = 200; # enough to block for the day by default
			}
		}else{
			if(/qmail-smtpd:\s(.+)\sat\s(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/){
				my $msg = $1;
                $ip = $2;
				
				if($msg eq 'Too many errors'){
					$weight = 30;
				}elsif($msg =~ /No gateway for/){
					$weight = 40;
                }elsif($msg =~ / <([^>]+)> from:? <([^>]+)>/){
                    # Invalid Recipient, SPF Failure, No gateway for
                    my ($rcpt,$from) = (lc($1),lc($2));

                    my $time = time();
                    if( $trap{$ip} > ($time - 86400) ){
                        verbose( "$ip already trapped." );
                        $weight = 10;
                    }elsif($rcpt =~ /$opt{trap}/){
                        verbose( "$ip tripped the trap on $rcpt" );
                        $weight = 200;
                        $trap{$ip} = $time;
                    }else{
                        for my $sender (keys %{$memory{$ip}{$rcpt}}){
                            unless($sender eq $from){
                                # same ipaddr sending message, same invalid rcpt, different sender.
                        
                                if( $time - $memory{$ip}{$rcpt}{$sender}{time} <= 60 ){
                                    if($time - $memory{$ip}{$rcpt}{$sender}{last} <= 60){
                                        verbose( "already penalized attack from $ip for this minute" );
                                    }else{
                                        # last time this guy tried this was < 60 sec ago.  bastard.
                                        verbose( "dictionary senders detected from $ip" );
                                        $weight = 40;
                                        $memory{$ip}{$rcpt}{$from}{last} = $time;
                                    }
                                }
                            }
                            last;
                        }
                        $weight ||= 10;
                        $memory{$ip}{$rcpt}{$from}{time} = $time;
                    }
				}else{
					$weight = 10;
				}
			}elsif(/simscan:[^:]+:[^:]+\s\((\d+\.\d{2})\/\d+\.\d{2}\):[^:]+:[^:]+:(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}):/){
				my $score = $1;
				$ip = $2;
				if($score > 15){
					$weight = 40;
				}elsif($score > 10){
					$weight = 20;
				}elsif($score < 5){
					$weight = '-4';
				}else{
					# we treat 5-10 as almost neutral (penalize just a bit)
					$weight = 2;
				}
			}elsif(/rblsmtpd:\s(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/){
				$ip = $1;
				$weight = 2;
			}
		}

		if($ip){
			if($cidr->find($ip)){
				verbose( "ignoring whitelisted ip address: $ip" );
			}else{
				my $time = time();
		
				my $sql = 'INSERT INTO abuse_events (ip,timestamp,weight) VALUES (' .
				          $dbh->quote($ip) . ",${time},${weight})";
				my $sth = $dbh->prepare($sql);
				$sth->execute;
				
				$sql = 'SELECT COUNT(*) FROM abuse_rate WHERE ip = ' . $dbh->quote($ip);
				$sth = $dbh->prepare($sql);
				$sth->execute;
				my $row = $sth->fetchrow_arrayref;
				unless($row->[0]){ # otherwise just let the relister deal with it
					my $t = (time() - 600);
					my $h = (time() - 3600);
					my $d = (time() - 86400);
	
					my $sql = 'SELECT timestamp,weight FROM abuse_events WHERE ip = ' . $dbh->quote($ip) .
					          ' ORDER BY timestamp DESC';
					my $sth = $dbh->prepare($sql);
					$sth->execute;
					my (%sum,%data);
					while(my $row = $sth->fetchrow_arrayref){
						$data{$row->[0]} += $row->[1];
						if($row->[0] >= $t){
							$sum{ten_min} += $row->[1];
							$sum{one_hour} += $row->[1];
							$sum{one_day} += $row->[1];
						}elsif($row->[0] >= $h){
							$sum{one_hour} += $row->[1];
							$sum{one_day} += $row->[1];
						}elsif($row->[0] >= $d){
							$sum{one_day} += $row->[1];
						}
					}
	
					my ($dorate,$total);
					foreach my $timestamp (reverse sort keys %data){
						$total += $data{$timestamp};
						foreach my $field (qw/one_day one_hour ten_min/){
							if($total >= $threshold{$field}){
								$dorate = ($timestamp + $seconds{$field});
								last;
							}
						}
						last if($dorate);
					}
					if($dorate){
						verbose( "threshold exceeded; blocking $ip" );
	
						my	$sql = 'INSERT INTO abuse_rate VALUES (' . $dbh->quote($ip) . ',';
						foreach my $field (qw/ten_min one_hour one_day/){
							$sql .= $dbh->quote($sum{$field}) . ',';
						}
						$sql .= time() . ',' . $dorate . ')'; # preceding comma from above loop
						my $sth = $dbh->prepare($sql);
						$sth->execute;
					}
				}
			}
		}
	}; # end eval (in case dbserver dies)
	alarm(0);

	if($@){
		# we errored
		verbose( "error procesing data: $@!" );
		unless(dbping($dbh)){
			#reconnect to db if last time we tried was more than 30 seconds ago
			my $now = time();
			if(($now - $last_connect) > 30){
				eval {
					my $h = set_sig_handler('ALRM', sub { die "TIMEOUT!"; } );
					alarm(3);
					if($dbh = DBI->connect($dsn, $opt{dbun}, $opt{dbpw}, {RaiseError => 1})){
						verbose( "reconnected to database" );
					}else{
						verbose( "reconnect to database failed: $DBI::errstr" );
					}
				};
				alarm(0);
				$last_connect = time();
			}
		}
	}
}

sub verbose {
    my $msg = join(' ', @_) . "\n";

    if($opt{verbose}){
        if($opt{relister}){
            warn $msg;
        }else{
            print LOG "antiabuse[log]: $msg";
        }
    }
}

sub dbping {
	my $test_dbh = shift;
	my $xcode = 0;
	eval {
		my $h = set_sig_handler('ALRM', sub { die "TIMEOUT!"; } );
		alarm(1);

		if($test_dbh){
			if(my $sth = $test_dbh->prepare('SELECT 1')){
				if(defined(my $rc = $sth->execute)){
					$sth->finish;
					$xcode=1;
				}
			}
		}
	};
	alarm(0);
	return $xcode;
}