package DAKKAR::Graylister;
use strict;
use warnings;
use Net::DNSBLLookup;
use DBI;

{
    %Net::DNSBLLookup::dns_servers=(
        'dnsbl.sorbs.net' => {
            '127.0.0.2' => Net::DNSBLLookup::DNSBLLOOKUP_OPEN_PROXY_HTTP,
            '127.0.0.3' => Net::DNSBLLookup::DNSBLLOOKUP_OPEN_PROXY_SOCKS,
            '127.0.0.4' => Net::DNSBLLookup::DNSBLLOOKUP_OPEN_PROXY_MISC,
            '127.0.0.5' => Net::DNSBLLookup::DNSBLLOOKUP_OPEN_RELAY,
            '127.0.0.6' => Net::DNSBLLookup::DNSBLLOOKUP_SPAMHOUSE,
            '127.0.0.7' => Net::DNSBLLookup::DNSBLLOOKUP_FORMMAIL,
            '127.0.0.8' => Net::DNSBLLookup::DNSBLLOOKUP_CONFIRMED_SPAM,
            '127.0.0.9' => Net::DNSBLLookup::DNSBLLOOKUP_HIJACKED,
            '127.0.0.10' => Net::DNSBLLookup::DNSBLLOOKUP_DYNAMIC_IP,
        },
        'dnsbl.njabl.org' => {
            '127.0.0.2' => Net::DNSBLLookup::DNSBLLOOKUP_OPEN_RELAY,
            '127.0.0.3' => Net::DNSBLLookup::DNSBLLOOKUP_DYNAMIC_IP,
            '127.0.0.4' => Net::DNSBLLookup::DNSBLLOOKUP_SPAMHOUSE,
            '127.0.0.5' => Net::DNSBLLookup::DNSBLLOOKUP_MULTI_OPEN_RELAY,
            '127.0.0.8' => Net::DNSBLLookup::DNSBLLOOKUP_FORMMAIL,
            '127.0.0.9' => Net::DNSBLLookup::DNSBLLOOKUP_OPEN_PROXY,
        },
        'bl.spamcop.net' => {
            '127.0.0.2' => Net::DNSBLLookup::DNSBLLOOKUP_UNKNOWN,
        },
        'unconfirmed.dsbl.org' => {
            '127.0.0.2' => Net::DNSBLLookup::DNSBLLOOKUP_UNKNOWN,
        },
        'list.dsbl.org' => {
            '127.0.0.2' => Net::DNSBLLookup::DNSBLLOOKUP_UNKNOWN,
        },
        'sbl.spamhaus.org' => {
            '127.0.0.2' => Net::DNSBLLookup::DNSBLLOOKUP_SPAMHOUSE,
        },
        'pbl.spamhaus.org' => {
            '127.0.0.10' => Net::DNSBLLookup::DNSBLLOOKUP_DYNAMIC_IP,
            '127.0.0.11' => Net::DNSBLLookup::DNSBLLOOKUP_DYNAMIC_IP,
        },
        'cbl.abuseat.org' => {
            '127.0.0.2' => Net::DNSBLLookup::DNSBLLOOKUP_OPEN_PROXY,
        },
        'psbl.surriel.com' => {
            '127.0.0.2' => Net::DNSBLLookup::DNSBLLOOKUP_OPEN_PROXY,
        },
    );

    use Net::DNSBLLookup::Result;
    {package Net::DNSBLLookup::Result;
     our %result_type;
     no warnings 'redefine';
    sub breakdown {
        my ($self)=@_;
        my ($total_spam, $total_proxy, $total_unknown, $total_dyn) = (0,0,0);
        return unless exists $self->{results};
        while (my ($dnsbl, $v) = each %{$self->{results}}) {
            my ($is_spam, $is_proxy, $is_unknown, $is_dyn) = (0,0,0,0);
            for my $retval (@$v) {
                my $result_type = $result_type{$retval};
                if ($result_type == DNSBLLOOKUP_RESULT_OPEN_PROXY) {
                    $is_proxy = 1;
                } elsif ($result_type == DNSBLLOOKUP_RESULT_SPAM) {
                    $is_spam = 1;
                } elsif ($result_type == DNSBLLOOKUP_RESULT_UNKNOWN) {
                    $is_unknown = 1;
                } elsif ($result_type == DNSBLLOOKUP_RESULT_DYNAMIC_IP) {
                    $is_dyn = 1;
                }
            }
            $total_proxy += $is_proxy;
            $total_spam += $is_spam;
            $total_dyn += $is_dyn;
            unless ($is_proxy || $is_spam || $is_dyn) {
                $total_unknown += $is_unknown;
            }
        }
        return ($total_proxy, $total_spam, $total_dyn, $total_unknown);
    }
}
}

my $DBNAME;

sub get_from_env {
    my $from=$ENV{SMTPMAILFROM};
    die "No from??\n" unless defined $from;
    my $to=$ENV{SMTPRCPTTO};
    die "No to??\n" unless defined $to;
    my $host=$ENV{TCPREMOTEIP};
    die "No ip??\n" unless defined $host;
    $DBNAME=$ENV{DAKGL_DBNAME}
        or die "No dbname??\n";
    return _cleanup_data($host,$from,$to);
}

sub _cleanup_data {
    my ($host,$from,$to)=@_;
    # EZMLM changes the "from" at each attempt...
    $from=~s{-return-\d+-}{-return-\$-};
    return ($host,$from,$to);
}

sub check {
    my ($host,$from,$to)=@_;

    remove_old_attempts();
    if (is_whitelisted($host)) {
        accept_message();return;
    }
    if (is_second_attempt($host,$from,$to)) {
        if (is_blacklisted($host)) {
            cleanup_attempt($host,$from,$to);
            accept_message();return;
        }
        else {
            add_to_whitelist($host);
            accept_message();return;
        }
    }
    record_first_attempt($host,$from,$to);
    reject_temporarily($from);
    return;
}

{my $dbh;

 sub _init_dbh {
     return if defined $dbh;
     $dbh=DBI->connect("dbi:SQLite:dbname=$DBNAME",'','',
                   {RaiseError=>1,PrintError=>0});
     my $ver=$dbh->selectall_arrayref(q{SELECT count(*) FROM SQLite_Master WHERE Type = 'table' AND name = 'version'});
     if ((!defined $ver) or (!@$ver) or ($ver->[0]->[0]==0)) {
         _prepare_db();
     }
 }

 {my @sts=(
     q{create table version(version integer)},
     q{insert into version(version) values (1)},
     q{create table whitelist(host varchar)},
     q{create table attempts(host varchar,smtpfrom varchar,smtprcpt varchar,time integer)},
  );
  sub _prepare_db {
      for my $s (@sts) {
          $dbh->do($s);
      }
  }
 }

 sub add_to_whitelist {
     my ($host)=@_;

     _init_dbh();
     my $ret=$dbh->do('INSERT INTO whitelist(host) VALUES (?)',
                      {},$host);
 }

 sub is_whitelisted {
     my ($host)=@_;

     _init_dbh();
     my $ret=$dbh->selectall_arrayref('SELECT * FROM whitelist WHERE host=?',
                                      {Slice=>{}},$host);
     return @$ret>0;
 }

 sub record_first_attempt {
     my ($host,$from,$to)=@_;
     _init_dbh();
     my $ret=$dbh->do('INSERT INTO attempts(host,smtpfrom,smtprcpt,time) VALUES (?,?,?,?)',
                      {},$host,$from,$to,time());
 }

 sub is_second_attempt {
     my ($host,$from,$to)=@_;
     _init_dbh();
     my $ret=$dbh->selectall_arrayref('SELECT * FROM attempts WHERE host=? AND smtpfrom=? AND smtprcpt=?',
                                      {Slice=>{}},$host,$from,$to);
     return @$ret>0;
 }

 sub cleanup_attempt {
     my ($host,$from,$to)=@_;
     _init_dbh();
     if ($from) {
         my $ret=$dbh->do('UPDATE attempts SET time=? WHERE host=? AND smtpfrom=? AND smtprcpt=?',
                      {},time(),$host,$from,$to);
     }
     else {
         # prbobaly a bounce
         my $ret=$dbh->do('DELETE FROM attempts WHERE host=? AND smtpfrom=? AND smtprcpt=?',
                          {},$host,$from,$to);
     }
 }

 sub remove_old_attempts {
     _init_dbh();
     my $ret=$dbh->do('DELETE FROM attempts WHERE time<?',
                      {},(time()-86400));
 }
}


sub is_blacklisted {
    my ($host)=@_;
    my $look=Net::DNSBLLookup->new();
    my $ret=$look->lookup($host);
    my ($proxy, $spam, $dyn, $unknown) = $ret->breakdown;
    return ($proxy+$spam+$dyn+$unknown > 0);
}

sub accept_message {}

{my $message='DAKKAR-Graylister temproray reject, try again later';
 sub reject_temporarily {
     my ($from)=@_;

     if ($from eq '' or $from=~/^postmaster@/) {
         print "LD451 $message\n";
     }
     else {
         print "E451 $message\n";
     }
 }
}