#!/usr/bin/perl

#Settings for greylisting.
#
# For an explanation of what the purpose of this is, and maybe a hint as to
# what values to enter, "check http://projects.puremagic.com/greylisting/".
# I think they recommend something like this:
# $gdb_black = 1*60*60;
# $gdb_grey = 5*60*60;
# $gdb_white = 36*24*60*60;
# $gdb_subnet = 1;
# 
#
# If greylist is 1, greylisting will be used.
#
# Greylisting is done on a triplet of sending hosts IP, mail from: and
# rcpt to:.
#
# When a session with a new triplet arrives, all sessions with that
# triplet will be tempfailed for $gdb_black seconds.
# After $gdb_black seconds it will be white-listed for $gdb_grey
# seconds.
# If a session for the triplet arrives within the $gdb_grey white-listing
# period, it will then be white-listed for $gdb_white seconds.
# If a session for a triplet arrives within the $gdb_white white-listing
# period, it will be white listed for another $gdb_white seconds.
#
# When a mail gets a spam-score above $gdb_reset, the greylist status for it's
# triplet will be reset (wich means the next session with that triplet will be
# treaded as though it's a new triplet).
# If $gdb_reset_host is true, all triplets from the same host IP will be reset
# whenever a spam triggers the reset.
#
# If $gdb_subnet is true, only the first 3 octes of the IP-addresses will be
# used in the greylist.
# If $gdb_from_domain is true, only the domain part of the mail from: address
# will be used in the greylist.
# If $gdb_to_domain is true, only the domain part of the rcpt to: address
# will be used in the greylist.
# If $gdb_from_strip is true, some stuff in the user part of the mail from:
# address will be replaced in order to handle mailinglists and some other
# stuff better.
# If $gdb_to_strip is true, some stuff in the user part of the rcpt to:
# address will be replaced in order to handle use parameters and some other 
# stuff better.
#***********************************************************************
$minute = 60;
$hour = 60*$minute;
$day = 24*$hour;

$greylist = 1;
$gdb_black = 1*$minute;
$gdb_grey = 48*$hour;
$gdb_white = 30*$day;
$gdb_reset = 7;
$gdb_reset_host = 0;
$gdb_subnet = 1;
$gdb_from_domain = 0;
$gdb_from_strip = 1;
$gdb_to_domain = 0;
$gdb_to_strip = 1;
$gdb_log = 0;

use DBI;

$DATABASE = "greylist";

$greylist_dbh = DBI->connect("DBI:mysql:database=$DATABASE;host=localhost","greylist","<OBSCURED>",
        { RaiseError => 1, AutoCommit => 0 })
        or die $DBI::errstr;

$select_sql = qq{ SELECT reset, accepted, count
                FROM greylist_data WHERE ip=? AND sender=? AND recipient=? };
$select_sth = $greylist_dbh->prepare($select_sql);

$insert_sql = qq{ INSERT INTO greylist_data(id, ip, sender, recipient, created, modified, reset, accepted, count)
                VALUES (?,?,?,?,?,?,?,?,?) };
$insert_sth = $greylist_dbh->prepare($insert_sql);

$update_sql = qq{ UPDATE greylist_data
                SET modified = ?, reset=?, accepted=?, count=?
                WHERE ip=? AND sender=? AND recipient=? };
$update_sth = $greylist_dbh->prepare($update_sql);

$reset_sql = qq{ UPDATE greylist_data
                SET modified = ?, reset = 0, accepted = 0
                WHERE ip=? AND sender=? AND recipient=?};
$reset_sth = $greylist_dbh->prepare($reset_sql);

$resetip_sql = qq{ UPDATE greylist_data
                SET modified = ?, reset = 0, accepted = 0
                WHERE ip=? };
$resetip_sth = $greylist_dbh->prepare($resetip_sql);

###############################
#Greylist Subroutines  ########
###############################

#Strip strings
sub address_strip ($) {
        my($a) = @_;
        $a = "" if (!defined($a));
        $a =~ s/^[<\[]//;
        $a =~ s/[>\]]$//;
        return lc($a);
}

# return a time string...
sub time_string($) {
        my ($time) = @_;
        my $h = int($time / (60*60));
        $time = $time % (60*60);
        my $m = int($time / 60);
        my $s = $time % 60;
        my $r = "";
        $r.="$h hours, " if ($h);
        $r.="$m minutes and " if ($h || $m);
        $r.="$s seconds";
        return $r;
}


#Strip strings for use in the greylist.
sub greylist_strip ($) {
        my($a) = @_;
        $a =~ s/;/:/g;
        return $a;
}

sub greylist_strip_mail($$$) {
        my($a,$d,$s) = @_;
        $a = address_strip($a);
        my $au = $a;
        my $ad = $a;
        $ad =~ s/.*@([^@]*)$/$1/;
        $au =~ s/@[^@]*$//;
        if ($d) {
                $au = "*";
        } elsif ($s) {
                $au =~ s/(.+)\+.*$/$1/;
                my $aut;
                my $autt = $au;
                do {
                        $aut = $autt;
                        $autt =~ s/^(|.*[^a-z0-9])[a-f0-9]*\d[a-f0-9]*(|[^a-z0-9].*)$/$1#$2/;
                } until ($autt eq $aut);
                $au = $aut if ($aut =~ /[a-z0-9]/);
                #$au =~ s/[^-a-z0-9_.#]/?/g;
        }
        return greylist_strip($au."@".$ad);
}


sub greylist_strip_ip($) {
        my($a) = @_;
        $a =~ s/(.*)\.[0-9]+$/$1\.*/ if (defined($gdb_subnet) && $gdb_subnet);
        return greylist_strip(address_strip($a));
}

sub greylist_strip_triplet(@) {
        my(@p) = @_;
        my($i,$s,$r) = @p;
        my $sr;
        my $sn;
        $s = greylist_strip_mail($s,(defined($gdb_from_domain) && $gdb_from_domain),(defined($gdb_from_strip) && $gdb_from_strip)) if $s;
        $r = greylist_strip_mail($r,(defined($gdb_to_domain) && $gdb_to_domain),(defined($gdb_to_strip) && $gdb_to_strip)) if $r;
        $i = greylist_strip_ip($i);
        return ($i,$s,$r);
}

# Checks authentication
sub check_authenticated () {
        open(COMM, "<./COMMANDS") or return 0;
        while(<COMM>) {
                if (/^=auth_authen/) {
                        close(COMM);
                        return 1;
                }
        }
        close(COMM);
        return 0;
}

sub greylist_ip_whitelist($) {

        # checks if a given ip number or block is free from whitelisting
        # it checks only the part of the ip number that is sent, so if
        # you whitelist here 192.168.0, then that's all it will check
        # against
        my $ip = shift;
        my %greylist_whitelist = {};

        $greylist_whitelist{'127.0.0'} = 1;
        $greylist_whitelist{'192.168.100'} = 1;
        #$greylist_whitelist{'208.180.20.6'} = 1;
        $greylist_whitelist{'216.198.0.26'} = 1; # stic.net's badly behaving mail server

        # from http://cvs.puremagic.com/viewcvs/*checkout*/greylisting/schema/whitelist_ip.txt?rev=
        $greylist_whitelist{'12.5.136.141'} = 1;    # Southwest Airlines (unique sender, no retry)
        $greylist_whitelist{'12.5.136.142 '} = 1;   # Southwest Airlines
        $greylist_whitelist{'64.12.136'} = 1;       # AOL (common pool)
        $greylist_whitelist{'64.12.137'} = 1;       # AOL
        $greylist_whitelist{'64.12.138'} = 1;       # AOL
        $greylist_whitelist{'64.125.132.254'} = 1;  # collab.net (unique sender per attempt)
        $greylist_whitelist{'66.135.209'} = 1;      # Ebay (for time critical alerts)
        $greylist_whitelist{'66.135.197'} = 1;      # Ebay
        $greylist_whitelist{'66.218.66'} = 1;       # Yahoo Groups servers (common pool, no retry)
        $greylist_whitelist{'152.163.225'} = 1;     # AOL
        $greylist_whitelist{'195.238.2.105'} = 1;   # skynet.be (wierd retry pattern)
        $greylist_whitelist{'195.238.2.124'} = 1;   # skynet.be 
        $greylist_whitelist{'195.238.3.12'} = 1;    # skynet.be
        $greylist_whitelist{'195.238.3.13'} = 1;    # skynet.be
        $greylist_whitelist{'204.107.120.10'} = 1;  # Ameritrade (no retry)
        $greylist_whitelist{'205.188.156'} = 1;     # AOL
        $greylist_whitelist{'205.206.231'} = 1;     # SecurityFocus.com (unique sender per attempt)
        $greylist_whitelist{'207.115.63'} = 1;      # Prodigy - broken software that retries continually (no delay)
        $greylist_whitelist{'207.171.168'} = 1;     # Amazon.com
        $greylist_whitelist{'207.171.180'} = 1;     # Amazon.com
        $greylist_whitelist{'207.171.187'} = 1;     # Amazon.com
        $greylist_whitelist{'207.171.188'} = 1;     # Amazon.com
        $greylist_whitelist{'207.171.190'} = 1;     # Amazon.com
        $greylist_whitelist{'213.136.52.31'} = 1;   # Mysql.com (unique sender)
        $greylist_whitelist{'217.158.50.178'} = 1;  # AXKit mailing list (unique sender per attempt)

        if ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
                return 1 if ($greylist_whitelist{"$1.$2.$3.$4"});
                return 1 if ($greylist_whitelist{"$1.$2.$3"});
                return 1 if ($greylist_whitelist{"$1.$2"});
                return 1 if ($greylist_whitelist{"$1"});
        } 
        return 0;
}


#Checks if a triplet is in the grey-list.
# Returns seconds until the triplet will be accepted, or -1 for error.
sub greylist_check($$$) {
        my ($ip,$sender,$recipient) = greylist_strip_triplet(@_);
        my $result = -1;

        my $now = time();
        my $event = "";

        # Get data from DB
        my ($reset,$accepted,$count) = (0,0,0);
        $select_sth->execute($ip, $sender, $recipient);
        $select_sth->bind_columns( \$reset, \$accepted, \$count );
        if ($select_sth->fetch) {

                if ($now < $reset+$gdb_black) {
                        $result = ($reset+$gdb_black)-$now;
                        $event = 'black';
                } elsif (($now < $reset+$gdb_grey) || 
                          (($accepted > 0) && ($now < $accepted + $gdb_white))) {
                        $count++;
                        $update_sth->execute($now, $reset, $now, $count, $ip, $sender, $recipient);
                        $greylist_dbh->commit();

                        $result = 0;
                        $event = 'white';
                } else {
                        $update_sth->execute($now, $now, 0, $count, $ip, $sender, $recipient);
                        $greylist_dbh->commit();

                        $result = $gdb_black;
                        $event = 'old';
                }

        } else {
                # insert new row in database
                $insert_sth->execute(undef,$ip, $sender, $recipient, $now, $now, $now, 0, 0);
                $greylist_dbh->commit();

                $result = $gdb_black;
                $event = 'new';
        }
        md_syslog('info', "MDLOG,$MsgID,grey_$event,$result,$RelayAddr,$sender,$recipient,?");
        return $result;
}

#Resets record(s) in the grey list.
sub greylist_reset($$$) {
        my ($p_ip,$p_sender,$p_recipient) = greylist_strip_triplet(@_);

        my $now = time();
        if ($p_sender && $p_recipient) {

                # update db with new values
                $reset_sth->execute($now,$p_ip, $p_sender, $p_recipient);
                $greylist_dbh->commit();
                md_syslog('info', "greylist: reset; -; $p_ip; $p_sender; $p_recipient") if (defined($gdb_log) && $gdb_log);

        } else {
                $resetip_sth->execute($now,$p_ip);
                $greylist_dbh->commit();
                md_syslog('info', "greylist: resetip; -, $p_ip; $p_sender; $p_recipient") if (defined($gdb_log) && $gdb_log);
        }
}

# Do not remove this next line
1;