qpsmtpd/plugins/require_resolvable_fromhost

142 lines
3.7 KiB
Plaintext
Raw Normal View History

use Qpsmtpd::DSN;
use Net::DNS qw(mx);
use Socket;
use Net::IP qw(:PROC);
use Qpsmtpd::TcpServer;
my %invalid = ();
my $has_ipv6 = Qpsmtpd::TcpServer::has_ipv6();
sub hook_mail {
my ($self, $transaction, $sender, %param) = @_;
Changes by jpeacock@cpan.org (John Peacock) o plugins/check_badmailfromto - New plugin in the style of check_badmailfrom, which matches a pair of FROM/TO and makes it seem like the recipient's address no longer exists (but only from the matching sender's point of view). Useful for stalkers and other harassment cases. o plugins/dns_whitelist_soft - New plugin to provide a DNS-based whitelist (good for distributed sites). o various files - Replaced tab character with 8 spaces and adjusted line breaks for better readability. Changes by mct@toren.net (Michael C. Toren) o lib/Qpsmtpd/SMTP.pm - Assumes a MAIL FROM value of "<#@[]>" (utilized by qmail to indicate a null sender when generating a doublebounce message) is equivalent to "<>". Previously qpsmtpd complained that the value could not be parsed. - Adds LOGIN to the default list of supported auth mechanisms. The documentation in Auth.pm indicated that auth-login was not currently supported due to lack of functionality, however I can confirm that LOGIN appears to work fine as tested by using msmtp (http://msmtp.sourceforge.net/). Are there any indications that LOGIN support is actually broken in the current implementation? - Removes the "X-Qpsmtpd-Auth: True" header appended when a message has been sent by an authenticated user. One problem with such a header is that it's impossible to say which SMTP hop added it, and it provides no information which could be used to backtrack the transaction. I grepped through my mail archives a bit looking for how other MTAs handled the problem, and decided it would be best to place this information in the Received: header: Received: from remotehost (HELO remotehost) (192.168.42.42) (smtp-auth username foo, mechanism cram-md5) by mail.netisland.net (qpsmtpd/0.28) with ESMTP; <date> o lib/Qpsmtpd/Auth.pm: - Documentation update for the arguments passed to an auth handler; previously the $mechanism argument was not mentioned, which threw off the argument offsets. - Documentation update for auth-login removing the warning that auth-login is not currently supported due to lack of functionality. - Fix to execute a generic auth hook when a more specific auth-$mechanism hook does not exist. (Previously posted to the list last week.) - Upon authentication, sets $session->{_auth_user} and $session->{_auth_mechanism} so that SMTP.pm can include them in the Received: header. o plugins/queue/qmail-queue - Added a timestamp and the qmail-queue qp identifier to the "Queued!" 250 message, for compatibility with qmail-smtpd, which can be very useful for tracking message delivery from machine to machine. For example, the new 250 message might be: 250 Queued! 1105927468 qp 3210 <1105927457@netisland.net> qmail-smtpd returns: 250 ok 1106546213 qp 7129 Additionally, for consistency angle brackets are placed around the Message-ID displayed in the 250 if they were missing in the message header. o plugins/check_badmailfrom: - Changed the error message from "Mail from $bad not accepted here" to "sorry, your envelope sender is in my badmailfrom list", for compatibility with qmail-smtpd. I didn't see any reason to share with the sender the value of $bad, especially for situations where the sender was rejected resulting from a wildcard. o plugins/check_earlytalker: o plugins/require_resolvable_fromhost: - No longer checks for earlytalkers or resolvable senders if the connection note "whitelistclient" is set, which is nice for helping backup MX hosts empty their queue faster. o plugins/count_unrecognized_commands: - Return code changed from DENY_DISCONNECT, which isn't valid in an unrecognized_command hook, to DENY, which in this context drops the connection anyway. (Previously posted to the list last week.) git-svn-id: https://svn.perl.org/qpsmtpd/trunk@356 958fd67b-6ff1-0310-b445-bb7760255be9
2005-01-28 04:30:50 +01:00
return DECLINED
if ($self->qp->connection->notes('whitelisthost'));
Changes by jpeacock@cpan.org (John Peacock) o plugins/check_badmailfromto - New plugin in the style of check_badmailfrom, which matches a pair of FROM/TO and makes it seem like the recipient's address no longer exists (but only from the matching sender's point of view). Useful for stalkers and other harassment cases. o plugins/dns_whitelist_soft - New plugin to provide a DNS-based whitelist (good for distributed sites). o various files - Replaced tab character with 8 spaces and adjusted line breaks for better readability. Changes by mct@toren.net (Michael C. Toren) o lib/Qpsmtpd/SMTP.pm - Assumes a MAIL FROM value of "<#@[]>" (utilized by qmail to indicate a null sender when generating a doublebounce message) is equivalent to "<>". Previously qpsmtpd complained that the value could not be parsed. - Adds LOGIN to the default list of supported auth mechanisms. The documentation in Auth.pm indicated that auth-login was not currently supported due to lack of functionality, however I can confirm that LOGIN appears to work fine as tested by using msmtp (http://msmtp.sourceforge.net/). Are there any indications that LOGIN support is actually broken in the current implementation? - Removes the "X-Qpsmtpd-Auth: True" header appended when a message has been sent by an authenticated user. One problem with such a header is that it's impossible to say which SMTP hop added it, and it provides no information which could be used to backtrack the transaction. I grepped through my mail archives a bit looking for how other MTAs handled the problem, and decided it would be best to place this information in the Received: header: Received: from remotehost (HELO remotehost) (192.168.42.42) (smtp-auth username foo, mechanism cram-md5) by mail.netisland.net (qpsmtpd/0.28) with ESMTP; <date> o lib/Qpsmtpd/Auth.pm: - Documentation update for the arguments passed to an auth handler; previously the $mechanism argument was not mentioned, which threw off the argument offsets. - Documentation update for auth-login removing the warning that auth-login is not currently supported due to lack of functionality. - Fix to execute a generic auth hook when a more specific auth-$mechanism hook does not exist. (Previously posted to the list last week.) - Upon authentication, sets $session->{_auth_user} and $session->{_auth_mechanism} so that SMTP.pm can include them in the Received: header. o plugins/queue/qmail-queue - Added a timestamp and the qmail-queue qp identifier to the "Queued!" 250 message, for compatibility with qmail-smtpd, which can be very useful for tracking message delivery from machine to machine. For example, the new 250 message might be: 250 Queued! 1105927468 qp 3210 <1105927457@netisland.net> qmail-smtpd returns: 250 ok 1106546213 qp 7129 Additionally, for consistency angle brackets are placed around the Message-ID displayed in the 250 if they were missing in the message header. o plugins/check_badmailfrom: - Changed the error message from "Mail from $bad not accepted here" to "sorry, your envelope sender is in my badmailfrom list", for compatibility with qmail-smtpd. I didn't see any reason to share with the sender the value of $bad, especially for situations where the sender was rejected resulting from a wildcard. o plugins/check_earlytalker: o plugins/require_resolvable_fromhost: - No longer checks for earlytalkers or resolvable senders if the connection note "whitelistclient" is set, which is nice for helping backup MX hosts empty their queue faster. o plugins/count_unrecognized_commands: - Return code changed from DENY_DISCONNECT, which isn't valid in an unrecognized_command hook, to DENY, which in this context drops the connection anyway. (Previously posted to the list last week.) git-svn-id: https://svn.perl.org/qpsmtpd/trunk@356 958fd67b-6ff1-0310-b445-bb7760255be9
2005-01-28 04:30:50 +01:00
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;
}
}
if ($sender ne "<>"
and $self->qp->config("require_resolvable_fromhost")
and !$self->check_dns($sender->host)) {
if ($sender->host) {
# default of temp_resolver_failed is DENYSOFT
return Qpsmtpd::DSN->temp_resolver_failed("Could not resolve " . $sender->host);
}
else {
# default of addr_bad_from_system is DENY, we use DENYSOFT here to
# get the same behaviour as without Qpsmtpd::DSN...
return Qpsmtpd::DSN->addr_bad_from_system(DENYSOFT,
"FQDN required in the envelope sender");
}
}
return DECLINED;
}
sub check_dns {
my ($self, $host) = @_;
my @host_answers;
# 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) {
# if any MX is valid, then we consider the domain
# resolvable
return 1 if mx_valid($self, $mx->exchange, $host);
}
# if there are MX records, and we got here,
# then none of them are valid
return 0 if (@mx > 0);
my $query = $res->search($host);
if ($query) {
foreach my $rrA ($query->answer) {
push(@host_answers, $rrA);
}
}
if ($has_ipv6) {
my $query = $res->search($host, 'AAAA');
if ($query) {
foreach my $rrAAAA ($query->answer) {
push(@host_answers, $rrAAAA);
}
}
}
if (@host_answers) {
foreach my $rr (@host_answers) {
return is_valid($rr->address) if $rr->type eq "A" or $rr->type eq "AAAA";
return mx_valid($self, $rr->exchange, $host) if $rr->type eq "MX";
}
}
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;
# IP in MX
return is_valid($name) if ip_is_ipv4($name) or ip_is_ipv6($name);
my @mx_answers;
my $query = $res->search($name, 'A');
if ($query) {
foreach my $rrA ($query->answer) {
push(@mx_answers, $rrA);
}
}
if ($has_ipv6) {
my $query = $res->search($name, 'AAAA');
if ($query) {
foreach my $rrAAAA ($query->answer) {
push(@mx_answers, $rrAAAA);
}
}
}
if (@mx_answers) {
foreach my $rr (@mx_answers) {
next unless $rr->type eq "A" or $rr->type eq "AAAA";
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