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
This commit is contained in:
John Peacock
parent
ed2ab5f5fd
commit
c840a1d04f
32
Changes
32
Changes
@ -1,6 +1,38 @@
|
||||
|
||||
0.29 -
|
||||
|
||||
Qpsmtpd::Auth - document $mechanism option, improve fallback to generic
|
||||
hooks, document that auth-login works now, stash auth user and method for
|
||||
later use by Qpsmtpd::SMTP to generate authentication header.
|
||||
(Michael Toren)
|
||||
|
||||
Qpsmtpd::SMTP - "MAIL FROM: <#@[]>" now works like qmail (null sender),
|
||||
add LOGIN to default auth mechanisms, display auth user and method in
|
||||
Received: line instead of X-Qpsmtpd-Auth header.
|
||||
(Michael Toren)
|
||||
|
||||
check_badmailfromto - NEW PLUGIN - like check_badmailfrom except matches
|
||||
both FROM: and TO:, and effectively makes it seem like the recipient
|
||||
no longer exists for that sender (great for harassment cases).
|
||||
(John Peacock)
|
||||
|
||||
check_earlytalker and require_resolvable_fromhost - short circuit test if
|
||||
whitelistclient is set. (Michael Toren)
|
||||
|
||||
check_badmailfrom - Do not say why a given message is denied.
|
||||
(Michael Toren)
|
||||
|
||||
dns_whitelist_soft - NEW PLUGIN - dns-based whitelist override for
|
||||
other qpsmtpd plugins. Add suuport for whitelisthost to dnsbl.
|
||||
(John Peacock)
|
||||
|
||||
auth/auth_vpopmail_sql - Support CRAM-MD5 (requires clear_passwd)
|
||||
(John Peacock)
|
||||
|
||||
plugins/queue/qmail-queue - Added a timestamp and the qmail-queue qp
|
||||
identifier to the "Queued!" message, for compatibility with qmail-smtpd
|
||||
(Michael Toren)
|
||||
|
||||
Support qmail-smtpd's timeoutsmtpd config file
|
||||
|
||||
Many improvements to the forking server (qpsmtpd-forkserver)
|
||||
|
||||
@ -64,6 +64,11 @@ entries or to send responses to the remote SMTP client.
|
||||
A Qpsmtpd::Transaction object which can be used to examine information
|
||||
about the current SMTP session like the remote IP address.
|
||||
|
||||
=item $mechanism
|
||||
|
||||
The lower-case name of the authentication mechanism requested by the
|
||||
client; either "plain", "login", or "cram-md5".
|
||||
|
||||
=item $user
|
||||
|
||||
Whatever the remote SMTP client sent to identify the user (may be bare
|
||||
@ -157,7 +162,6 @@ A slightly more secure method where the username and password are Base-64
|
||||
encoded before sending. This is still an insecure method, since it is
|
||||
trivial to decode the Base-64 data. Again, it will not normally be chosen
|
||||
by SMTP clients unless a more secure method is not available (or if it fails).
|
||||
CURRENTLY NOT SUPPORTED DUE TO LACK OF DOCUMENTATION ON FUNCTIONALITY
|
||||
|
||||
=item * auth-cram-md5
|
||||
|
||||
@ -309,23 +313,28 @@ sub SASL {
|
||||
$passHash, $ticket );
|
||||
|
||||
# try running the polymorphous hooks next
|
||||
if ( $rc == DECLINED ) {
|
||||
if ( !$rc || $rc == DECLINED ) {
|
||||
( $rc, $msg ) =
|
||||
$session->run_hooks( "auth", $mechanism, $user, $passClear, $passHash,
|
||||
$ticket );
|
||||
$session->run_hooks( "auth", $mechanism, $user, $passClear,
|
||||
$passHash, $ticket );
|
||||
}
|
||||
|
||||
if ( $rc == OK ) {
|
||||
$msg = "Authentication successful for $user" .
|
||||
( defined $msg ? " - " . $msg : "" );
|
||||
( defined $msg ? " - " . $msg : "" );
|
||||
$session->respond( 235, $msg );
|
||||
$session->connection->relay_client(1);
|
||||
$session->log( LOGINFO, $msg );
|
||||
|
||||
$session->{_auth_user} = $user;
|
||||
$session->{_auth_mechanism} = $mechanism;
|
||||
s/[\r\n].*//s for ($session->{_auth_user}, $session->{_auth_mechanism});
|
||||
|
||||
return OK;
|
||||
}
|
||||
else {
|
||||
$msg = "Authentication failed for $user" .
|
||||
( defined $msg ? " - " . $msg : "" );
|
||||
( defined $msg ? " - " . $msg : "" );
|
||||
$session->respond( 535, $msg );
|
||||
$session->log( LOGERROR, $msg );
|
||||
return DENY;
|
||||
|
||||
@ -35,6 +35,7 @@ sub new {
|
||||
my (%commands); @commands{@commands} = ('') x @commands;
|
||||
# this list of valid commands should probably be a method or a set of methods
|
||||
$self->{_commands} = \%commands;
|
||||
|
||||
$self;
|
||||
}
|
||||
|
||||
@ -104,7 +105,7 @@ sub start_conversation {
|
||||
}
|
||||
elsif ($rc != DONE) {
|
||||
$self->respond(220, $self->config('me') ." ESMTP qpsmtpd "
|
||||
. $self->version ." ready; send us your mail, but not your spam.");
|
||||
. $self->version ." ready; send us your mail, but not your spam.");
|
||||
return DONE;
|
||||
}
|
||||
}
|
||||
@ -166,7 +167,7 @@ sub ehlo {
|
||||
|
||||
my @capabilities = $self->transaction->notes('capabilities')
|
||||
? @{ $self->transaction->notes('capabilities') }
|
||||
: ();
|
||||
: ();
|
||||
|
||||
# Check for possible AUTH mechanisms
|
||||
my %auth_mechanisms;
|
||||
@ -176,7 +177,7 @@ HOOK: foreach my $hook ( keys %{$self->{hooks}} ) {
|
||||
$auth_mechanisms{uc($1)} = 1;
|
||||
}
|
||||
else { # at least one polymorphous auth provider
|
||||
%auth_mechanisms = map {$_,1} qw(PLAIN CRAM-MD5);
|
||||
%auth_mechanisms = map {$_,1} qw(PLAIN CRAM-MD5 LOGIN);
|
||||
last HOOK;
|
||||
}
|
||||
}
|
||||
@ -188,12 +189,12 @@ HOOK: foreach my $hook ( keys %{$self->{hooks}} ) {
|
||||
}
|
||||
|
||||
$self->respond(250,
|
||||
$self->config("me") . " Hi " . $conn->remote_info . " [" . $conn->remote_ip ."]",
|
||||
"PIPELINING",
|
||||
"8BITMIME",
|
||||
($self->config('databytes') ? "SIZE ". ($self->config('databytes'))[0] : ()),
|
||||
@capabilities,
|
||||
);
|
||||
$self->config("me") . " Hi " . $conn->remote_info . " [" . $conn->remote_ip ."]",
|
||||
"PIPELINING",
|
||||
"8BITMIME",
|
||||
($self->config('databytes') ? "SIZE ". ($self->config('databytes'))[0] : ()),
|
||||
@capabilities,
|
||||
);
|
||||
}
|
||||
}
|
||||
|
||||
@ -236,7 +237,7 @@ sub mail {
|
||||
|
||||
$self->log(LOGWARN, "from email address : [$from]");
|
||||
|
||||
if ($from eq "<>" or $from =~ m/\[undefined\]/) {
|
||||
if ($from eq "<>" or $from =~ m/\[undefined\]/ or $from eq "<#@[]>") {
|
||||
$from = Qpsmtpd::Address->new("<>");
|
||||
}
|
||||
else {
|
||||
@ -329,9 +330,9 @@ sub rcpt {
|
||||
sub help {
|
||||
my $self = shift;
|
||||
$self->respond(214,
|
||||
"This is qpsmtpd " . $self->version,
|
||||
"See http://smtpd.develooper.com/",
|
||||
'To report bugs or send comments, mail to <ask@develooper.com>.');
|
||||
"This is qpsmtpd " . $self->version,
|
||||
"See http://smtpd.develooper.com/",
|
||||
'To report bugs or send comments, mail to <ask@develooper.com>.');
|
||||
}
|
||||
|
||||
sub noop {
|
||||
@ -443,39 +444,39 @@ sub data {
|
||||
# lot of spam that is malformed in the header.
|
||||
|
||||
($_ eq ".\n" or $_ eq ".\r")
|
||||
and $self->respond(421, "See http://smtpd.develooper.com/barelf.html")
|
||||
and return $self->disconnect;
|
||||
and $self->respond(421, "See http://smtpd.develooper.com/barelf.html")
|
||||
and return $self->disconnect;
|
||||
|
||||
# add a transaction->blocked check back here when we have line by line plugin access...
|
||||
unless (($max_size and $size > $max_size)) {
|
||||
s/\r\n$/\n/;
|
||||
s/^\.\./\./;
|
||||
if ($in_header and m/^\s*$/) {
|
||||
$in_header = 0;
|
||||
my @headers = split /^/m, $buffer;
|
||||
$in_header = 0;
|
||||
my @headers = split /^/m, $buffer;
|
||||
|
||||
# ... need to check that we don't reformat any of the received lines.
|
||||
#
|
||||
# 3.8.2 Received Lines in Gatewaying
|
||||
# When forwarding a message into or out of the Internet environment, a
|
||||
# gateway MUST prepend a Received: line, but it MUST NOT alter in any
|
||||
# way a Received: line that is already in the header.
|
||||
# ... need to check that we don't reformat any of the received lines.
|
||||
#
|
||||
# 3.8.2 Received Lines in Gatewaying
|
||||
# When forwarding a message into or out of the Internet environment, a
|
||||
# gateway MUST prepend a Received: line, but it MUST NOT alter in any
|
||||
# way a Received: line that is already in the header.
|
||||
|
||||
$header->extract(\@headers);
|
||||
#$header->add("X-SMTPD", "qpsmtpd/".$self->version.", http://smtpd.develooper.com/");
|
||||
$header->extract(\@headers);
|
||||
#$header->add("X-SMTPD", "qpsmtpd/".$self->version.", http://smtpd.develooper.com/");
|
||||
|
||||
$buffer = "";
|
||||
$buffer = "";
|
||||
|
||||
# FIXME - call plugins to work on just the header here; can
|
||||
# save us buffering the mail content.
|
||||
# FIXME - call plugins to work on just the header here; can
|
||||
# save us buffering the mail content.
|
||||
|
||||
}
|
||||
|
||||
if ($in_header) {
|
||||
$buffer .= $_;
|
||||
$buffer .= $_;
|
||||
}
|
||||
else {
|
||||
$self->transaction->body_write($_);
|
||||
$self->transaction->body_write($_);
|
||||
}
|
||||
|
||||
$size += length $_;
|
||||
@ -488,15 +489,12 @@ sub data {
|
||||
$self->transaction->header($header);
|
||||
|
||||
my $smtp = $self->connection->hello eq "ehlo" ? "ESMTP" : "SMTP";
|
||||
|
||||
# only true if client authenticated
|
||||
if ( defined $self->{_auth} and $self->{_auth} == OK ) {
|
||||
$header->add("X-Qpsmtpd-Auth","True");
|
||||
}
|
||||
my $authheader = (defined $self->{_auth} and $self->{_auth} == OK) ?
|
||||
"(smtp-auth username $self->{_auth_user}, mechanism $self->{_auth_mechanism})\n" : "";
|
||||
|
||||
$header->add("Received", "from ".$self->connection->remote_info
|
||||
." (HELO ".$self->connection->hello_host . ") (".$self->connection->remote_ip
|
||||
. ")\n by ".$self->config('me')." (qpsmtpd/".$self->version
|
||||
. ")\n $authheader by ".$self->config('me')." (qpsmtpd/".$self->version
|
||||
.") with $smtp; ". (strftime('%a, %d %b %Y %H:%M:%S %z', localtime)),
|
||||
0);
|
||||
|
||||
|
||||
@ -9,9 +9,9 @@ auth_vpopmail_sql - Authenticate to vpopmail via MySQL
|
||||
This plugin authenticates vpopmail users directly against a standard
|
||||
vpopmail MySQL database. It makes the not-unreasonable assumption that
|
||||
both pw_name and pw_domain are lowercase only (qmail doesn't actually care).
|
||||
It also requires that vpopmail be built with the recommended
|
||||
'--enable-clear-passwd=y' option, because there is no other way to compare
|
||||
the password with CRAM-MD5.
|
||||
If you are using CRAM-MD5, it also requires that vpopmail be built with the
|
||||
recommended '--enable-clear-passwd=y' option, because there is no way
|
||||
to compare the crypted password.
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
@ -50,9 +50,9 @@ Please see the LICENSE file included with qpsmtpd for details.
|
||||
sub register {
|
||||
my ( $self, $qp ) = @_;
|
||||
|
||||
$self->register_hook( "auth-plain", "authsql" );
|
||||
|
||||
# $self->register_hook("auth-cram-md5", "authsql");
|
||||
$self->register_hook("auth-plain", "authsql" );
|
||||
$self->register_hook("auth-login", "authsql" );
|
||||
$self->register_hook("auth-cram-md5", "authsql");
|
||||
|
||||
}
|
||||
|
||||
@ -82,31 +82,37 @@ sub authsql {
|
||||
"Authentication to vpopmail via mysql: $pw_name\@$pw_domain");
|
||||
|
||||
my $sth = $dbh->prepare(<<SQL);
|
||||
select pw_clear_passwd
|
||||
select pw_passwd, pw_clear_passwd
|
||||
from vpopmail
|
||||
where pw_name = ? and pw_domain = ?
|
||||
SQL
|
||||
|
||||
$sth->execute( $pw_name, $pw_domain );
|
||||
|
||||
my ($pw_clear_passwd) = $sth->fetchrow_array;
|
||||
my ($pw_passwd, $pw_clear_passwd) = $sth->fetchrow_array;
|
||||
|
||||
$sth->finish;
|
||||
$dbh->disconnect;
|
||||
|
||||
unless ( defined $pw_clear_passwd ) {
|
||||
|
||||
# if this isn't defined then the user doesn't exist here
|
||||
# or the administrator forgot to build with --enable-clear-passwd=y
|
||||
if ( # clear_passwd isn't defined so we cannot support CRAM-MD5
|
||||
( $method =~ /CRAM-MD5/i and not defined $pw_clear_passwd )
|
||||
or
|
||||
# user doesn't exist in this domain
|
||||
( not defined $pw_passwd )
|
||||
) {
|
||||
return ( DECLINED, "authsql/$method" );
|
||||
}
|
||||
|
||||
# at this point we can assume the user name matched
|
||||
if (
|
||||
( defined $passClear
|
||||
and $pw_clear_passwd eq $passClear ) or
|
||||
( defined $passHash
|
||||
and $passHash eq hmac_md5_hex( $ticket, $pw_clear_passwd ) )
|
||||
( defined $passClear and
|
||||
(
|
||||
($pw_clear_passwd eq $passClear)
|
||||
or ($pw_passwd eq crypt( $passClear, $pw_passwd ) )
|
||||
)
|
||||
)
|
||||
or ( defined $passHash
|
||||
and $passHash eq hmac_md5_hex( $ticket, $pw_clear_passwd ) )
|
||||
)
|
||||
{
|
||||
|
||||
|
||||
@ -33,7 +33,7 @@ sub mail_handler {
|
||||
or return (DECLINED);
|
||||
|
||||
return (DECLINED) unless ($sender->format ne "<>"
|
||||
and $sender->host && $sender->user);
|
||||
and $sender->host && $sender->user);
|
||||
|
||||
my $host = lc $sender->host;
|
||||
my $from = lc($sender->user) . '@' . $host;
|
||||
@ -43,7 +43,7 @@ sub mail_handler {
|
||||
next unless $bad;
|
||||
$bad = lc $bad;
|
||||
warn "Bad badmailfrom config: No \@ sign in $bad\n" and next unless $bad =~ m/\@/;
|
||||
$transaction->notes('badmailfrom', "Mail from $bad not accepted here")
|
||||
$transaction->notes('badmailfrom', "sorry, your envelope sender is in my badmailfrom list")
|
||||
if ($bad eq $from) || (substr($bad,0,1) eq '@' && $bad eq "\@$host");
|
||||
}
|
||||
return (DECLINED);
|
||||
|
||||
64
plugins/check_badmailfromto
Normal file
64
plugins/check_badmailfromto
Normal file
@ -0,0 +1,64 @@
|
||||
#! perl
|
||||
=head1 NAME
|
||||
|
||||
check_badmailfromto - checks the badmailfromto config
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Much like the similar check_badmailfrom, this plugin references both the
|
||||
FROM: and TO: lines, and if they both are present in the badmailfromto
|
||||
config file (a tab delimited list of FROM/TO pairs), then the message is
|
||||
blocked as if the recipient (TO) didn't exist. This is specifically designed
|
||||
to not give the impression that the sender is blocked (good for cases of
|
||||
harassment).
|
||||
|
||||
Based heavily on check_badmailfrom.
|
||||
|
||||
=cut
|
||||
|
||||
sub register {
|
||||
my ($self, $qp) = @_;
|
||||
$self->register_hook("mail", "mail_handler");
|
||||
$self->register_hook("rcpt", "rcpt_handler");
|
||||
}
|
||||
|
||||
sub mail_handler {
|
||||
my ($self, $transaction, $sender) = @_;
|
||||
|
||||
my @badmailfromto = $self->qp->config("badmailfromto")
|
||||
or return (DECLINED);
|
||||
|
||||
return (DECLINED) unless ($sender->format ne "<>"
|
||||
and $sender->host && $sender->user);
|
||||
|
||||
my $host = lc $sender->host;
|
||||
my $from = lc($sender->user) . '@' . $host;
|
||||
|
||||
for my $bad (@badmailfromto) {
|
||||
$bad =~ s/^\s*(\S+).*/$1/;
|
||||
next unless $bad;
|
||||
$bad = lc $bad;
|
||||
warn "Bad badmailfromto config: No \@ sign in $bad\n" and next unless $bad =~ m/\@/;
|
||||
$transaction->notes('badmailfromto', "$bad")
|
||||
if ($bad eq $from)
|
||||
|| (substr($bad,0,1) eq '@' && $bad eq "\@$host");
|
||||
}
|
||||
return (DECLINED);
|
||||
}
|
||||
|
||||
sub rcpt_handler {
|
||||
my ($self, $transaction, $rcpt) = @_;
|
||||
my $recipient = lc($rcpt->user) . '@' . lc($rcpt->host);
|
||||
my $sender = $transaction->notes('badmailfromto');
|
||||
if ($sender) {
|
||||
my @badmailfromto = $self->qp->config("badmailfromto")
|
||||
or return (DECLINED);
|
||||
|
||||
foreach (@badmailfromto) {
|
||||
my ($from, $to) = m/^\s*(\S+)\t(\S+).*/;
|
||||
return (DENY, "mail to $recipient not accepted here")
|
||||
if lc($from) eq $sender and lc($to) eq $recipient;
|
||||
}
|
||||
}
|
||||
return (DECLINED);
|
||||
}
|
||||
@ -53,14 +53,14 @@ sub register {
|
||||
my ($self, $qp, @args) = @_;
|
||||
|
||||
if (@args % 2) {
|
||||
$self->log(LOGERROR, "Unrecognized/mismatched arguments");
|
||||
return undef;
|
||||
$self->log(LOGERROR, "Unrecognized/mismatched arguments");
|
||||
return undef;
|
||||
}
|
||||
$self->{_args} = {
|
||||
'wait' => 1,
|
||||
'action' => 'denysoft',
|
||||
'defer-reject' => 0,
|
||||
@args,
|
||||
'wait' => 1,
|
||||
'action' => 'denysoft',
|
||||
'defer-reject' => 0,
|
||||
@args,
|
||||
};
|
||||
$self->register_hook('connect', 'connect_handler');
|
||||
$self->register_hook('mail', 'mail_handler')
|
||||
@ -71,12 +71,16 @@ sub register {
|
||||
sub connect_handler {
|
||||
my ($self, $transaction) = @_;
|
||||
my $in = new IO::Select;
|
||||
my $ip = $self->qp->connection->remote_ip;
|
||||
|
||||
return DECLINED
|
||||
if ($self->qp->connection->notes('whitelistclient'));
|
||||
|
||||
$in->add(\*STDIN) || return DECLINED;
|
||||
if ($in->can_read($self->{_args}->{'wait'})) {
|
||||
$self->log(LOGNOTICE, 'remote host started talking before we said hello');
|
||||
$self->log(LOGNOTICE, "remote host started talking before we said hello [$ip]");
|
||||
if ($self->{_args}->{'defer-reject'}) {
|
||||
$self->qp->connection->notes('earlytalker', 1);
|
||||
$self->qp->connection->notes('earlytalker', 1);
|
||||
} else {
|
||||
my $msg = 'Connecting host started transmitting before SMTP greeting';
|
||||
return (DENY,$msg) if $self->{_args}->{'action'} eq 'deny';
|
||||
|
||||
@ -36,13 +36,13 @@ sub check_unrec_cmd {
|
||||
$self->log(LOGINFO, "Unrecognized command '$cmd'");
|
||||
|
||||
my $badcmdcount =
|
||||
$self->qp->connection->notes('unrec_cmd_count',
|
||||
($self->qp->connection->notes('unrec_cmd_count') || 0) + 1
|
||||
);
|
||||
$self->qp->connection->notes( 'unrec_cmd_count',
|
||||
($self->qp->connection->notes('unrec_cmd_count') || 0) + 1
|
||||
);
|
||||
|
||||
if ($badcmdcount >= $self->{_unrec_cmd_max}) {
|
||||
$self->log(LOGINFO, "Closing connection. Too many unrecognized commands.");
|
||||
return (DENY_DISCONNECT, "Closing connection. $badcmdcount unrecognized commands. Perhaps you should read RFC 2821?");
|
||||
return (DENY, "Closing connection. $badcmdcount unrecognized commands. Perhaps you should read RFC 2821?");
|
||||
}
|
||||
|
||||
return DECLINED;
|
||||
|
||||
167
plugins/dns_whitelist_soft
Normal file
167
plugins/dns_whitelist_soft
Normal file
@ -0,0 +1,167 @@
|
||||
=head1 NAME
|
||||
|
||||
dns_whitelist_soft - dns-based whitelist override for other qpsmtpd plugins
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The dns_whitelist_soft plugin allows selected host to be whitelisted as
|
||||
exceptions to later plugin processing. It is strongly based on the original
|
||||
dnsbl plugin as well as Gavin Carr's original whitelist_soft plugin. It is
|
||||
most suitable for multisite installations, so that the whitelist is stored
|
||||
in one location and available from all.
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
To enable the plugin, add it to the ~qpsmtpd/config/plugins file as usual.
|
||||
It should precede any plugins whose rejections you wish to override. You may
|
||||
have to alter those plugins to check the appropriate notes field.
|
||||
|
||||
Several configuration files are supported, corresponding to different
|
||||
parts of the SMTP conversation:
|
||||
|
||||
=over 4
|
||||
|
||||
=item whitelist_zones
|
||||
|
||||
Any IP address listed in the whitelist_zones file is queried using
|
||||
the connecting MTA's IP address. Any A or TXT answer is means that the
|
||||
remote HOST address can be selectively exempted at other stages by plugins
|
||||
testing for a 'whitelisthost' connection note.
|
||||
|
||||
NOTE: other 'connect' hooks will continue to fire (e.g. dnsbl), since the DNS
|
||||
queries happen in the background. This plugin's 'rcpt_handler' retrieves
|
||||
the results of the query and sets the connection note if found.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
John Peacock <jpeacock@rowman.com>
|
||||
|
||||
Based on the 'whitelist_soft' plugin by Gavin Carr <gavin@openfusion.com.au>,
|
||||
based on the 'whitelist' plugin by Devin Carraway <qpsmtpd@devin.com>.
|
||||
|
||||
=cut
|
||||
|
||||
sub register {
|
||||
my ($self, $qp) = @_;
|
||||
|
||||
$self->register_hook("connect", "connect_handler");
|
||||
$self->register_hook("rcpt", "rcpt_handler");
|
||||
}
|
||||
|
||||
sub connect_handler {
|
||||
my ($self, $transaction) = @_;
|
||||
|
||||
my $remote_ip = $self->qp->connection->remote_ip;
|
||||
|
||||
my %whitelist_zones = map { (split /\s+/, $_, 2)[0,1] }
|
||||
$self->qp->config('whitelist_zones');
|
||||
|
||||
return DECLINED unless %whitelist_zones;
|
||||
|
||||
my $reversed_ip = join(".", reverse(split(/\./, $remote_ip)));
|
||||
|
||||
# we queue these lookups in the background and just fetch the
|
||||
# results in the first rcpt handler
|
||||
|
||||
my $res = new Net::DNS::Resolver;
|
||||
my $sel = IO::Select->new();
|
||||
|
||||
for my $dnsbl (keys %whitelist_zones) {
|
||||
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl in the background");
|
||||
$sel->add($res->bgsend("$reversed_ip.$dnsbl", "TXT"));
|
||||
}
|
||||
|
||||
$self->qp->connection->notes('whitelist_sockets', $sel);
|
||||
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
sub process_sockets {
|
||||
my ($self) = @_;
|
||||
|
||||
my $conn = $self->qp->connection;
|
||||
|
||||
return $conn->notes('whitelisthost')
|
||||
if $conn->notes('whitelisthost');
|
||||
|
||||
my $res = new Net::DNS::Resolver;
|
||||
my $sel = $conn->notes('whitelist_sockets') or return "";
|
||||
|
||||
my $result;
|
||||
|
||||
$self->log(LOGDEBUG, "waiting for whitelist dns");
|
||||
|
||||
# don't wait more than 4 seconds here
|
||||
my @ready = $sel->can_read(4);
|
||||
|
||||
$self->log(LOGDEBUG, "DONE waiting for whitelist dns, got ",
|
||||
scalar @ready, " answers ...") ;
|
||||
return '' unless @ready;
|
||||
|
||||
for my $socket (@ready) {
|
||||
my $query = $res->bgread($socket);
|
||||
$sel->remove($socket);
|
||||
undef $socket;
|
||||
|
||||
my $whitelist;
|
||||
|
||||
if ($query) {
|
||||
my $a_record = 0;
|
||||
foreach my $rr ($query->answer) {
|
||||
$a_record = 1 if $rr->type eq "A";
|
||||
my $name = $rr->name;
|
||||
($whitelist) = ($name =~ m/(?:\d+\.){4}(.*)/) unless $whitelist;
|
||||
$whitelist = $name unless $whitelist;
|
||||
$self->log(LOGDEBUG, "name ", $rr->name);
|
||||
next unless $rr->type eq "TXT";
|
||||
$self->log(LOGDEBUG, "got txt record");
|
||||
$result = $rr->txtdata and last;
|
||||
}
|
||||
$a_record and $result = "Blocked by $whitelist";
|
||||
}
|
||||
else {
|
||||
$self->log(LOGERROR, "$whitelist query failed: ", $res->errorstring)
|
||||
unless $res->errorstring eq "NXDOMAIN";
|
||||
}
|
||||
|
||||
if ($result) {
|
||||
#kill any other pending I/O
|
||||
$conn->notes('whitelist_sockets', undef);
|
||||
return $conn->notes('whitelisthost', $result);
|
||||
}
|
||||
}
|
||||
|
||||
if ($sel->count) {
|
||||
# loop around if we have dns blacklists left to see results from
|
||||
return $self->process_sockets();
|
||||
}
|
||||
|
||||
# er, the following code doesn't make much sense anymore...
|
||||
|
||||
# if there was more to read; then forget it
|
||||
$conn->notes('whitelist_sockets', undef);
|
||||
|
||||
return $conn->notes('whitelisthost', $result);
|
||||
|
||||
}
|
||||
|
||||
sub rcpt_handler {
|
||||
my ($self, $transaction, $rcpt) = @_;
|
||||
my $ip = $self->qp->connection->remote_ip || return (DECLINED);
|
||||
my $note = $self->process_sockets;
|
||||
if ( $note ) {
|
||||
$self->log(LOGNOTICE,"Host $ip is whitelisted: $note");
|
||||
}
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
sub disconnect_handler {
|
||||
my ($self, $transaction) = @_;
|
||||
|
||||
$self->qp->connection->notes('whitelist_sockets', undef);
|
||||
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
@ -154,8 +154,20 @@ sub rcpt_handler {
|
||||
}
|
||||
|
||||
my $note = $self->process_sockets;
|
||||
return (DENY, $note) if $note;
|
||||
my $whitelist = $self->qp->connection->notes('whitelisthost');
|
||||
if ( $note ) {
|
||||
if ( $rcpt->user =~ /^(?:postmaster|abuse|mailer-daemon|root)$/i ) {
|
||||
$self->log(2, "Don't blacklist special account: ".$rcpt->user);
|
||||
}
|
||||
elsif ( $whitelist ) {
|
||||
$self->log(2, "Whitelist overrode blacklist: $whitelist");
|
||||
}
|
||||
else {
|
||||
return (DENY, $note);
|
||||
}
|
||||
}
|
||||
return DECLINED;
|
||||
|
||||
}
|
||||
|
||||
sub disconnect_handler {
|
||||
|
||||
@ -75,7 +75,8 @@ sub queue_handler {
|
||||
|
||||
my $msg_id = $transaction->header->get('Message-Id') || '';
|
||||
$msg_id =~ s/[\r\n].*//s; # don't allow newlines in the Message-Id here
|
||||
return (OK, "Queued! $msg_id");
|
||||
$msg_id = "<$msg_id>" unless $msg_id =~ /^<.*>$/; # surround in <>'s
|
||||
return (OK, "Queued! " . time . " qp $child $msg_id");
|
||||
}
|
||||
elsif (defined $child) {
|
||||
# Child
|
||||
@ -100,7 +101,7 @@ sub queue_handler {
|
||||
POSIX::dup2(fileno(ENVELOPE_READER), 1) or die "Unable to dup ENVELOPE_READER: $!";
|
||||
|
||||
my $ppid = getppid();
|
||||
$self->log(LOGNOTICE, "(for $ppid ) Queuing to $queue_exec");
|
||||
$self->log(LOGNOTICE, "(for $ppid ) Queuing qp $$ to $queue_exec");
|
||||
|
||||
my $rc = exec $queue_exec;
|
||||
|
||||
|
||||
@ -8,13 +8,16 @@ sub register {
|
||||
sub mail_handler {
|
||||
my ($self, $transaction, $sender) = @_;
|
||||
|
||||
return DECLINED
|
||||
if ($self->qp->connection->notes('whitelistclient'));
|
||||
|
||||
$sender->format ne "<>"
|
||||
and $self->qp->config("require_resolvable_fromhost")
|
||||
and !check_dns($sender->host)
|
||||
and return (DENYSOFT,
|
||||
($sender->host
|
||||
? "Could not resolve ". $sender->host
|
||||
: "FQDN required in the envelope sender"));
|
||||
($sender->host
|
||||
? "Could not resolve ". $sender->host
|
||||
: "FQDN required in the envelope sender"));
|
||||
|
||||
return DECLINED;
|
||||
|
||||
|
||||
@ -19,11 +19,11 @@ my $command = 'MAIL FROM:<ask@perl.org> SIZE=1230';
|
||||
is(($smtpd->command($command))[0], 250, $command);
|
||||
is($smtpd->transaction->sender->format, '<ask@perl.org>', 'got the right sender');
|
||||
|
||||
$command = 'MAIL FROM:<>';
|
||||
my $command = 'MAIL FROM:<>';
|
||||
is(($smtpd->command($command))[0], 250, $command);
|
||||
is($smtpd->transaction->sender->format, '<>', 'got the right sender');
|
||||
|
||||
$command = 'MAIL FROM:<ask@p.qpsmtpd-test.askask.com> SIZE=1230';
|
||||
my $command = 'MAIL FROM:<ask@p.qpsmtpd-test.askask.com> SIZE=1230';
|
||||
is(($smtpd->command($command))[0], 250, $command);
|
||||
is($smtpd->transaction->sender->format, '<ask@p.qpsmtpd-test.askask.com>', 'got the right sender');
|
||||
|
||||
|
||||
@ -63,6 +63,15 @@ $ao = Qpsmtpd::Address->new($as);
|
||||
ok ($ao, "new $as");
|
||||
is ($ao->address, 'foo@example.com', "address $as");
|
||||
|
||||
$as = '<foo@foo.x.example.com>';
|
||||
$ao = Qpsmtpd::Address->new($as);
|
||||
ok ($ao, "new $as");
|
||||
is ($ao->format, $as, "format $as");
|
||||
|
||||
$as = 'foo@foo.x.example.com';
|
||||
ok ($ao = Qpsmtpd::Address->parse('<'.$as.'>'), "parse $as");
|
||||
is ($ao && $ao->address, $as, "address $as");
|
||||
|
||||
# Not sure why we can change the address like this, but we can so test it ...
|
||||
is ($ao && $ao->address('test@example.com'), 'test@example.com', 'address(test@example.com)');
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user