byterazor/qpsmtpd
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

check dns of sending host

Browse Source 
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
1 changed files with 26 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
qpsmtpd
View File

@ -135,6 +135,11 @@ sub mail {
if check_rhsbl($rhsbl, $host); 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; #warn "$$ getting mail from ",$from->format,"\n" if $TRACE;
respond(250, $from->format . ", sender OK - I always like getting mail from you!"); 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]; $rcpt = (Mail::Address->parse($rcpt))[0];
return respond(501, "could not parse recipient") unless $rcpt; 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, "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; push @{$state{transaction}->{rcpt}}, $rcpt;
respond(250, $rcpt->format . ", recipient OK"); respond(250, $rcpt->format . ", recipient OK");
} }
@ -203,8 +209,8 @@ sub data {
# Parent # Parent
close MESSAGE_READER or fault("close msg reader fault"),exit; close MESSAGE_READER or fault("close msg reader fault"),exit;
close ENVELOPE_READER or fault("close envelope 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 "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\r\n"; print MESSAGE_WRITER " by $config{me} (qpsmtpd/$QPsmtpd::VERSION) with SMTP; ", scalar gmtime, " -0000\n";
print MESSAGE_WRITER $buffer; print MESSAGE_WRITER $buffer;
close MESSAGE_WRITER; close MESSAGE_WRITER;
@ -296,6 +302,24 @@ sub check_dnsbl {
return ""; 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 { sub check_relay {
my $host = lc shift; my $host = lc shift;