diff options
Diffstat (limited to 'lib/DAKKAR/Graylister.pm')
| -rw-r--r-- | lib/DAKKAR/Graylister.pm | 229 |
1 files changed, 229 insertions, 0 deletions
diff --git a/lib/DAKKAR/Graylister.pm b/lib/DAKKAR/Graylister.pm new file mode 100644 index 0000000..9ee9be0 --- /dev/null +++ b/lib/DAKKAR/Graylister.pm @@ -0,0 +1,229 @@ +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"; + } + } +} |