#!/usr/local/bin/perl5 -w

use DBI;
use Sys::Syslog qw(:DEFAULT setlogsock);
use Data::Dumper;
use strict "vars";
use vars qw($dbh $sth_lookup $sth_insert $sth_update $sth_update2);  # MySQL handles
use vars qw(%attr);                                     # Current request
use vars qw($verbose);

my ($greylist_delay) = 300;
my ($syslog_socktype,$syslog_facility,$syslog_options,$syslog_priority) = ("unix","mail","pid","info");
my (@DBIPARMS) = ("DBI:mysql:greylistdb:localhost",'myuser','mypassword');


  ######################################################
  # Load DBI parameters from outside this script       #
  # Primarilly this is so thatI can replace @DBIPARMS  #
  ######################################################
if (-e "/etc/postfix/extras/greylist.pl.dbi") {
 # My DBI parameters are stored outside the script 
 my $buffer;
 open(CONF,"</etc/postfix/extras/greylist.pl.dbi");
 read CONF,$buffer,99999;
 close CONF;
 eval $buffer;
}


=head1 Create the SQL table with this
 mysqladmin create greylistdb
 mysql greylistdb

 DROP TABLE entities;

 CREATE TABLE entities (
  id int(11) NOT NULL auto_increment,
  client_address   varchar(32) NOT NULL,
  sender varchar(128) NOT NULL, 
  recipient varchar(128) NOT NULL,
  client_name varchar(128) DEFAULT "",
  helo_name varchar(128) DEFAULT "",
  queue_id  varchar(16) DEFAULT "",
  insertdate timestamp(14) NOT NULL,
  seconddate timestamp(14) NOT NULL,
  updatedate timestamp(14) NOT NULL,
  counter int(11) DEFAULT 0,
  PRIMARY KEY (id),
  KEY (client_address),
  KEY (sender),
  KEY (recipient),
  UNIQUE KEY (client_address,sender,recipient)
 )  TYPE=MyISAM;

=head1 SQL query samples

Look at specific sender/recipient pairs that successfully navigated greylisting, and report how long it took between the first and second tries.

 mysql> select counter,(unix_timestamp(seconddate)-unix_timestamp(insertdate))
        as diff, insertdate, seconddate,updatedate,sender,recipient 
        from entities where seconddate>0  order  by updatedate;

Report average INITIAL delay, for COMPLETED messages, by recipient

 mysql> select  (sum(unix_timestamp(seconddate)) /
                   count(unix_timestamp(seconddate)))  
              - (sum(unix_timestamp(insertdate)) / 
                   count(unix_timestamp(insertdate)))
        as delta, recipient from entities 
        where (seconddate > 0) group by recipient;

=head1 How to use inside postfix

This isn't as much of a how-to, but more of a how-I-did-it.

main.cf:

 smtpd_recipient_restrictions =
   permit_sasl_authenticated ,
   permit_mynetworks,
   warn_if_reject reject_unauth_pipelining,
   check_policy_service unix:private/greylist
   check_policy_service unix:private/bridge
   reject_unauth_destination

master.cf:

 greylist  unix  -       n       n       -       -       spawn
   user=nobody argv=/usr/local/bin/perl5 /etc/postfix/greylist.pl -v

=head1  Testing JUST the greylist

Nobody will want to hear about your postfix having problems with this
greylist filter, unless you've fully 100% isolated your problems to 
being or not being the filter.

First off, you should run as whatever user you say in "master.cf".
I run as "nobody".  This will ensure that you do not have permission
issues.

I use:

 % cat >/tmp/1
 request=smtpd_access_policy
 protocol_state=RCPT
 protocol_name=SMTP
 helo_name=the.world.tld
 queue_id=1045F2AB23
 sender=spamthe@world.tld
 recipient=me@mydomain.com
 client_address=10.1.2.3
 client_name=the.world.tld
 ^d      [ctrl d on a blank line]

 % /etc/postfix/greylist.pl < /tmp/1
 action=450 Service is unavailable; code 300

Wait a bit

 % /etc/postfix/greylist.pl < /tmp/1
 action=450 Service is unavailable; code 250

Wait 5 minutes

 % /etc/postfix/greylist.pl < /tmp/1
 action=dunno


At this point, yes, it is working as expected.


=head1 SUPPORT

Sorry, but my current work schedule precludes me from spending much time
supporting this.  Anyone handy with perl and mysql within your own
organization can possibly help.  If you're doing this for home use, perhaps
now is that great time to learn new things!

This doesn't mean I won't answer questions or take suggestions; however,
my time is indeed limited, and my response may not be the one you're after.

=cut

  ##############################################################
  # Given %attr, return back the answer to tell the user.      #
  #                                                            #
  # Note that this does have some whitelisting happening       #
  # (where we return "dunno") based on specific circumstances. #
  # This can probably be done in postfix itself, but why       #
  # lose that flexibility?                                     #
  ##############################################################


sub smtpd_access_policy {
    my $bypass = 0;

    $bypass++ if (-f "/tmp/bypass");
    
  $bypass++ if ($attr{"recipient"} =~ m/progressive/i);

    $bypass++ if ($attr{"client_name"} =~ m/paypal/);
    $bypass++ if ($attr{"sender"} =~ m/paypal/);

   $bypass++ if ($attr{"sender"} =~ m/ronan/i);
   $bypass++ if ($attr{"sender"} =~ m/countrywide/i);

# Home buying
   $bypass++ if ($attr{"recipient"} =~ m/(movers|newhome)/);



    $bypass++ if ($attr{"recipient"} =~ m/page/);
    $bypass++ if ($attr{"sender"} =~ m/messaging.sprintpcs.com/i);

    $bypass++ if ($attr{"recipient"} =~ m/web.*\@kissmygrass.com/i);

    $bypass++ if ($attr{"recipient"} =~ m/revokeable/);
    $bypass++ if ($attr{"recipient"} =~ m/revokable/);
    $bypass++ if ($attr{"recipient"} =~ m/householdvisa/);
	  $bypass++ if ($attr{"recipient"} =~ m/kaboing/);
	  $bypass++ if ($attr{"recipient"} =~ m/beazer/);

    $bypass++ if ($attr{"recipient"} =~ m/blueman/i);
    $bypass++ if ($attr{"recipient"} =~ m/comcast/i);

    # postmasters are required to get mail. 
    $bypass++ if ($attr{"recipient"} =~ m/postmaster/i);

    # Exim's equivalent of sender verification
    $bypass++ if ($attr{"recipient"} =~ m/$attr{client_name}-.*-testing\@/);


    # Specific ugly formats that don't suit greylisting at all.
    # Note that groups.yahoo.com treats 451 (TEMPFAIL) as *PERMANENT*.  :(
    $bypass++ if ($attr{"sender"} =~ m#returns.groups.yahoo.com#);
    $bypass++ if ($attr{"sender"} =~ m#.*-.*=.*\..*@.*#); # VERP? not seen with spam really

    # more sites that treat 450 as 550:
    $bypass++ if ($attr{"sender"} =~ m#registeredsite.com$#);
    $bypass++ if ($attr{"sender"} =~ m#he.net$#);

    $bypass++ if ($attr{"recipient"} =~ m/jfeslerredchair/);
    $bypass++ if ($attr{"recipient"} =~ m/jfeslerxdarwin/);


    $bypass++ if ($attr{"sender"} =~ m/r8rs1/);


    $bypass++ if ($attr{"sender"} =~ m#\d+\@mobile.att.net$#);


    # "fix" sender addresses to strip out numbers that are used for tracking
    $attr{"sender"} =~ s/(?=.*@)\b\d+\b/-#-#/g;  #  from=<rangers-allcom-list-return-4381-user=domain.com@burningman.com>
 
    # ebay is really slow to resend mail - as much as 2-3 hours!   
    $bypass++ if (($attr{"sender"} =~ m/[@.](ebay.com|ebaymails.com)$/) &&
             ($attr{"client_name"} =~ m/[@.](ebay.com|ebaymails.com)$/));

    $bypass++ if ($attr{"recipient"} =~ m/ebay\@/);
    $bypass++ if ($attr{"recipient"} =~ m/\+ebay/);



    # I don't want locally generated mail to be slowed down.
    $bypass++ if ($attr{"client_address"} eq "127.0.0.1");
    $bypass++ if ($attr{"client_address"} eq "64.57.102.22");

    # Some mailing lists suck and don't reset the Sender: address
    # to a list owner.    This one is for Jeff.
    $bypass++ if ($attr{"client_name"} =~ m/laughingsquid.net$/);

    # I have a different access list handle "crpl" mailing list mail.
    $bypass++ if ($attr{"recipient"} =~ m/^crpl@(corvette-resto.com|gigo.com)/i);

    # Bounces are either legit - or user unknown.  Let'em in quick.
    $bypass++ if ($attr{"recipient"} =~ m/bounces/i); 

    # Treat postmaster special.  Some day I'll regret this I'm sure.
    $bypass++ if ($attr{"sender"} =~ m/^postmaster\@/i);
    $bypass++ if ($attr{"recipient"} =~ m/^postmaster\@/i);


    # Find out when we first got mail from this IP/sender/recipient
    # This also updates the mysql database as a side effect
    my ($time_stamp)  = read_database();
    my ($age) = time() - $time_stamp;

    # Return _after_ running the database updates - this gives us information about what is going on, if we want to datamine it
    return "dunno" if ($bypass);

    # We previously bypassed if the *IP* address was us
    # Nobody else should claim to be us.
    if (($attr{"helo_name"} eq "64.57.102.22") ||
        ($attr{"helo_name"} eq "gigo.com") ||
        ($attr{"helo_name"} eq "heaven.gigo.com"))  {
       return "550 You are not really $attr{helo_name}."
    }


    # If this is a new request add this client/sender/recipient to the database.
    if ($time_stamp == 0) {
     syslog $syslog_priority, "we got back '0' from read_database, something is wrong; defaulting to 'dunno'";
     return "dunno";
    }

    # Specify DUNNO instead of OK so that the check_policy_service restriction
    # can be followed by other restrictions.
    syslog $syslog_priority, "request age $age" if $verbose;
    if ($age > $greylist_delay) {
      return "dunno";
    } else {
      my $diff = $greylist_delay - $age;
    	return "450 Service is unavailable; code $diff"
    }
}

#
# Log an error and abort.
#
sub fatal_exit {
    my($first) = shift(@_);
    
    ##########################################################
    # In my opinion, it would be better to say "dunno"       #
    # instead of cause errors to postfix.  To that end, we   #
    # say so, before exiting.  Greylisting is just a partial #
    # defense against spam, but it isn't really part of      #
    # access controls.                                       #
    ##########################################################
    print "action=dunno\n\n";  

    syslog "err", "fatal: $first", @_;
    if (-t STDOUT) {
      print STDOUT "fatal: $first\n";  # if ran interactively.. lets see it!
    }
    exit 1;
}

sub open_database {
  return if ($dbh);
  $dbh = DBI->connect(@DBIPARMS);
  unless ($dbh) {
    fatal_exit "mysql database open failed";
  } 
}

#
# Read database. Use a shared lock to avoid reading the database
# while it is being changed.
#
sub read_database {
    my($ip,$sender,$recipient) = @_;
    breakpoint();

    open_database();

    $sth_update ||= $dbh->prepare("UPDATE entities SET counter=counter+1, updatedate=now(), insertdate=insertdate, client_name=?, helo_name=?, queue_id=?" 
                                  . " WHERE client_address=? AND  sender=? AND recipient=?");
    my $rv_update = $sth_update->execute($attr{"client_name"},$attr{"helo_name"},$attr{"queue_id"},
                     $attr{"client_address"},$attr{"sender"},$attr{"recipient"});

    if ($rv_update < 1) {
       # Hm.  Maybe we should try inserting!
       breakpoint();
       $sth_insert ||= $dbh->prepare("INSERT INTO entities(client_address,sender,recipient,client_name,helo_name,queue_id,updatedate,counter) VALUES (?,?,?,?,?,?,now(),1)");
       my $rv_insert = $sth_insert->execute($attr{"client_address"},$attr{"sender"},$attr{"recipient"}, $attr{"client_name"},$attr{"helo_name"},$attr{"queue_id"});
    }

    $sth_lookup ||= $dbh->prepare("SELECT unix_timestamp(insertdate) AS u_insertdate, insertdate,updatedate,seconddate, counter" 
                                  . " FROM entities WHERE client_address=? AND sender=? AND recipient=?");
    my $rv_lookup = $sth_lookup->execute($attr{"client_address"},$attr{"sender"},$attr{"recipient"});
    my $hashref = $sth_lookup->fetchrow_hashref;

    
    return  0 if (! defined $hashref);
    if (${$hashref}{"counter"}==2) {
      $sth_update2 ||= $dbh->prepare("UPDATE entities SET seconddate=now(), insertdate=insertdate,updatedate=updatedate"
                                    . " WHERE client_address=? AND  sender=? AND recipient=?");
      my $rv_update2 = $sth_update2->execute($attr{"client_address"},$attr{"sender"},$attr{"recipient"});
    }


    return (${$hashref}{"u_insertdate"});
}


#
# This process runs as a daemon, so it can't log to a terminal. Use
# syslog so that people can actually see our messages.
#
setlogsock $syslog_socktype;
openlog $0, $syslog_options, $syslog_facility;

#
# We don't need getopt() for now.
#
foreach (@ARGV) {
 if ($_ eq "-v") {
   $verbose=1;
 } else {
   fatal_exit("Invalid option: $_, usage: $0 [-v]");
 }
}


#
# Unbuffer standard output.
#
select((select(STDOUT), $| = 1)[0]);

#
# Receive a bunch of attributes, evaluate the policy, send the result.
#
while (<STDIN>) {
    if (/([^=]+)=(.*)\n/) {
	$attr{substr($1, 0, 512)} = substr($2, 0, 127);
    } elsif ($_ eq "\n") {
	if ($verbose) {
	    for (keys %attr) {
		syslog $syslog_priority, "Attribute: %s=%s", $_, $attr{$_};
	    }
	}
  $attr{'request'} ||= 'missing';
	fatal_exit "unrecognized request type: $attr{request}"
	    unless $attr{"request"} eq "smtpd_access_policy";
	my $action = smtpd_access_policy();
#$action = "dunno";  # TEMP
	syslog $syslog_priority, "Action: %s", $action if $verbose;
	print STDOUT "action=$action\n\n";
	%attr = ();
    } else {
	chop;
	syslog $syslog_priority, "warning: ignoring garbage: %.100s", $_;
    }
}


sub breakpoint {
  $DB::single = 2;
  $DB::single = 2; # Avoid warnings
}