Initial commit.
This commit is contained in:
410
mail/spamassassin/MTX.pm
Normal file
410
mail/spamassassin/MTX.pm
Normal file
@@ -0,0 +1,410 @@
|
||||
|
||||
# MTX plugin for SpamAssassin
|
||||
# (c) Darxus@ChaosReigns.com, released under the GPL.
|
||||
# http://www.chaosreigns.com/mtx/
|
||||
#
|
||||
# 2010-02-10 Initial release.
|
||||
# 2010-02-12 Implemented blacklisting, switched to SA's DnsResolver
|
||||
# 2010-02-12-01 Fixed failure to handle IP CNAME caused in previous.
|
||||
# Reduce chances of exploiting flaws by more defaulting to
|
||||
# "fail".
|
||||
# 2010-02-12-01 Switched from last external to last untrusted relay.
|
||||
# 2010-02-13 Rename of above.
|
||||
# 2010-02-13-01 Don't "fail" on "last untrusted relay unavailable".
|
||||
# 2010-02-14 Rename of above.
|
||||
# 2010-02-14-01 Implemented policy record without delegation.
|
||||
# 2010-02-14-02 Implemented policy record delegation.
|
||||
# 2010-02-14-03 Fixed whining about "implicit split to @_".
|
||||
# 2010-02-15 Rename of above.
|
||||
# 2010-02-15-01 Don't check Policy of None has already been determined.
|
||||
# 2010-02-15-02 Removed unnecessary variable $arraydepth.
|
||||
# 2010-02-15-03 Minor tidying.
|
||||
# 2010-02-15-04 Removed unnecessary variable $hostname.
|
||||
# 2010-02-15-05 Further minor tidying.
|
||||
# 2010-02-16 Rename of above.
|
||||
# 2010-02-15-01 Switched back to Net::DNS::Resolver for SpamAssassin v3.3.0 compatability.
|
||||
# All releases pass harness testing on SA v3.2.5 + perl
|
||||
# v5.8.8 and v3.3.0 + perl v5.10.0 starting here.
|
||||
# 2010-10-19 Throw a freaking error if the DNS lookup fails. Thanks to
|
||||
# Patrick Domack for reporting.
|
||||
# 2010-10-24 If DNS lookup on sending IP returns something but it
|
||||
# contains nothing, also set mtx_none so check_polciy
|
||||
# doesn't get run. Thanks to Patrick Domack for reporting.
|
||||
# 2011-05-29 IPv6 support by Andreas Schulze.
|
||||
#
|
||||
# TODO
|
||||
# * Switch to Mail::SpamAssassin::DnsResolver::bgsend ?
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MTX - MTX
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
# http://www.chaosreigns.com/mtx/
|
||||
|
||||
loadplugin Mail::SpamAssassin::Plugin::MTX
|
||||
|
||||
header MTX_PASS eval:check_mtx_pass()
|
||||
score MTX_PASS -5
|
||||
describe MTX_PASS MTX: Passed: http://www.chaosreigns.com/mtx/
|
||||
|
||||
header MTX_FAIL eval:check_mtx_fail()
|
||||
score MTX_FAIL 1
|
||||
describe MTX_FAIL MTX: Failed: http://www.chaosreigns.com/mtx/
|
||||
|
||||
header MTX_BLACKLIST eval:check_mtx_blacklist()
|
||||
# Do not define a score, it's defined with mtx_blacklist.
|
||||
describe MTX_BLACKLIST MTX: On your blacklist.
|
||||
|
||||
# Blacklist by the host name (PTR) of the sending IP (last untrusted relay).
|
||||
# Second argument is the score to assign, use whatever you want.
|
||||
mtx_blacklist *.example.com 5 # Known to send spam *and* nonspam, nullify PASS score.
|
||||
mtx_blacklist *.example2.com 100 # Only sends spam, big penalty.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Write the above lines in the synopsis to
|
||||
C</etc/spamassassin/local.cf>.
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package Mail::SpamAssassin::Plugin::MTX;
|
||||
|
||||
use Mail::SpamAssassin::Plugin;
|
||||
use Mail::SpamAssassin::Logger; # dbg()
|
||||
# REVIEW: does including Net::IP introduce performance
|
||||
# or massiv memory usage changes?
|
||||
# REVIEW: may this trigger problems outside this plugin?
|
||||
use Net::IP;
|
||||
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(Mail::SpamAssassin::Plugin);
|
||||
#my $res = Mail::SpamAssassin::DnsResolver->new;
|
||||
my $res = Net::DNS::Resolver->new;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $mailsaobject = shift;
|
||||
|
||||
$class = ref($class) || $class;
|
||||
my $self = $class->SUPER::new($mailsaobject);
|
||||
bless ($self, $class);
|
||||
|
||||
$self->register_eval_rule ("check_mtx_pass");
|
||||
$self->register_eval_rule ("check_mtx_fail");
|
||||
$self->register_eval_rule ("check_mtx_none");
|
||||
$self->register_eval_rule ("check_mtx_neutral");
|
||||
$self->register_eval_rule ("check_mtx_softfail");
|
||||
$self->register_eval_rule ("check_mtx_hardfail");
|
||||
$self->register_eval_rule ("check_mtx_blacklist");
|
||||
|
||||
$self->set_config($mailsaobject->{conf});
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub check_mtx_pass {
|
||||
my ($self, $scanner) = @_;
|
||||
&check_mtx unless $scanner->{mtx_checked};
|
||||
return $scanner->{mtx_pass};
|
||||
}
|
||||
sub check_mtx_fail {
|
||||
my ($self, $scanner) = @_;
|
||||
&check_mtx unless $scanner->{mtx_checked};
|
||||
return $scanner->{mtx_fail};
|
||||
}
|
||||
sub check_mtx_none {
|
||||
my ($self, $scanner) = @_;
|
||||
&check_mtx unless $scanner->{mtx_checked};
|
||||
return 0 if ( $scanner->{mtx_hardfail} );
|
||||
&check_policy if ( $scanner->{mtx_fail} and ! $scanner->{policy_checked}
|
||||
and ! $scanner->{mtx_none} );
|
||||
return $scanner->{mtx_none};
|
||||
}
|
||||
sub check_mtx_neutral {
|
||||
my ($self, $scanner) = @_;
|
||||
&check_mtx unless $scanner->{mtx_checked};
|
||||
return 0 if ( $scanner->{mtx_hardfail} );
|
||||
&check_policy if ( $scanner->{mtx_fail} and ! $scanner->{policy_checked}
|
||||
and ! $scanner->{mtx_none} );
|
||||
return $scanner->{mtx_neutral};
|
||||
}
|
||||
sub check_mtx_softfail {
|
||||
my ($self, $scanner) = @_;
|
||||
&check_mtx unless $scanner->{mtx_checked};
|
||||
return 0 if ( $scanner->{mtx_hardfail} );
|
||||
&check_policy if ( $scanner->{mtx_fail} and ! $scanner->{policy_checked}
|
||||
and ! $scanner->{mtx_none} );
|
||||
return $scanner->{mtx_softfail};
|
||||
}
|
||||
sub check_mtx_hardfail {
|
||||
my ($self, $scanner) = @_;
|
||||
&check_mtx unless $scanner->{mtx_checked};
|
||||
return 1 if ( $scanner->{mtx_hardfail} );
|
||||
&check_policy if ( $scanner->{mtx_fail} and ! $scanner->{policy_checked}
|
||||
and ! $scanner->{mtx_none} );
|
||||
return $scanner->{mtx_hardfail};
|
||||
}
|
||||
|
||||
sub check_policy {
|
||||
my ($self,$scanner) = @_;
|
||||
$scanner->{policy_checked} = 1;
|
||||
my $participant = 0;
|
||||
dbg("mtx: Checking MTX Policy.");
|
||||
use Mail::SpamAssassin::Util::RegistrarBoundaries;
|
||||
my $domain = Mail::SpamAssassin::Util::RegistrarBoundaries::trim_domain($scanner->{hostname});
|
||||
my @hostname = split('\.', $scanner->{hostname});
|
||||
my $policy_mindepth = scalar( @{[split('\.', $domain)]} );
|
||||
my $policy_maxdepth = scalar( @hostname );
|
||||
$policy_maxdepth = 20 if ($policy_maxdepth > 20);
|
||||
dbg ("mtx: Policy mindepth: $policy_mindepth, maxdepth: $policy_maxdepth" );
|
||||
for my $policy_depth ($policy_mindepth .. $policy_maxdepth) {
|
||||
my $delegate = 0;
|
||||
my $policyfound = 0;
|
||||
$domain = join('.',reverse((reverse(@hostname))[0 .. $policy_depth -1]));
|
||||
my $policy = "policy.mtx.$domain";
|
||||
dbg("mtx: MTX Policy record name: $policy, depth: $policy_depth");
|
||||
my $packet = $res->send($policy, 'A');
|
||||
unless (defined $packet) {
|
||||
dbg('mtx: DNS "A" record lookup failed. You appear to have a DNS problem: ', $res->errorstring);
|
||||
return;
|
||||
}
|
||||
my @answer = $packet->answer;
|
||||
unless (@answer) {
|
||||
dbg("mtx: Failed to get policy record $policy.");
|
||||
$scanner->{mtx_none}=1;
|
||||
return;
|
||||
}
|
||||
for my $rr (@answer) {
|
||||
if (${$rr}{type} eq 'A') {
|
||||
my $address = ${$rr}{address};
|
||||
unless (defined $address) {
|
||||
dbg("mtx: A record exists but has no value. I don't think this is possible.");
|
||||
$scanner->{mtx_none}=1;
|
||||
return;
|
||||
}
|
||||
dbg("mtx: MTX Policy record value: $address.");
|
||||
if ($address =~ m#^127\.\d{1,3}\.(0|1)\.(0|1|2)$#) { ##
|
||||
$delegate = $1;
|
||||
$participant = $2;
|
||||
$policyfound = 1;
|
||||
if ($delegate == 1) {
|
||||
dbg("mtx: Delegated.");
|
||||
} else {
|
||||
dbg("mtx: Not delegated.");
|
||||
}
|
||||
if ($participant == 0) {
|
||||
dbg("mtx: Found Neutral.");
|
||||
$scanner->{mtx_neutral}=1;
|
||||
$scanner->{mtx_softfail}=0;
|
||||
$scanner->{mtx_hardfail}=0;
|
||||
} elsif ($participant == 1) {
|
||||
dbg("mtx: Found SoftFail.");
|
||||
$scanner->{mtx_neutral}=0;
|
||||
$scanner->{mtx_softfail}=1;
|
||||
$scanner->{mtx_hardfail}=0;
|
||||
} elsif ($participant == 2) {
|
||||
dbg("mtx: Found HardFail.");
|
||||
$scanner->{mtx_neutral}=0;
|
||||
$scanner->{mtx_softfail}=0;
|
||||
$scanner->{mtx_hardfail}=1;
|
||||
}
|
||||
} else {
|
||||
dbg("mtx: Unknown policy record found, wildcard DNS record, or new version of MTX? Ignoring.");
|
||||
}
|
||||
last; # Protocol says only check first.
|
||||
}
|
||||
}
|
||||
if ($policyfound != 1) {
|
||||
dbg("mtx: No policy found at this depth.");
|
||||
unless ( $scanner->{mtx_neutral} or $scanner->{mtx_softfail}
|
||||
or $scanner->{mtx_hardfail} ) {
|
||||
$scanner->{mtx_none}=1;
|
||||
}
|
||||
return;
|
||||
}
|
||||
last unless ($delegate == 1);
|
||||
}
|
||||
}
|
||||
|
||||
sub check_mtx {
|
||||
my ($self,$scanner) = @_;
|
||||
|
||||
# Sane defaults. Reduce chance of exploitable flaws.
|
||||
$scanner->{mtx_fail}=1;
|
||||
$scanner->{mtx_pass}=0;
|
||||
|
||||
dbg("mtx: Doing the necessary DNS lookups.");
|
||||
$scanner->{mtx_checked}=1;
|
||||
$scanner->{lasthop} = $scanner->{relays_untrusted}->[0];
|
||||
if (!defined $scanner->{lasthop}) {
|
||||
dbg("mtx: Last untrusted relay not available, fix your SA config, skipping MTX.");
|
||||
# The *only* failure that doesn't result in a "fail", because it's
|
||||
# due to SA misconfiguration. Or all hops being trusted, or something.
|
||||
$scanner->{mtx_fail}=0;
|
||||
return;
|
||||
}
|
||||
my $ip = $scanner->{lasthop}->{ip};
|
||||
dbg("mtx: Testing IP: $ip (last untrusted relay).");
|
||||
|
||||
my $mtx = '';
|
||||
|
||||
{
|
||||
my $packet = $res->send($ip, 'PTR');
|
||||
unless (defined $packet) {
|
||||
dbg('mtx: DNS "PTR" record lookup failed. You appear to have a DNS problem: ', $res->errorstring);
|
||||
return;
|
||||
}
|
||||
my @answer = $packet->answer;
|
||||
unless (@answer) {
|
||||
dbg("mtx: Failed to get PTR record for $ip.");
|
||||
$scanner->{mtx_fail}=1;
|
||||
$scanner->{mtx_none}=1;
|
||||
return;
|
||||
}
|
||||
# Can't just use the first record because it could be a CNAME with
|
||||
# a PTR in there somewhere.
|
||||
for my $rr (@answer) {
|
||||
if (${$rr}{type} eq 'PTR') {
|
||||
$scanner->{hostname} = ${$rr}{ptrdname};
|
||||
dbg("mtx: Host name ('PTR' record) is ". $scanner->{hostname} .".");
|
||||
my $netip = new Net::IP ($ip);
|
||||
my $reverseip = $netip->reverse_ip();
|
||||
$reverseip =~ s/\.(in-addr|ip6)\.arpa\.//i;
|
||||
unless (defined $reverseip and $reverseip =~ /\./) {
|
||||
info("mtx: failed to reverse $ip");
|
||||
# REVIEW: maybe $scanner->{mtx_foo} should be set ?????
|
||||
return;
|
||||
}
|
||||
$mtx = $reverseip . '.mtx.' . $scanner->{hostname};
|
||||
$scanner->{mtx_record}=$mtx;
|
||||
dbg("mtx: Relevant MTX record is: $mtx");
|
||||
last; # Protocol says use the first one.
|
||||
}
|
||||
}
|
||||
if ($mtx eq '') {
|
||||
dbg("mtx: Looking up DNS PTR record for sender returned a vailue which did not contain the answer.");
|
||||
# Looking up the DNS record for the delivering IP returned an
|
||||
# answer, but it contained nothing. That's pretty freaky.
|
||||
# Need to call it a "fail" anyway so spammers don't explot it.
|
||||
$scanner->{mtx_fail}=1;
|
||||
$scanner->{mtx_none}=1;
|
||||
return;
|
||||
}
|
||||
|
||||
dbg("mtx: Checking blacklist.");
|
||||
foreach my $black_addr (keys %{$scanner->{conf}->{mtx_blacklist}}) {
|
||||
my $re = qr/$scanner->{conf}->{mtx_blacklist}->{$black_addr}{re}/i;
|
||||
if ($mtx =~ $re) {
|
||||
# How can I do this without an array?
|
||||
my $bl_score = (@{$scanner->{conf}->{mtx_blacklist}->{$black_addr}{domain}})[0];
|
||||
dbg("mtx: Blacklisted with score $bl_score and regex $re");
|
||||
$scanner->{blacklist_score}=$bl_score;
|
||||
last; # Use first matching blacklist entry.
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
{
|
||||
my $packet = $res->send($mtx, 'A');
|
||||
unless (defined $packet) {
|
||||
dbg('mtx: DNS "A" record lookup failed. You appear to have a DNS problem: ', $res->errorstring);
|
||||
return;
|
||||
}
|
||||
my @answer = $packet->answer;
|
||||
unless (@answer) {
|
||||
dbg("mtx: Failed to get A record for $mtx.");
|
||||
$scanner->{mtx_fail}=1;
|
||||
return;
|
||||
}
|
||||
for my $rr (@answer) {
|
||||
if (${$rr}{type} eq 'A') {
|
||||
my $address = ${$rr}{address};
|
||||
unless (defined $address) {
|
||||
dbg("mtx: A record exists but has no value. I don't think this is possible.");
|
||||
# Make sure it doesn't get exploited, just in case.
|
||||
$scanner->{mtx_fail}=1;
|
||||
return;
|
||||
}
|
||||
dbg("mtx: MTX record value: $address.");
|
||||
if ($address =~ m#^127\.\d{1,3}\.\d{1,3}\.(0|1)$#) { ##
|
||||
my $mtxvalue = $1;
|
||||
if ($mtxvalue == 1) {
|
||||
dbg("mtx: MTX record value indicates legit server. That's the only pass.");
|
||||
$scanner->{mtx_pass}=1;
|
||||
$scanner->{mtx_fail}=0;
|
||||
return;
|
||||
} elsif ($mtxvalue == 0) {
|
||||
dbg("mtx: MTX record value indicates non-legit server. That's a fail.");
|
||||
$scanner->{mtx_fail}=1;
|
||||
$scanner->{mtx_hardfail}=1;
|
||||
return;
|
||||
} else {
|
||||
dbg("mtx: Somebody introduced a bug.");
|
||||
die "mtx: Somebody introduced a bug.";
|
||||
}
|
||||
} else {
|
||||
dbg("mtx: Unknown MTX record value found. Wildcard DNS record or new version of MTX? Ignoring.");
|
||||
}
|
||||
last; # Protocol says only check first.
|
||||
}
|
||||
}
|
||||
dbg("mtx: No known MTX record value found, fail.");
|
||||
$scanner->{mtx_fail}=1;
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub set_config {
|
||||
my ($self, $conf) = @_;
|
||||
my @cmds;
|
||||
|
||||
push (@cmds, {
|
||||
setting => 'mtx_blacklist',
|
||||
code => sub {
|
||||
my ($self, $key, $value, $line) = @_;
|
||||
local ($1,$2);
|
||||
unless (defined $value and $value !~ /^$/) {
|
||||
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
|
||||
}
|
||||
# It is important to not accept negative scores on the blacklist,
|
||||
# because these hostnames can effortlessly beforged by the IP owner.
|
||||
unless (defined $value and $value =~ /^(\S+)\s+([\d\.]+)$/) {
|
||||
return $Mail::SpamAssassin::Conf::INVALID_VALUE;
|
||||
}
|
||||
my $address = $1;
|
||||
my $score = $2;
|
||||
$self->{parser}->add_to_addrlist_rcvd('mtx_blacklist', $address, $score);
|
||||
}
|
||||
});
|
||||
|
||||
return($conf->{parser}->register_commands(\@cmds));
|
||||
}
|
||||
|
||||
sub check_mtx_blacklist {
|
||||
my ($self, $scanner) = @_;
|
||||
&check_mtx unless $scanner->{mtx_checked};
|
||||
my @cmds;
|
||||
my $score = $scanner->{blacklist_score};
|
||||
|
||||
if($score) {
|
||||
my $description = $scanner->{conf}->{descriptions}->{MTX_BLACKLIST};
|
||||
$description .= " Score $score.";
|
||||
$scanner->{conf}->{descriptions}->{MTX_BLACKLIST} = $description;
|
||||
|
||||
# Set the score.
|
||||
$scanner->got_hit("MTX_BLACKLIST", "", score => $score);
|
||||
for my $set (0..3) {
|
||||
$scanner->{conf}->{scoreset}->[$set]->{"MTX_BLACKLIST"} = sprintf("%0.3f", $score);
|
||||
}
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user