ea28e88fa6
"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
99 lines
2.4 KiB
Plaintext
99 lines
2.4 KiB
Plaintext
use Net::DNS qw(mx);
|
|
use Socket;
|
|
|
|
my %invalid = ();
|
|
|
|
sub hook_mail {
|
|
my ($self, $transaction, $sender) = @_;
|
|
|
|
return DECLINED
|
|
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 "<>"
|
|
and $self->qp->config("require_resolvable_fromhost")
|
|
and !$self->check_dns($sender->host)
|
|
and return (DENYSOFT,
|
|
($sender->host
|
|
? "Could not resolve ". $sender->host
|
|
: "FQDN required in the envelope sender"));
|
|
|
|
return DECLINED;
|
|
|
|
}
|
|
|
|
sub check_dns {
|
|
my ($self, $host) = @_;
|
|
|
|
# for stuff where we can't even parse a hostname out of the address
|
|
return 0 unless $host;
|
|
|
|
return 1 if $host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/;
|
|
|
|
my $res = new Net::DNS::Resolver;
|
|
$res->tcp_timeout(30);
|
|
$res->udp_timeout(30);
|
|
my @mx = mx($res, $host);
|
|
foreach my $mx (@mx) {
|
|
return mx_valid($self, $mx->exchange, $host);
|
|
}
|
|
my $query = $res->search($host);
|
|
if ($query) {
|
|
foreach my $rr ($query->answer) {
|
|
if ($rr->type eq "A") {
|
|
return is_valid($rr->address);
|
|
}
|
|
elsif ($rr->type eq "MX") {
|
|
return mx_valid($self, $rr->exchange, $host);
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$self->log(LOGWARN, "$$ query for $host failed: ", $res->errorstring)
|
|
unless $res->errorstring eq "NXDOMAIN";
|
|
}
|
|
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
|