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:
parent
37fb26af81
commit
ea28e88fa6
6
config.sample/invalid_resolvable_fromhost
Normal file
6
config.sample/invalid_resolvable_fromhost
Normal 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
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user