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

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 {
         # probably 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=DAKKAR::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";
     }
 }
}