#!/usr/bin/perl -w
# -*- cperl -*-
# $Id$

use strict;
use Data::Dumper;
use Mail::SPF::Query;
use Net::DNS;
use Sys::Syslog;
use IO::Handle;
use Getopt::Std;
use Fcntl ':flock';
use DBI;


my $greylist_db = "/var/spool/postfix/db/greylist/greylist.sqlite"; # chrooted!
my $whitelist_expiry = 30 * 86400;

my @greylist_time = ( 0, 2, 5, 15, 60 );

## global vars
my ($dbh, %attrs, $res);

sub policy {
  my $suspect = 0;

  ## already whitelisted?
  my $wl_status = get_status();
  if($wl_status eq 'W') {
    return 'DUNNO';
  } elsif($wl_status eq 'G') {
    return "450 Greylisted, try again later";
  } elsif($wl_status eq 'OK') {
    return "OK";
  }

  ## no reverse lookup
  if($attrs{client_name} eq 'unknown') {
    mylog('debug', 'no reverse lookup for %s', $attrs{client_address});
    $suspect++;
  }

  ## HELO
  if($attrs{helo_name} !~ /\./) { # host without domain
    mylog('debug', 'HELO name %s is not FQDN', $attrs{helo_name});
    $suspect++;
  } elsif($attrs{helo_name} =~ /^\[?\d+\.\d+\.\d+\.\d+\]?$/) {
    mylog('debug', 'HELO name %s is IP addr', $attrs{helo_name});
    $suspect++;
  } else { # check helo name in DNS
    unless(has_A_or_MX($attrs{helo_name})) { # helo name not in DNS
      mylog('debug', 'HELO name %s has no A or MX records',
	    $attrs{helo_name});
      $suspect++;
    }
  }

  ## dialups
  if(my $r = check_rbls(["dul.dnsbl.sorbs.net", "dynablock.njabl.org",
			 "dialups.visi.com" ],
			$attrs{client_address})) {
    mylog('debug', 'dialup (%s): %s', $r, $attrs{client_address});
    $suspect++;
  }

  ## SPF
  my $spf = new Mail::SPF::Query(ip => $attrs{client_address},
				 sender => $attrs{sender},
				 helo => $attrs{helo_name},
				 trusted => 1,
				 guess => 1);
  unless (defined $spf) {
    mylog('debug','new Mail::SPF::Query failed');
  } else {
    my ($result, $smtp_comment) = $spf->result();
    mylog('debug', 'SPF result %s/%s', $result, $smtp_comment);
    if($result !~ /pass|none/) {
      $suspect++;
    }
  }

  mylog('debug', 'suspect level %d', $suspect);

  if($suspect == 0) {
    set_whitelisted();
    return "DUNNO";
  } else {
    set_greylisted($greylist_time[$suspect]);
    return "450 Greylisted, try again later";
  }
}


## main
openlog("meta-greylist", "pid", "mail");
mylog('info', 'starting');

my %opts;
getopts('d', \%opts);
my $debug = $opts{d};

$res = Net::DNS::Resolver->new;
$res->persistent_udp(1);


autoflush STDOUT 1;

while(<>) {
  chomp;

  my $answer;

  if(/^$/) {
    if($attrs{request} ne 'smtpd_access_policy') {
      mylog('info', 'request = %s != smtpd_access_policy', $attrs{request});
      $answer = "DUNNO";
    } elsif($attrs{protocol_state} ne 'RCPT') {
      mylog('info', 'protocol_state = %s != RCPT', $attrs{protocol_state});
      $answer = "DUNNO";
    } else {
      ($attrs{sender_domain} = $attrs{sender}) =~ s/^.*\@//g;
      open_db();
      $answer = policy(\%attrs);
      close_db();
    }

    chomp($answer);
    mylog('debug', 'action=%s', $answer);
    printf("action=%s\n\n", $answer);
    %attrs = ();
    next;
  }
  my($k,$v) = split(/=/,$_,2);
  $attrs{$k} = $v;
  mylog('debug', 'attr %s=%s', $k, $v);
}
mylog('info', 'terminating (EOF)');

sub mylog {
  my $level = shift;
  if($level eq 'debug' && $debug) {
    $level = 'info';
  }
  if($level ne 'debug') {
    syslog($level, @_);
  }
}

sub has_A_or_MX {
  my $fqdn = shift;

  my $q = $res->send($fqdn,'A');
  return undef unless $q;
  foreach my $rr ($q->answer) {
    mylog('debug','has_A_or_MX (A): %s RR %s', $fqdn, $rr->type);
    if($rr->type eq 'A') {
       return 1;
    }
  }
  $q = $res->send($fqdn,'MX');
  return undef unless $q;
  foreach my $rr ($q->answer) {
    mylog('debug','has_A_or_MX (MX): %s RR %s', $fqdn, $rr->type);
    if($rr->type eq 'MX') {
      return 1;
    }
  }
  return 0;
}

sub check_rbl {
  my $rbl = shift;
  my $ipaddr = shift;

  my $revaddr = join('.',reverse(split(/\./,$ipaddr))) . '.' . $rbl;

  my $q = $res->send($revaddr, 'A');
  #mylog('debug', 'check_rbl %s', $revaddr);
  return undef unless $q;
  foreach my $rr ($q->answer) {
    if($rr->type eq 'A') {
      return 1;
    }
  }
  return 0;
}

sub check_rbls {
  my $rbls = shift;
  my $ipaddr = shift;

  foreach my $rbl (@$rbls) {
    if(check_rbl($rbl, $ipaddr)) {
      return $rbl;
    }
  }
  return undef;
}

sub get_status {
  my($sth, @r, $ret);

  $ret = eval {

    my $x = $dbh->selectall_arrayref("SELECT * FROM forwarders
              WHERE hostname = ?", {}, $attrs{client_name});
    if(@$x) {
      mylog('debug', '%s is forwarder', $attrs{client_name});
      return 'OK';
    }

    $sth = $dbh->prepare_cached("SELECT status, expire FROM greylist
                                 WHERE client = ? AND helo = ?
                                 AND sender = ?");
    $sth->execute($attrs{client_address}, $attrs{helo_name},
		  $attrs{sender_domain});
    if(@r = $sth->fetchrow_array) {
      if($r[0] eq 'W') {
	$dbh->do("UPDATE greylist SET expire = ?, count = count + 1
                  WHERE client = ? AND helo = ? AND sender = ?", {},
		 time() + $whitelist_expiry,
		 $attrs{client_address}, $attrs{helo_name},
		 $attrs{sender_domain});
	mylog('info', '%s:%s:%s is whitelisted', $attrs{client_address},
	      $attrs{helo_name}, $attrs{sender_domain});
	return 'W';
      } elsif($r[0] eq 'G') {
	if($r[1] >= time()) {
	  mylog('info', '%s:%s:%s is greylisted', $attrs{client_address},
		$attrs{helo_name}, $attrs{sender_domain});
	  return 'G';
	} else {
	  mylog('info', '%s:%s:%s changing to whitelisted',
		$attrs{client_address},	$attrs{helo_name},
		$attrs{sender_domain});
	  set_whitelisted();
	  return 'W';
	}
      } else {
	mylog('err', 'impossible status row: %s', $r[0]);
	return 'W';
      }
    } else {
      mylog('debug', '%s:%s:%s is not in DB', $attrs{client_address},
	    $attrs{helo_name}, $attrs{sender_domain});
      return 'U';
    }
  };
  if($@) {
    mylog('err', 'is_whitelisted: SQL error: %s', $dbh->errstr);
    return 'W';
  }
  return $ret;
}

sub set_whitelisted {
  eval {
    my $x = $dbh->selectall_arrayref("SELECT * FROM greylist WHERE
              client = ? AND helo = ? AND sender = ?", {},
				       $attrs{client_address},
				       $attrs{helo_name},
				       $attrs{sender_domain});
    if(@$x) {
      $dbh->do("UPDATE greylist SET status = 'W', expire = ?, count = 1
              WHERE client = ? AND helo = ? AND sender = ?", {},
	       time() + $whitelist_expiry,
	       $attrs{client_address}, $attrs{helo_name},
	       $attrs{sender_domain});
    } else {
      $dbh->do("INSERT INTO greylist (client, helo, sender, status, expire,
                count) VALUES(?,?,?,'W',?,1)", {},
	       $attrs{client_address}, $attrs{helo_name}, $attrs{sender_domain},
	       time() + $whitelist_expiry);
      mylog('info', '%s:%s:%s set to whitelisted', $attrs{client_address},
	    $attrs{helo_name}, $attrs{sender_domain});
    }
  };
  if($@) {
    mylog('err', 'set_whitelisted: SQL error: %s', $@);
  }
}

sub set_greylisted {
  my $duration = shift;

  unless(defined $duration) {
    $duration = $greylist_time[-1];
  }

  eval {
    $dbh->do("INSERT INTO greylist (client, helo, sender, status, expire, count)
              VALUES(?,?,?,'G',?,0)", {},
	     $attrs{client_address}, $attrs{helo_name}, $attrs{sender_domain},
	     time() + $duration * 60);
    mylog('info', '%s:%s:%s set to greylisted (%d)', $attrs{client_address},
	  $attrs{helo_name}, $attrs{sender_domain}, $duration);
  };
  if($@) {
    mylog('err', 'set_greylisted: SQL error: %s', $@);
  }
}

sub open_db {
  unless($dbh = DBI->connect("dbi:SQLite:dbname=$greylist_db",'','',
                         { RaiseError => 1,
			   PrintError => 0,
			   AutoCommit => 1})) {
    mylog("error connecting to DB %s", $greylist_db);
    exit 1;
  }
  $dbh->{HandleError} = \&log_db_error;
  $dbh->{ShowErrorStatement} = 1;
  eval {
    $dbh->do("select client, helo, sender, status, expire, count
                      from greylist where expire = 0");
  };
  if ($@) {
    eval {
      $dbh->do("create table greylist (
                       client text,
                       helo text,
                       sender text,
                       status text,
                       expire integer,
                       count integer)");
      $dbh->do("create unique index greylist_main
                       on greylist(client, helo, sender)");
      $dbh->do("create index greylist_time
                       on greylist(expire)");
      mylog('info', 'initialized DB %s', $greylist_db);
    };
    if ($@) {
      mylog('err', "error creating DB: %s", $@);
      exit 2;
    }
  }

  eval {
    $dbh->do("select hostname from forwarders");
  };
  if ($@) {
    eval {
      $dbh->do("create table forwarders (
                hostname text primary key)");
      mylog('info', 'created table forwarders');
    };
    if($@) {
      mylog('err', 'error creating table forwarders');
      exit 3;
    }
  }
}

sub log_db_error {
  my $msg = shift;

  mylog('err', 'DBI error: %s', $msg);
  return undef;
}

sub close_db {
  $dbh->disconnect();
}

#
# $Log$
#