check dns of sending host
rejct mails to unicode@perl.org as no such address exists and it gets a lot of spam (needs to be moved to an external filter too). fix bug that screws up the headers. git-svn-id: https://svn.perl.org/qpsmtpd/trunk@4 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
parent
0664a76dc3
commit
a237b44602
28
qpsmtpd
28
qpsmtpd
@ -135,6 +135,11 @@ sub mail {
|
||||
if check_rhsbl($rhsbl, $host);
|
||||
}
|
||||
}
|
||||
|
||||
if ($from->format ne "<>") {
|
||||
respond(450, "Could not resolve ". $from->host),return 1 unless check_dns($from->host);
|
||||
}
|
||||
|
||||
#warn "$$ getting mail from ",$from->format,"\n" if $TRACE;
|
||||
respond(250, $from->format . ", sender OK - I always like getting mail from you!");
|
||||
|
||||
@ -150,6 +155,7 @@ sub rcpt {
|
||||
$rcpt = (Mail::Address->parse($rcpt))[0];
|
||||
return respond(501, "could not parse recipient") unless $rcpt;
|
||||
return respond(550, "will not relay for ". $rcpt->host) unless check_relay($rcpt->host);
|
||||
return respond(550, "no such mailbox") if lc $rcpt->address eq 'unicode@perl.org';
|
||||
push @{$state{transaction}->{rcpt}}, $rcpt;
|
||||
respond(250, $rcpt->format . ", recipient OK");
|
||||
}
|
||||
@ -203,8 +209,8 @@ sub data {
|
||||
# Parent
|
||||
close MESSAGE_READER or fault("close msg reader fault"),exit;
|
||||
close ENVELOPE_READER or fault("close envelope reader fault"), exit;
|
||||
print MESSAGE_WRITER "Received: from $state{remote_info} (HELO $state{hello_host}) ($state{remote_ip})\r\n";
|
||||
print MESSAGE_WRITER " by $config{me} (qpsmtpd/$QPsmtpd::VERSION) with SMTP; ", scalar gmtime, " -0000\r\n";
|
||||
print MESSAGE_WRITER "Received: from $state{remote_info} (HELO $state{hello_host}) ($state{remote_ip})\n";
|
||||
print MESSAGE_WRITER " by $config{me} (qpsmtpd/$QPsmtpd::VERSION) with SMTP; ", scalar gmtime, " -0000\n";
|
||||
print MESSAGE_WRITER $buffer;
|
||||
close MESSAGE_WRITER;
|
||||
|
||||
@ -296,6 +302,24 @@ sub check_dnsbl {
|
||||
return "";
|
||||
}
|
||||
|
||||
sub check_dns {
|
||||
my $host = shift;
|
||||
my $res = new Net::DNS::Resolver;
|
||||
return 1 if mx($res, $host);
|
||||
my $query = $res->search($host);
|
||||
if ($query) {
|
||||
foreach my $rr ($query->answer) {
|
||||
warn "rr->type ". $rr->type;
|
||||
return 1 if $rr->type eq "A" or $rr->type eq "MX";
|
||||
}
|
||||
}
|
||||
else {
|
||||
warn "$$ query for $host failed: ", $res->errorstring, "\n"
|
||||
unless $res->errorstring eq "NXDOMAIN";
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
sub check_relay {
|
||||
my $host = lc shift;
|
||||
|
Loading…
Reference in New Issue
Block a user