Extend require_resolvable_fromhost to include a configurable list of

"impossible" addresses to combat spammer forging.  (Hanno Hecker)

git-svn-id: https://svn.perl.org/qpsmtpd/branches/0.31@522 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
John Peacock 2005-07-28 20:25:54 +00:00
parent 37fb26af81
commit ea28e88fa6
2 changed files with 61 additions and 3 deletions

View File

@ -0,0 +1,6 @@
# include full network block including mask
127.0.0.0/8
0.0.0.0/8
224.0.0.0/4
169.254.0.0/16
10.0.0.0/8

View File

@ -1,4 +1,7 @@
use Net::DNS qw(mx); use Net::DNS qw(mx);
use Socket;
my %invalid = ();
sub hook_mail { sub hook_mail {
my ($self, $transaction, $sender) = @_; my ($self, $transaction, $sender) = @_;
@ -6,6 +9,14 @@ sub hook_mail {
return DECLINED return DECLINED
if ($self->qp->connection->notes('whitelistclient')); if ($self->qp->connection->notes('whitelistclient'));
foreach my $i ($self->qp->config("invalid_resolvable_fromhost")) {
$i =~ s/^\s*//;
$i =~ s/\s*$//;
if ($i =~ m#^((\d{1,3}\.){3}\d{1,3})/(\d\d?)#) {
$invalid{$1} = $3;
}
}
$sender->format ne "<>" $sender->format ne "<>"
and $self->qp->config("require_resolvable_fromhost") and $self->qp->config("require_resolvable_fromhost")
and !$self->check_dns($sender->host) and !$self->check_dns($sender->host)
@ -18,7 +29,6 @@ sub hook_mail {
} }
sub check_dns { sub check_dns {
my ($self, $host) = @_; my ($self, $host) = @_;
@ -30,11 +40,19 @@ sub check_dns {
my $res = new Net::DNS::Resolver; my $res = new Net::DNS::Resolver;
$res->tcp_timeout(30); $res->tcp_timeout(30);
$res->udp_timeout(30); $res->udp_timeout(30);
return 1 if mx($res, $host); my @mx = mx($res, $host);
foreach my $mx (@mx) {
return mx_valid($self, $mx->exchange, $host);
}
my $query = $res->search($host); my $query = $res->search($host);
if ($query) { if ($query) {
foreach my $rr ($query->answer) { foreach my $rr ($query->answer) {
return 1 if $rr->type eq "A" or $rr->type eq "MX"; if ($rr->type eq "A") {
return is_valid($rr->address);
}
elsif ($rr->type eq "MX") {
return mx_valid($self, $rr->exchange, $host);
}
} }
} }
else { else {
@ -44,3 +62,37 @@ sub check_dns {
return 0; return 0;
} }
sub is_valid {
my $ip = shift;
my ($net,$mask);
### while (($net,$mask) = each %invalid) {
### ... does NOT reset to beginning, will start on
### 2nd invocation after where it denied the first time..., so
### 2nd time the same "MAIL FROM" would be accepted!
foreach $net (keys %invalid) {
$mask = $invalid{$net};
$mask = pack "B32", "1"x($mask)."0"x(32-$mask);
return 0
if join(".", unpack("C4", inet_aton($ip) & $mask)) eq $net;
}
return 1;
}
sub mx_valid {
my ($self, $name, $host) = @_;
my $res = new Net::DNS::Resolver;
my $query = $res->search($name);
if ($query) {
foreach my $rr ($query->answer) {
next unless $rr->type eq "A";
return is_valid($rr->address);
}
}
else {
$self->log(LOGWARN, "$$ query for $host failed: ", $res->errorstring)
unless $res->errorstring eq "NXDOMAIN";
}
return 0;
}
# vim: ts=2 sw=2 expandtab syn=perl