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 -
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)

17
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
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,10 +313,10 @@ 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 ) {
@ -321,6 +325,11 @@ sub SASL {
$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 {

14
lib/Qpsmtpd/SMTP.pm
View File

@ -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;
}
@ -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;
}
}
@ -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 {
@ -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);

36
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
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,30 +82,36 @@ 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
( 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 ) )
)
{

2
plugins/check_badmailfrom
View File

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

6
plugins/check_earlytalker
View File

@ -71,10 +71,14 @@ 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);
} else {

4
plugins/count_unrecognized_commands
View File

@ -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',
($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
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;
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 {

5
plugins/queue/qmail-queue
View File

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

3
plugins/require_resolvable_fromhost
View File

@ -8,6 +8,9 @@ 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)

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->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');

9
t/qpsmtpd-address.t
View File

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