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:
Ask Bjørn Hansen 2001-10-31 00:11:29 +00:00
parent 0664a76dc3
commit a237b44602

28
qpsmtpd
View File

@ -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;