#!/usr/bin/perl
#
# $Id$
# 
# Simple mail server graylist
#
# When a mail server connects to us for the first time, record the time
# and return a temporary error message.
#
# Almost all legitimate mail servers will retry, but most zombie mail
# servers that send spam won't retry, so this should block a resonable
# amount of spam.
#
# Some other graylists do this on a host/sender/recipient triple, but
# whether the server retries or not is an attribute of only the host
# portion, and not the sender or recipient, so this is pretty much just
# delaying the inevitable.
#

use Sys::Syslog;
use POSIX;

# Number of seconds to wait before allowing a client host thru the graylist.
#
# A really small value here seems to work well, since most legitimate mail servers
# I've observed so far retry within five to ten minutes.
#
# Don't expose this number to the client host in error messages, since spammers 
# might use this and retry as soon as possible, thus defeating the purpose of the
# graylist!

my $delay = 300;

# Where to keep the graylist database
#
# Obviously the user who runs this script must have write access to this directory

my $database = "/var/lib/graylist/allow";

openlog("graylist", "pid");
# non-fatal

if (dbmopen(%ALLOW, "$database", 0600))
{
    while (<>)
    {
        chomp;

        if (/^client_address=(.*)$/)
        {
            my $addr = $1;
            my $now = time;

            if (defined $ALLOW{$addr})
            {
                if ($now >= $ALLOW{$addr})
                {
                    # This host has waited long enuff and has passed the graylist
                    syslog "mail|debug", "%s", "$addr has passed graylist";

                    # Keep the graylist fresh
                    #
                    # We will write another script to purge all entries old than a certain time from the database
                    # but we don't want to purge an entry that was recently used
                    $ALLOW{$addr} = $now;

                    # Host has passed the graylist, but this is not a whitelist,
                    # so return DUNNO to continue with the next Postfix test
                    print STDOUT "action=DUNNO\n\n";
                    exit 0;
                }
                else
                {
                    # Already seen this host, but it hasn't yet waited long enuff
                    my $time = strftime("%H:%M:%S", localtime($ALLOW{$addr}));
                    syslog "mail|debug", "%s %s %s %s", "$addr", "must wait until", "$time", "to send mail";

                    # Deliberately keep this message easy to read for a human
                    # but don't include the exact delay as a number in case a spammer tries parsing it
                    print STDOUT "action=421 4.7.1 Your mail server must wait before sending mail.  Try again in a few minutes.\n\n";
                    exit 0;
                }
            }
            else
            {
                # Host not seen before, make it wait $delay seconds before it can send mail
                $ALLOW{$addr} = $now + $delay;
                my $time = strftime("%H:%M:%S", localtime($ALLOW{$addr}));
                syslog "mail|debug", "%s %s %s %s", "$addr", "must wait until", "$time", "to send mail";

                # Deliberately keep this message easy to read for a human
                # but don't include the exact delay as a number in case a spammer tries parsing it
                print STDOUT "action=421 4.7.1 Your mail server is not known to this system.  Try again in a few minutes.\n\n";
                exit 0;
            }
        }

        if (/^$/)
        {
            # End of record, quit
            exit 0;
        }
    }
    # Catch all
    exit 0;
}
else
{
    # Log the error then allow the message
    # We don't want to reject mail if this script isn't working for some reason
    print "action=WARN Cannot open graylist database\n\n";
    exit 1;
}