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

Changes by jpeacock@cpan.org (John Peacock)

Browse Source 
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 2005-01-28 03:30:50 +00:00
parent ed2ab5f5fd
commit c840a1d04f
14 changed files with 386 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
Changes
View File

@ -1,6 +1,38 @@
0.29 - 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 Support qmail-smtpd's timeoutsmtpd config file
Many improvements to the forking server (qpsmtpd-forkserver) Many improvements to the forking server (qpsmtpd-forkserver)

21
lib/Qpsmtpd/Auth.pm
View File

@ -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 A Qpsmtpd::Transaction object which can be used to examine information
about the current SMTP session like the remote IP address. 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 =item $user
Whatever the remote SMTP client sent to identify the user (may be bare 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 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 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). 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 =item * auth-cram-md5
@ -309,23 +313,28 @@ sub SASL {
$passHash, $ticket ); $passHash, $ticket );
# try running the polymorphous hooks next # try running the polymorphous hooks next
if ( $rc == DECLINED ) { if ( !$rc || $rc == DECLINED ) {
( $rc, $msg ) = ( $rc, $msg ) =
$session->run_hooks( "auth", $mechanism, $user, $passClear, $passHash, $session->run_hooks( "auth", $mechanism, $user, $passClear,
$ticket ); $passHash, $ticket );
} }
if ( $rc == OK ) { if ( $rc == OK ) {
$msg = "Authentication successful for $user" . $msg = "Authentication successful for $user" .
( defined $msg ? " - " . $msg : "" ); ( defined $msg ? " - " . $msg : "" );
$session->respond( 235, $msg ); $session->respond( 235, $msg );
$session->connection->relay_client(1); $session->connection->relay_client(1);
$session->log( LOGINFO, $msg ); $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; return OK;
} }
else { else {
$msg = "Authentication failed for $user" . $msg = "Authentication failed for $user" .
( defined $msg ? " - " . $msg : "" ); ( defined $msg ? " - " . $msg : "" );
$session->respond( 535, $msg ); $session->respond( 535, $msg );
$session->log( LOGERROR, $msg ); $session->log( LOGERROR, $msg );
return DENY; return DENY;

70
lib/Qpsmtpd/SMTP.pm
View File

@ -35,6 +35,7 @@ sub new {
my (%commands); @commands{@commands} = ('') x @commands; my (%commands); @commands{@commands} = ('') x @commands;
# this list of valid commands should probably be a method or a set of methods # this list of valid commands should probably be a method or a set of methods
$self->{_commands} = \%commands; $self->{_commands} = \%commands;
$self; $self;
} }
@ -104,7 +105,7 @@ sub start_conversation {
} }
elsif ($rc != DONE) { elsif ($rc != DONE) {
$self->respond(220, $self->config('me') ." ESMTP qpsmtpd " $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; return DONE;
} }
} }
@ -166,7 +167,7 @@ sub ehlo {
my @capabilities = $self->transaction->notes('capabilities') my @capabilities = $self->transaction->notes('capabilities')
? @{ $self->transaction->notes('capabilities') } ? @{ $self->transaction->notes('capabilities') }
: (); : ();
# Check for possible AUTH mechanisms # Check for possible AUTH mechanisms
my %auth_mechanisms; my %auth_mechanisms;
@ -176,7 +177,7 @@ HOOK: foreach my $hook ( keys %{$self->{hooks}} ) {
$auth_mechanisms{uc($1)} = 1; $auth_mechanisms{uc($1)} = 1;
} }
else { # at least one polymorphous auth provider 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; last HOOK;
} }
} }
@ -188,12 +189,12 @@ HOOK: foreach my $hook ( keys %{$self->{hooks}} ) {
} }
$self->respond(250, $self->respond(250,
$self->config("me") . " Hi " . $conn->remote_info . " [" . $conn->remote_ip ."]", $self->config("me") . " Hi " . $conn->remote_info . " [" . $conn->remote_ip ."]",
"PIPELINING", "PIPELINING",
"8BITMIME", "8BITMIME",
($self->config('databytes') ? "SIZE ". ($self->config('databytes'))[0] : ()), ($self->config('databytes') ? "SIZE ". ($self->config('databytes'))[0] : ()),
@capabilities, @capabilities,
); );
} }
} }
@ -236,7 +237,7 @@ sub mail {
$self->log(LOGWARN, "from email address : [$from]"); $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("<>"); $from = Qpsmtpd::Address->new("<>");
} }
else { else {
@ -329,9 +330,9 @@ sub rcpt {
sub help { sub help {
my $self = shift; my $self = shift;
$self->respond(214, $self->respond(214,
"This is qpsmtpd " . $self->version, "This is qpsmtpd " . $self->version,
"See http://smtpd.develooper.com/", "See http://smtpd.develooper.com/",
'To report bugs or send comments, mail to <ask@develooper.com>.'); 'To report bugs or send comments, mail to <ask@develooper.com>.');
} }
sub noop { sub noop {
@ -443,39 +444,39 @@ sub data {
# lot of spam that is malformed in the header. # lot of spam that is malformed in the header.
($_ eq ".\n" or $_ eq ".\r") ($_ eq ".\n" or $_ eq ".\r")
and $self->respond(421, "See http://smtpd.develooper.com/barelf.html") and $self->respond(421, "See http://smtpd.develooper.com/barelf.html")
and return $self->disconnect; and return $self->disconnect;
# add a transaction->blocked check back here when we have line by line plugin access... # add a transaction->blocked check back here when we have line by line plugin access...
unless (($max_size and $size > $max_size)) { unless (($max_size and $size > $max_size)) {
s/\r\n$/\n/; s/\r\n$/\n/;
s/^\.\./\./; s/^\.\./\./;
if ($in_header and m/^\s*$/) { if ($in_header and m/^\s*$/) {
$in_header = 0; $in_header = 0;
my @headers = split /^/m, $buffer; my @headers = split /^/m, $buffer;
# ... need to check that we don't reformat any of the received lines. # ... need to check that we don't reformat any of the received lines.
# #
# 3.8.2 Received Lines in Gatewaying # 3.8.2 Received Lines in Gatewaying
# When forwarding a message into or out of the Internet environment, a # 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 # gateway MUST prepend a Received: line, but it MUST NOT alter in any
# way a Received: line that is already in the header. # way a Received: line that is already in the header.
$header->extract(\@headers); $header->extract(\@headers);
#$header->add("X-SMTPD", "qpsmtpd/".$self->version.", http://smtpd.develooper.com/"); #$header->add("X-SMTPD", "qpsmtpd/".$self->version.", http://smtpd.develooper.com/");
$buffer = ""; $buffer = "";
# FIXME - call plugins to work on just the header here; can # FIXME - call plugins to work on just the header here; can
# save us buffering the mail content. # save us buffering the mail content.
} }
if ($in_header) { if ($in_header) {
$buffer .= $_; $buffer .= $_;
} }
else { else {
$self->transaction->body_write($_); $self->transaction->body_write($_);
} }
$size += length $_; $size += length $_;
@ -488,15 +489,12 @@ sub data {
$self->transaction->header($header); $self->transaction->header($header);
my $smtp = $self->connection->hello eq "ehlo" ? "ESMTP" : "SMTP"; my $smtp = $self->connection->hello eq "ehlo" ? "ESMTP" : "SMTP";
my $authheader = (defined $self->{_auth} and $self->{_auth} == OK) ?
# only true if client authenticated "(smtp-auth username $self->{_auth_user}, mechanism $self->{_auth_mechanism})\n" : "";
if ( defined $self->{_auth} and $self->{_auth} == OK ) {
$header->add("X-Qpsmtpd-Auth","True");
}
$header->add("Received", "from ".$self->connection->remote_info $header->add("Received", "from ".$self->connection->remote_info
." (HELO ".$self->connection->hello_host . ") (".$self->connection->remote_ip ." (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)), .") with $smtp; ". (strftime('%a, %d %b %Y %H:%M:%S %z', localtime)),
0); 0);

38
plugins/auth/auth_vpopmail_sql
View File

@ -9,9 +9,9 @@ auth_vpopmail_sql - Authenticate to vpopmail via MySQL
This plugin authenticates vpopmail users directly against a standard This plugin authenticates vpopmail users directly against a standard
vpopmail MySQL database. It makes the not-unreasonable assumption that vpopmail MySQL database. It makes the not-unreasonable assumption that
both pw_name and pw_domain are lowercase only (qmail doesn't actually care). both pw_name and pw_domain are lowercase only (qmail doesn't actually care).
It also requires that vpopmail be built with the recommended If you are using CRAM-MD5, it also requires that vpopmail be built with the
'--enable-clear-passwd=y' option, because there is no other way to compare recommended '--enable-clear-passwd=y' option, because there is no way
the password with CRAM-MD5. to compare the crypted password.
=head1 CONFIGURATION =head1 CONFIGURATION
@ -50,9 +50,9 @@ Please see the LICENSE file included with qpsmtpd for details.
sub register { sub register {
my ( $self, $qp ) = @_; my ( $self, $qp ) = @_;
$self->register_hook( "auth-plain", "authsql" ); $self->register_hook("auth-plain", "authsql" );
$self->register_hook("auth-login", "authsql" );
# $self->register_hook("auth-cram-md5", "authsql"); $self->register_hook("auth-cram-md5", "authsql");
} }
@ -82,31 +82,37 @@ sub authsql {
"Authentication to vpopmail via mysql: $pw_name\@$pw_domain"); "Authentication to vpopmail via mysql: $pw_name\@$pw_domain");
my $sth = $dbh->prepare(<<SQL); my $sth = $dbh->prepare(<<SQL);
select pw_clear_passwd select pw_passwd, pw_clear_passwd
from vpopmail from vpopmail
where pw_name = ? and pw_domain = ? where pw_name = ? and pw_domain = ?
SQL SQL
$sth->execute( $pw_name, $pw_domain ); $sth->execute( $pw_name, $pw_domain );
my ($pw_clear_passwd) = $sth->fetchrow_array; my ($pw_passwd, $pw_clear_passwd) = $sth->fetchrow_array;
$sth->finish; $sth->finish;
$dbh->disconnect; $dbh->disconnect;
unless ( defined $pw_clear_passwd ) { if ( # clear_passwd isn't defined so we cannot support CRAM-MD5
( $method =~ /CRAM-MD5/i and not defined $pw_clear_passwd )
# if this isn't defined then the user doesn't exist here or
# or the administrator forgot to build with --enable-clear-passwd=y # user doesn't exist in this domain
( not defined $pw_passwd )
) {
return ( DECLINED, "authsql/$method" ); return ( DECLINED, "authsql/$method" );
} }
# at this point we can assume the user name matched # at this point we can assume the user name matched
if ( if (
( defined $passClear ( defined $passClear and
and $pw_clear_passwd eq $passClear ) or (
( defined $passHash ($pw_clear_passwd eq $passClear)
and $passHash eq hmac_md5_hex( $ticket, $pw_clear_passwd ) ) or ($pw_passwd eq crypt( $passClear, $pw_passwd ) )
)
)
or ( defined $passHash
and $passHash eq hmac_md5_hex( $ticket, $pw_clear_passwd ) )
) )
{ {

4
plugins/check_badmailfrom
View File

@ -33,7 +33,7 @@ sub mail_handler {
or return (DECLINED); or return (DECLINED);
return (DECLINED) unless ($sender->format ne "<>" return (DECLINED) unless ($sender->format ne "<>"
and $sender->host && $sender->user); and $sender->host && $sender->user);
my $host = lc $sender->host; my $host = lc $sender->host;
my $from = lc($sender->user) . '@' . $host; my $from = lc($sender->user) . '@' . $host;
@ -43,7 +43,7 @@ sub mail_handler {
next unless $bad; next unless $bad;
$bad = lc $bad; $bad = lc $bad;
warn "Bad badmailfrom config: No \@ sign in $bad\n" and next unless $bad =~ m/\@/; 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"); if ($bad eq $from) || (substr($bad,0,1) eq '@' && $bad eq "\@$host");
} }
return (DECLINED); return (DECLINED);

64
plugins/check_badmailfromto Normal file
View 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);
}

22
plugins/check_earlytalker
View File

@ -53,14 +53,14 @@ sub register {
my ($self, $qp, @args) = @_; my ($self, $qp, @args) = @_;
if (@args % 2) { if (@args % 2) {
$self->log(LOGERROR, "Unrecognized/mismatched arguments"); $self->log(LOGERROR, "Unrecognized/mismatched arguments");
return undef; return undef;
} }
$self->{_args} = { $self->{_args} = {
'wait' => 1, 'wait' => 1,
'action' => 'denysoft', 'action' => 'denysoft',
'defer-reject' => 0, 'defer-reject' => 0,
@args, @args,
}; };
$self->register_hook('connect', 'connect_handler'); $self->register_hook('connect', 'connect_handler');
$self->register_hook('mail', 'mail_handler') $self->register_hook('mail', 'mail_handler')
@ -71,12 +71,16 @@ sub register {
sub connect_handler { sub connect_handler {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $in = new IO::Select; 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; $in->add(\*STDIN) || return DECLINED;
if ($in->can_read($self->{_args}->{'wait'})) { 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'}) { if ($self->{_args}->{'defer-reject'}) {
$self->qp->connection->notes('earlytalker', 1); $self->qp->connection->notes('earlytalker', 1);
} else { } else {
my $msg = 'Connecting host started transmitting before SMTP greeting'; my $msg = 'Connecting host started transmitting before SMTP greeting';
return (DENY,$msg) if $self->{_args}->{'action'} eq 'deny'; return (DENY,$msg) if $self->{_args}->{'action'} eq 'deny';

8
plugins/count_unrecognized_commands
View File

@ -36,13 +36,13 @@ sub check_unrec_cmd {
$self->log(LOGINFO, "Unrecognized command '$cmd'"); $self->log(LOGINFO, "Unrecognized command '$cmd'");
my $badcmdcount = my $badcmdcount =
$self->qp->connection->notes('unrec_cmd_count', $self->qp->connection->notes( 'unrec_cmd_count',
($self->qp->connection->notes('unrec_cmd_count') || 0) + 1 ($self->qp->connection->notes('unrec_cmd_count') || 0) + 1
); );
if ($badcmdcount >= $self->{_unrec_cmd_max}) { if ($badcmdcount >= $self->{_unrec_cmd_max}) {
$self->log(LOGINFO, "Closing connection. Too many unrecognized commands."); $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; return DECLINED;

167
plugins/dns_whitelist_soft Normal file
View 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;

14
plugins/dnsbl
View File

@ -154,8 +154,20 @@ sub rcpt_handler {
} }
my $note = $self->process_sockets; 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; return DECLINED;
} }
sub disconnect_handler { sub disconnect_handler {

5
plugins/queue/qmail-queue
View File

@ -75,7 +75,8 @@ sub queue_handler {
my $msg_id = $transaction->header->get('Message-Id') || ''; my $msg_id = $transaction->header->get('Message-Id') || '';
$msg_id =~ s/[\r\n].*//s; # don't allow newlines in the Message-Id here $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) { elsif (defined $child) {
# Child # Child
@ -100,7 +101,7 @@ sub queue_handler {
POSIX::dup2(fileno(ENVELOPE_READER), 1) or die "Unable to dup ENVELOPE_READER: $!"; POSIX::dup2(fileno(ENVELOPE_READER), 1) or die "Unable to dup ENVELOPE_READER: $!";
my $ppid = getppid(); 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; my $rc = exec $queue_exec;

9
plugins/require_resolvable_fromhost
View File

@ -8,13 +8,16 @@ sub register {
sub mail_handler { sub mail_handler {
my ($self, $transaction, $sender) = @_; my ($self, $transaction, $sender) = @_;
return DECLINED
if ($self->qp->connection->notes('whitelistclient'));
$sender->format ne "<>" $sender->format ne "<>"
and $self->qp->config("require_resolvable_fromhost") and $self->qp->config("require_resolvable_fromhost")
and !check_dns($sender->host) and !check_dns($sender->host)
and return (DENYSOFT, and return (DENYSOFT,
($sender->host ($sender->host
? "Could not resolve ". $sender->host ? "Could not resolve ". $sender->host
: "FQDN required in the envelope sender")); : "FQDN required in the envelope sender"));
return DECLINED; return DECLINED;

4
t/addresses.t
View File

@ -19,11 +19,11 @@ my $command = 'MAIL FROM:<ask@perl.org> SIZE=1230';
is(($smtpd->command($command))[0], 250, $command); is(($smtpd->command($command))[0], 250, $command);
is($smtpd->transaction->sender->format, '<ask@perl.org>', 'got the right sender'); 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->command($command))[0], 250, $command);
is($smtpd->transaction->sender->format, '<>', 'got the right sender'); 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->command($command))[0], 250, $command);
is($smtpd->transaction->sender->format, '<ask@p.qpsmtpd-test.askask.com>', 'got the right sender'); is($smtpd->transaction->sender->format, '<ask@p.qpsmtpd-test.askask.com>', 'got the right sender');

9
t/qpsmtpd-address.t
View File

@ -63,6 +63,15 @@ $ao = Qpsmtpd::Address->new($as);
ok ($ao, "new $as"); ok ($ao, "new $as");
is ($ao->address, 'foo@example.com', "address $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 ... # 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)'); is ($ao && $ao->address('test@example.com'), 'test@example.com', 'address(test@example.com)');