#!/usr/bin/perl
# mailmgr (C) 2003, Julian Haight, All Rights reserved under GPL license:
# http://www.gnu.org/licenses/gpl.txt

# This is a script which tails sendmail log files and dynamically blocks
# port-25 connections from hosts which meet certain criteria, using
# command-line kernel-level firewall configuration tools provided by
# underlying operating system (iptables)

use strict;
use Net::hostent;
use Socket;

my($LOG) = '/var/log/mail_log';

# allow 20 deliveries per hour
my($MAXCONN) = 20; my($BLOCKSECS) = (60*60);
# regex for whitelisted IPs - never blacklist (FE, 255.255.255/24)
my($LOCALNET) = '^(?:127\.0\.0\.1|255\.255\.255)';
# your kernel-firewall tweaker, see "iptables" func to redefine params used
my($IPTABLES) = '/usr/sbin/iptables';
my($ADDRULE) = '-I'; # cmdline for insert rule
my($DELRULE) = '-D'; # cmdline for delete rule
# Regex of additional reasons to get firewalled
# my($REASONS) = '(unexpected close on connection|did not issue MAIL|lost input channel|timeout waiting for input|I\/O error on connection|error on output channel sending)';
my($REASONS) = 0; # zero means don't blacklist for reasons above
my($MEMORYSEC) = (60*5); # 5 minute buffer
my(%buffer, %stats);
my($OCT) = '(?:25[012345]|2[0-4]\d|1?\d\d?)';
my($IP) = $OCT . '\.' . $OCT . '\.' . $OCT . '\.' . $OCT;

taillog();

sub taillog {
    my($offset, $name, $val, $line, $params, $ip, $ctrladdr, $qid, $conn,
       $reason);
    $offset = (-s $LOG); # Don't start at begining, go to end
#    $offset=0;
    while (1==1) {
	sleep(1);
	if ((-s $LOG) < $offset) {
	    print "Log shrunk, resetting..\n";
	    $offset = 0;
	}
	open(TAIL, $LOG) || print STDERR "Error opening $LOG: $!\n";

	# this dosn't work for some reason??
	if (seek(TAIL, $offset, 0)) {
	    # found offset, log not rotated
	} else {
	    # log reset, follow
	    $offset=0; 
	    seek(TAIL, $offset, 0);
	}
	while ($line = <TAIL>) {
	    chop($line);
	    if (($REASONS) && ($line =~ m/$REASONS/)) {
		$reason = $1;
		if ($line =~ m/\[($IP)\]/) {
		    $ip = $1;
		    print "Because of $reason, ";
		    blockIp($ip);
		} elsif ($line =~ m/from ([a-zA-Z0-9\.\-]+)/) {
		    $ip = $1; 
		    print "host: $ip ";
		    $ip = getip($ip);
		    if ($ip) {
			print "Because of $reason, ";
			blockIp($ip);
		    } else {
			print "Failed to find IP: $line\n";
		    }
		} else {
		    print "Should have blocked?: $line\n";
		}
		next;
	    }
	    if ($line =~ m/(|mailer\=\*file\*|DSN: Service unavailable|return to sender|premature EOM|mailer\=cyrus)/) {
#		print "Ignore $1\n";
		next;
	    }
	    if ($line =~ m/
		(....\d+\s[\d:]+)         # date
		\s\S+\s                   # hostname
		sendmail\[(\d+)\]\:\s     # pid
		([a-zA-Z0-9]+)\:\s        # qid
		/x) {
		$qid = $3;
		$buffer{$qid}->{'date'} = $1;
		$buffer{$qid}->{'pid'} = $2;
		$buffer{$qid}->{'update'} = time();
		$params = $';
		while ($params =~ m/
		       ([a-z]+)\=([^\,]+)(?:\,\s)?  # name value pairs
		       /xg) {
		    if ($buffer{$qid}->{$1}) {
			$buffer{$qid}->{"next-$1"} = $2;
		    } else {
			$buffer{$qid}->{$1} = $2;
		    }
		}
		if (!$buffer{$qid}->{'relay'}) {
		    print "No relay in line: $line\n";
		}
		if ($ip = $buffer{$qid}->{'relay'}) {
		    if ($ip =~ m/\[([\d\.]+)\]/) {
			$ip = $1;
		    } else {
			print "Cannot match ip: $ip\n";
		    }
		    if ($ctrladdr = ($buffer{$qid}->{'to'})) {
			$stats{$ip}->{'count'}++;
			if (!$stats{$ip}->{'first'}) {
			    $stats{$ip}->{'first'} = time();
			}
			if ((!$stats{$ip}->{'blocked'}) &&
			    ($stats{$ip}->{'count'} > $MAXCONN)) {
			    blockIp($ip);
			}
			$stats{$ip}->{'conn'}--;
			delete($buffer{$qid}); # remove after we get both parts
			if (($stats{$ip}->{'blocked'}) &&
			    ($stats{$ip}->{'count'} <= $MAXCONN) &&
			    ($stats{$ip}->{'conn'} < 3)) {
			    print "Re-allow $ip\n";
			    unblockIp($ip);
			}
		    } else {
			$stats{$ip}->{'conn'}++; 
			if ((!$stats{$ip}->{'blocked'}) &&
			    ($stats{$ip}->{'conn'} > 5)) {
			    print "Exceeded connection limit: $ip\n";
			    blockIp($ip);
			}
		    }
#		    print "ip:$ip conn: $stats{$ip}->{'conn'}\n";
		}
	    }
	}
	groom();
	$offset=tell(TAIL);
	close(TAIL);
    }
}

sub groom {
    my($ip, $name);
    foreach $ip (keys(%stats)) {
	if (($stats{$ip}->{'blocked'}) &&
	    ($stats{$ip}->{'blockdte'} < (time()-$BLOCKSECS))) {
	    unblockIp($ip);
	    delete ($stats{$ip});
	}
	# forget them if they haven't been blocked and it's been a long time
	if ((!$stats{$ip}->{'blocked'}) &&
	    ($stats{$ip}->{'first'} < (time()-$BLOCKSECS))) {
	    delete ($stats{$ip});
	}
    }
    # using $ip for qid
    foreach $ip (keys(%buffer)) {
	if ($buffer{$ip}->{'update'} < (time()-$MEMORYSEC)) {
	    delete($buffer{$ip});
	}
    }
}

sub unblockIp {
    my($ip) = @_;
    iptables($DELRULE, $ip);
    print "unblock $ip\n";
    $stats{$ip}->{'blocked'} = 0;
}

sub blockIp {
    my($ip) = @_;
    if ($ip =~ m/$LOCALNET/) {
	return;
    }
    if ($stats{$ip}->{'blocked'}) {
	print STDERR "already blocked: $ip\n";
	return;
    }

    $stats{$ip}->{'blockdte'} = time();
    $stats{$ip}->{'blocked'} = 1;
    iptables($ADDRULE, $ip);
    print "block $ip\n";
}

sub iptables {
    my($action, $ip) = @_;
    my(@args) = ($IPTABLES,
		 $action,
		 'INPUT', '--protocol', 'tcp', '--source',
		 $ip,
		 '--syn', '-j', 'DROP');
    system(@args);
}

sub getip {
    my($name) = @_;
    my($h);
    unless ($h = gethost($name)) {
	print "Cannot get ip for $name\n";
	return '';
    }
    if (@{$h->addr_list} > 1) {
	print "Multiple ips for $name\n";
	return '';
    }
    return inet_ntoa($h->addr);
}