From c840a1d04f2cb7042061448349c3c648504118e8 Mon Sep 17 00:00:00 2001 From: John Peacock Date: Fri, 28 Jan 2005 03:30:50 +0000 Subject: [PATCH] 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; 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 --- Changes | 32 ++++++ lib/Qpsmtpd/Auth.pm | 21 +++- lib/Qpsmtpd/SMTP.pm | 70 ++++++------ plugins/auth/auth_vpopmail_sql | 38 ++++--- plugins/check_badmailfrom | 4 +- plugins/check_badmailfromto | 64 +++++++++++ plugins/check_earlytalker | 22 ++-- plugins/count_unrecognized_commands | 8 +- plugins/dns_whitelist_soft | 167 ++++++++++++++++++++++++++++ plugins/dnsbl | 14 ++- plugins/queue/qmail-queue | 5 +- plugins/require_resolvable_fromhost | 9 +- t/addresses.t | 4 +- t/qpsmtpd-address.t | 9 ++ 14 files changed, 386 insertions(+), 81 deletions(-) create mode 100644 plugins/check_badmailfromto create mode 100644 plugins/dns_whitelist_soft diff --git a/Changes b/Changes index a38b1f4..0d97ffe 100644 --- a/Changes +++ b/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) diff --git a/lib/Qpsmtpd/Auth.pm b/lib/Qpsmtpd/Auth.pm index 7230b51..f6fa1c3 100644 --- a/lib/Qpsmtpd/Auth.pm +++ b/lib/Qpsmtpd/Auth.pm @@ -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; diff --git a/lib/Qpsmtpd/SMTP.pm b/lib/Qpsmtpd/SMTP.pm index d38bacb..98fd589 100644 --- a/lib/Qpsmtpd/SMTP.pm +++ b/lib/Qpsmtpd/SMTP.pm @@ -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 .'); + "This is qpsmtpd " . $self->version, + "See http://smtpd.develooper.com/", + 'To report bugs or send comments, mail to .'); } 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); diff --git a/plugins/auth/auth_vpopmail_sql b/plugins/auth/auth_vpopmail_sql index 031746f..4ce935f 100644 --- a/plugins/auth/auth_vpopmail_sql +++ b/plugins/auth/auth_vpopmail_sql @@ -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(<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 ) ) ) { diff --git a/plugins/check_badmailfrom b/plugins/check_badmailfrom index 16ca64f..8a07564 100644 --- a/plugins/check_badmailfrom +++ b/plugins/check_badmailfrom @@ -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); diff --git a/plugins/check_badmailfromto b/plugins/check_badmailfromto new file mode 100644 index 0000000..8c0390b --- /dev/null +++ b/plugins/check_badmailfromto @@ -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); +} diff --git a/plugins/check_earlytalker b/plugins/check_earlytalker index b444517..b44192b 100644 --- a/plugins/check_earlytalker +++ b/plugins/check_earlytalker @@ -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'; diff --git a/plugins/count_unrecognized_commands b/plugins/count_unrecognized_commands index 1f92a31..d9986b1 100644 --- a/plugins/count_unrecognized_commands +++ b/plugins/count_unrecognized_commands @@ -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; diff --git a/plugins/dns_whitelist_soft b/plugins/dns_whitelist_soft new file mode 100644 index 0000000..5eb6b83 --- /dev/null +++ b/plugins/dns_whitelist_soft @@ -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 + +Based on the 'whitelist_soft' plugin by Gavin Carr , +based on the 'whitelist' plugin by Devin Carraway . + +=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; diff --git a/plugins/dnsbl b/plugins/dnsbl index 353a918..9c4ec80 100644 --- a/plugins/dnsbl +++ b/plugins/dnsbl @@ -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 { diff --git a/plugins/queue/qmail-queue b/plugins/queue/qmail-queue index 8c91af4..2b391f6 100644 --- a/plugins/queue/qmail-queue +++ b/plugins/queue/qmail-queue @@ -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; diff --git a/plugins/require_resolvable_fromhost b/plugins/require_resolvable_fromhost index a122bda..ec2c539 100644 --- a/plugins/require_resolvable_fromhost +++ b/plugins/require_resolvable_fromhost @@ -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; diff --git a/t/addresses.t b/t/addresses.t index 2e261d0..c19b586 100644 --- a/t/addresses.t +++ b/t/addresses.t @@ -19,11 +19,11 @@ my $command = 'MAIL FROM: SIZE=1230'; is(($smtpd->command($command))[0], 250, $command); is($smtpd->transaction->sender->format, '', '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: SIZE=1230'; +my $command = 'MAIL FROM: SIZE=1230'; is(($smtpd->command($command))[0], 250, $command); is($smtpd->transaction->sender->format, '', 'got the right sender'); diff --git a/t/qpsmtpd-address.t b/t/qpsmtpd-address.t index e112ea7..b305940 100644 --- a/t/qpsmtpd-address.t +++ b/t/qpsmtpd-address.t @@ -63,6 +63,15 @@ $ao = Qpsmtpd::Address->new($as); ok ($ao, "new $as"); is ($ao->address, 'foo@example.com', "address $as"); +$as = ''; +$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)');