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)=@_;
$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 {
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";
}
}
}