Merge branch 'master' of github.com:msimerson/qpsmtpd-dev

Conflicts:
	config.sample/plugins

Changes

@@ -570,7 +570,7 @@ Next Version
   no longer exists for that sender (great for harassment cases).
   (John Peacock)
 
-  check_earlytalker and resolvable_fromhost - short circuit test if
+  earlytalker and resolvable_fromhost - short circuit test if
   whitelistclient is set. (Michael Toren)
 
   check_badmailfrom - Do not say why a given message is denied.
@@ -642,7 +642,7 @@ Next Version
 
   Add a plugin hook for the DATA command
 
-  check_earlytalker -
+  earlytalker -
     + optionally react to an earlytalker by denying all MAIL-FROM commands
       rather than issuing a 4xx/5xx greeting and disconnecting. (Mark
       Powell)
@@ -728,7 +728,7 @@ Next Version
   Use $ENV{QMAIL} to override /var/qmail for where to find the
   control/ directory.
 
-  Enable "check_earlytalker" in the default plugins config
+  Enable "earlytalker" in the default plugins config
 
   Added a milter plugin to allow use of sendmail milters
 
@@ -792,7 +792,7 @@ Next Version
   unrecognized_command hook and a count_unrecognized_commands
   plugin. (Rasjid Wilcox)
 
-  check_earlytalker plugin.  Deny the connection if the client talks
+  earlytalker plugin.  Deny the connection if the client talks
   before we show our SMTP banner.  (From Devin Carraway)
 
   Patch Qpsmtpd::SMTP to allow connect plugins to give DENY and

MANIFEST

@@ -59,7 +59,7 @@ Makefile.PL
 MANIFEST			This list of files
 MANIFEST.SKIP
 META.yml			Module meta-data (added by MakeMaker)
-plugins/async/check_earlytalker
+plugins/async/earlytalker
 plugins/async/dns_whitelist_soft
 plugins/async/dnsbl
 plugins/async/queue/smtp-forward
@@ -77,9 +77,9 @@ plugins/auth/authdeny
 plugins/badmailfrom
 plugins/badmailfromto
 plugins/badrcptto
-plugins/check_bogus_bounce
+plugins/bogus_bounce
-plugins/check_earlytalker
+plugins/earlytalker
-plugins/check_loop
+plugins/loop
 plugins/connection_time
 plugins/content_log
 plugins/count_unrecognized_commands
@@ -172,9 +172,9 @@ t/plugin_tests/auth/auth_vpopmaild
 t/plugin_tests/auth/authdeny
 t/plugin_tests/auth/authnull
 t/plugin_tests/badmailfrom
-t/plugin_tests/check_badmailfromto
+t/plugin_tests/badmailfromto
 t/plugin_tests/badrcptto
-t/plugin_tests/check_earlytalker
+t/plugin_tests/earlytalker
 t/plugin_tests/count_unrecognized_commands
 t/plugin_tests/dnsbl
 t/plugin_tests/dspam

config.sample/plugins

@@ -28,19 +28,21 @@ dont_require_anglebrackets
 # parse_addr_withhelo
 
 quit_fortune
+#karma penalty_box 1 reject naughty
+
 # tls should load before count_unrecognized_commands
 #tls
-check_earlytalker
+earlytalker
 count_unrecognized_commands 4
 relay
 
 resolvable_fromhost
 
 rhsbl
-dnsbl reject naughty
+dnsbl reject naughty reject_type disconnect
 badmailfrom
 badrcptto
-helo
+helo policy lenient
 
 # sender_permitted_from
 # greylisting p0f genre,windows
@@ -70,13 +72,16 @@ spamassassin reject 12
 # rejects mails with a SA score higher than 20 and munges the subject
 # of the score is higher than 10.
 #
-#   spamassassin reject_threshold 20 munge_subject_threshold 10
+#   spamassassin reject 20 munge_subject_threshold 10
 
 # dspam must run after spamassassin for the learn_from_sa feature to work
 dspam learn_from_sa 7 reject 1
 
 # run the clamav virus checking plugin
 # virus/clamav
+# virus/clamdscan deny_viruses yes scan_all 1
+
+naughty reject data
 
 naughty
 

docs/hooks.pod

@@ -293,7 +293,7 @@ was sent, this hook is called.
 
 B<NOTE:> This hook, like B<EHLO>, B<VRFY>, B<QUIT>, B<NOOP>, is an 
 endpoint of a pipelined command group (see RFC 1854) and may be used to 
-detect ``early talkers''. Since svn revision 758 the F<check_earlytalker>
+detect ``early talkers''. Since svn revision 758 the F<earlytalker>
 plugin may be configured to check at this hook for ``early talkers''.
 
 Allowed return codes are

lib/Qpsmtpd/Plugin.pm

@@ -282,6 +282,15 @@ sub is_immune {
     return;
 };
 
+sub adjust_karma {
+    my ( $self, $value ) = @_;
+
+    my $karma = $self->connection->notes('karma') || 0;
+    $karma += $value;
+    $self->connection->notes('karma', $value);
+    return $value;
+};
+
 sub _register_standard_hooks {
   my ($plugin, $qp) = @_;
 

log/show_message

@@ -0,0 +1,72 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+
+my $QPDIR = get_qp_dir();
+my $logfile = "$QPDIR/log/main/current";
+
+my $is_ip  = 0;
+my $search = $ARGV[0];
+
+if ( ! $search ) {
+    die "\nusage: $0 [ ip_address | PID ]\n\n";
+};
+
+if ( $search =~ /^(?:[0-9]{1,3}\.){3}[0-9]{1,3}$/ ) {
+    #print "it's an IP\n";
+    $is_ip++;
+};
+
+open my $LOG, '<', $logfile or die "unable to open $logfile\n";
+
+if ( $is_ip ) {    # look for the connection start message for the IP
+    my $ip_matches;
+    while ( defined (my $line = <$LOG>) ) {
+        next if ! $line;
+        my ( $tai, $pid, $mess ) = split /\s/, $line, 3;
+        if ( 'Connection from ' eq substr( $mess, 0, 16 ) ) {
+            my ( $ip ) = (split /\s+/, $mess)[-1];  # IP is last word
+            $ip = substr $ip, 1, -1;                # trim off brackets
+            if ( $ip eq $search ) {
+                $ip_matches++;
+                $search = $pid;
+                $is_ip = 0;
+            };
+        };
+    };
+    seek $LOG, 0, 0;
+    die "no pid found for ip $search\n" if $is_ip;
+    print "showing the last of $ip_matches connnections from $ARGV[0]\n";
+};
+
+print "showing QP message PID $search\n";
+
+while ( defined (my $line = <$LOG>) ) {
+    next if ! $line;
+    my ( $tai, $pid, $mess ) = split /\s/, $line, 3;
+    next if ! $pid;
+    print $mess if ( $pid eq $search );
+};
+close $LOG;
+
+
+sub get_qp_dir {
+    foreach my $user ( qw/ qpsmtpd smtpd / ) {
+        my ($homedir) = (getpwnam( $user ))[7] or next;
+
+        if ( -d "$homedir/plugins" ) {
+            return "$homedir";
+        };
+        foreach my $s ( qw/ smtpd qpsmtpd qpsmtpd-dev / ) {
+            if ( -d "$homedir/$s/plugins" ) {
+                return "$homedir/$s";
+            };
+        };
+    };
+    if ( -d "./plugins" ) {
+        return Cwd::getcwd();
+    };
+};

log/summarize

@@ -3,6 +3,7 @@
 use strict;
 use warnings;
 
+use Cwd;
 use Data::Dumper;
 use File::Tail;
 
@@ -24,7 +25,6 @@ my %formats = (
     ip                    => "%-15.15s",
     hostname              => "%-20.20s",
     distance              =>    "%5.5s",
-
     'ident::geoip'        => "%-20.20s",
     'ident::p0f'          => "%-10.10s",
     count_unrecognized_commands => "%-5.5s",
@@ -37,6 +37,10 @@ my %formats = (
     check_earlytalker     => "%-3.3s",
     helo                  => "%-3.3s",
     tls                   => "%-3.3s",
+    'auth::auth_vpopmail' => "%-3.3s",
+    'auth::auth_vpopmaild' => "%-3.3s",
+    'auth::auth_vpopmail_sql' => "%-3.3s",
+    'auth::auth_checkpassword' => "%-3.3s",
     badmailfrom           => "%-3.3s",
     check_badmailfrom     => "%-3.3s",
     sender_permitted_from => "%-3.3s",
@@ -69,7 +73,7 @@ while ( defined (my $line = $fh->read) ) {
     next if ! $line;
     my ( $type, $pid, $hook, $plugin, $message ) = parse_line( $line );
     next if ! $type;
-    next if $type =~ /info|unknown|response/;
+    next if $type =~ /^(info|unknown|response|tcpserver)$/;
     next if $type eq 'init';           # doesn't occur in all deployment models
 
     if ( ! $pids{$pid} ) {             # haven't seen this pid 
@@ -104,12 +108,18 @@ while ( defined (my $line = $fh->read) ) {
         };
 
         if ( $plugin eq 'ident::geoip' ) {
+            if ( length $message < 3 ) {
+                $formats{'ident::geoip'} = "%-3.3s";
+                $formats3{'ident::geoip'} = "%-3.3s";
+            }
+            else {
                 my ($gip, $distance) = $message =~ /(.*?),\s+([\d]+)\skm/;
                 if ( $distance ) {
                     $pids{$pid}{$plugin}  = $gip;
                     $pids{$pid}{distance} = $distance;
                 };
             };
+        };
     }
     elsif ( $type eq 'reject' ) { }
     elsif ( $type eq 'connect' ) { }
@@ -150,6 +160,7 @@ sub parse_line {
     return parse_line_plugin( $line ) if substr($message, 0, 1) eq '(';
     return ( 'dispatch', $pid, undef, undef, $message ) if substr($message, 0, 12) eq 'dispatching ';
     return ( 'response', $pid, undef, undef, $message ) if $message =~ /^[2|3]\d\d/;
+    return ( 'tcpserver', $pid, undef, undef, undef ) if substr($pid, 0, 10) eq 'tcpserver:';
 
     # lines seen about once per connection
     return ( 'init',     $pid, undef, undef, $message ) if substr($message, 0, 19) eq 'Accepted connection';
@@ -228,12 +239,12 @@ sub print_auto_format {
 
         if ( defined $pids{$pid}{helo_host} && $plugin =~ /helo/ ) {
             $format .= " %-18.18s";
-            push @values, delete $pids{$pid}{helo_host};
+            push @values, substr( delete $pids{$pid}{helo_host}, -18, 18);
             push @headers, 'HELO';
         }
         elsif ( defined $pids{$pid}{from} && $plugin =~ /from/ ) {
             $format .= " %-20.20s";
-            push @values, delete $pids{$pid}{from};
+            push @values, substr( delete $pids{$pid}{from}, -20, 20);
             push @headers, 'MAIL FROM';
         }
         elsif ( defined $pids{$pid}{to} && $plugin =~ /to|rcpt|recipient/ ) {
@@ -276,17 +287,21 @@ sub show_symbol {
 
 sub get_qp_dir {
     foreach my $user ( qw/ qpsmtpd smtpd / ) {
-
         my ($homedir) = (getpwnam( $user ))[7] or next;
 
         if ( -d "$homedir/plugins" ) {
             return "$homedir";
         };
-        if ( -d "$homedir/smtpd/plugins" ) {
+        foreach my $s ( qw/ smtpd qpsmtpd qpsmtpd-dev / ) {
-            return "$homedir/smtpd";
+            if ( -d "$homedir/$s/plugins" ) {
+                return "$homedir/$s";
             };
         };
     };
+    if ( -d "./plugins" ) {
+        return Cwd::getcwd();
+    };
+};
 
 sub populate_plugins_from_registry {
 

log/watch

@@ -3,11 +3,12 @@
 use strict;
 use warnings;
 
+use Cwd;
 use Data::Dumper;
 use File::Tail;
 
-my $dir = find_qp_log_dir() or die "unable to find QP home dir";
+my $dir = get_qp_dir() or die "unable to find QP home dir";
-my $file = "$dir/main/current";
+my $file = "$dir/log/main/current";
 my $fh = File::Tail->new(name=>$file, interval=>1, maxinterval=>1, debug =>1, tail =>100 );
 
 while ( defined (my $line = $fh->read) ) {
@@ -15,16 +16,21 @@ while ( defined (my $line = $fh->read) ) {
     print $line;
 };
 
-sub find_qp_log_dir {
+sub get_qp_dir {
     foreach my $user ( qw/ qpsmtpd smtpd / ) {
-
         my ($homedir) = (getpwnam( $user ))[7] or next;
 
-        if ( -d "$homedir/log" ) {
+        if ( -d "$homedir/plugins" ) {
-            return "$homedir/log";
+            return "$homedir";
         };
-        if ( -d "$homedir/smtpd/log" ) {
+        foreach my $s ( qw/ smtpd qpsmtpd qpsmtpd-dev / ) {
-            return "$homedir/smtpd/log";
+            if ( -d "$homedir/$s/plugins" ) {
+                return "$homedir/$s";
             };
         };
     };
+    if ( -d "./plugins" ) {
+        return Cwd::getcwd();
+    };
+};
+

plugins/async/earlytalker

@@ -2,7 +2,7 @@
 
 =head1 NAME
 
-check_earlytalker - Check that the client doesn't talk before we send the SMTP banner
+earlytalker - Check that the client doesn't talk before we send the SMTP banner
 
 =head1 DESCRIPTION
 

plugins/badmailfrom

@@ -85,7 +85,7 @@ sub hook_mail {
         next unless $bad;
         next unless $self->is_match( $from, $bad, $host );
         $reason ||= "Your envelope sender is in my badmailfrom list";
-        $self->connection->notes('karma', ($self->connection->notes('karma') || 0) - 1);
+        $self->adjust_karma( -1 );
         return $self->get_reject( $reason );
     }
 

plugins/bogus_bounce

@@ -2,7 +2,7 @@
 
 =head1 NAME
 
-check_bogus_bounce - Check that a bounce message isn't bogus
+bogus_bounce - Check that a bounce message isn't bogus
 
 =head1 DESCRIPTION
 

plugins/dspam

@@ -216,7 +216,7 @@ sub register {
     $self->{_args}{dspam_bin} ||= '/usr/local/bin/dspam';
 
     if ( ! -x $self->{_args}{dspam_bin} ) {
-        $self->log(LOGERROR, "dspam not found: ");
+        $self->log(LOGERROR, "dspam CLI binary not found: install dspam and/or set dspam_bin");
         return DECLINED;
     };
 
@@ -478,9 +478,7 @@ sub reject_agree {
 
     if ( $d->{class} eq 'Spam' ) {
         if ( $sa->{is_spam} eq 'Yes' ) {
-            if ( defined $self->connection->notes('karma') ) {
+            $self->adjust_karma( -2 );
-                $self->connection->notes('karma', $self->connection->notes('karma') - 2);
-            };
             $self->log(LOGINFO, "fail, agree, $status");
             my $reject = $self->get_reject_type();
             return ($reject, 'we agree, no spam please');
@@ -493,9 +491,7 @@ sub reject_agree {
     if ( $d->{class} eq 'Innocent' ) {
         if ( $sa->{is_spam} eq 'No' ) {
             if ( $d->{confidence} > .9 ) {
-                if ( defined $self->connection->notes('karma') ) {
+                $self->adjust_karma( 2 );
-                    $self->connection->notes('karma', ( $self->connection->notes('karma') + 2) );
-                };
             };
             $self->log(LOGINFO, "pass, agree, $status");
             return DECLINED;
@@ -591,6 +587,7 @@ sub autolearn {
 
     defined $self->{_args}{autolearn} or return;
 
+    # only train once.
     $self->autolearn_naughty( $response, $transaction ) and return;
     $self->autolearn_karma( $response, $transaction ) and return;
     $self->autolearn_spamassassin( $response, $transaction ) and return;

plugins/earlytalker

@@ -2,7 +2,7 @@
 
 =head1 NAME
 
-check_earlytalker - Check that the client doesn't talk before we send the SMTP banner
+earlytalker - Check that the client doesn't talk before we send the SMTP banner
 
 =head1 DESCRIPTION
 
@@ -30,7 +30,7 @@ must also be allowed for.
 
 Do we reject/deny connections to early talkers?
 
-  check_earlytalker reject [ 0 | 1 ]
+  earlytalker reject [ 0 | 1 ]
 
 Default: I<reject 1>
 
@@ -48,7 +48,7 @@ issued a deny or denysoft (depending on the value of I<reject_type>). The defaul
 is to react at the SMTP greeting stage by issuing the apropriate response code
 and terminating the SMTP connection.
 
-  check_earlytalker defer-reject [ 0 | 1 ]
+  earlytalker defer-reject [ 0 | 1 ]
 
 =head2 check-at [ CONNECT | DATA ]
 
@@ -173,7 +173,7 @@ sub connect_handler {
     };
 
     $self->connection->notes('earlytalker', 1);
-    $self->connection->notes('karma', -1);
+    $self->adjust_karma( -1 );
     return DECLINED;
 }
 
@@ -205,6 +205,7 @@ sub log_and_deny {
     my $ip = $self->qp->connection->remote_ip || 'remote host';
 
     $self->connection->notes('earlytalker', 1);
+    $self->adjust_karma( -1 );
 
     my $log_mess = "$ip started talking before we said hello";
     my $smtp_msg = 'Connecting host started transmitting before SMTP greeting';

plugins/helo

@@ -106,25 +106,25 @@ Default: lenient
 
 =head3 lenient
 
-Reject failures of the following tests: is_in_badhelo, invalid_localhost, and
+Reject failures of the following tests: is_in_badhelo, invalid_localhost,
-is_forged_literal.
+is_forged_literal, and is_plain_ip.
 
 This setting is lenient enough not to cause problems for your Windows users.
 It is comparable to running check_spamhelo, but with the addition of regexp
-support and the prevention of forged localhost and forged IP literals.
+support, the prevention of forged localhost, forged IP literals, and plain
+IPs.
 
 =head3 rfc
 
 Per RFC 2821, the HELO hostname is the FQDN of the sending server or an
 address literal. When I<policy rfc> is selected, all the lenient checks and
-the following are enforced: is_plain_ip, is_not_fqdn, no_forward_dns, and
+the following are enforced: is_not_fqdn, no_forward_dns, and no_reverse_dns.
-no_reverse_dns.
 
 If you have Windows users that send mail via your server, do not choose
-I<policy rfc> without I<reject naughty> and the B<naughty> plugin. Windows
+I<policy rfc> without settings I<reject naughty> and using the B<naughty>
-users often send unqualified HELO names and will have trouble sending mail.
+plugin. Windows PCs often send unqualified HELO names and will have trouble
-<Naughty> can defer the rejection, and if the user subsequently authenticates,
+sending mail. The B<naughty> plugin defers the rejection, and if the user
-the rejection will be cancelled.
+subsequently authenticates, the rejection is be cancelled.
 
 =head3 strict
 
@@ -259,11 +259,10 @@ sub populate_tests {
     my $self = shift;
 
     my $policy = $self->{_args}{policy};
-    @{ $self->{_helo_tests} } = qw/ is_in_badhelo invalid_localhost is_forged_literal /;
+    @{ $self->{_helo_tests} } = qw/ is_in_badhelo invalid_localhost is_forged_literal is_plain_ip /;
 
     if ( $policy eq 'rfc' || $policy eq 'strict' ) {
-        push @{ $self->{_helo_tests} }, qw/ is_plain_ip is_not_fqdn
+        push @{ $self->{_helo_tests} }, qw/ is_not_fqdn no_forward_dns no_reverse_dns /;
-                                            no_forward_dns no_reverse_dns /;
     };
 
     if ( $policy eq 'strict' ) {
@@ -431,7 +430,7 @@ sub no_matching_dns {
     if ( $self->connection->notes('helo_forward_match') &&
          $self->connection->notes('helo_reverse_match') ) {
         $self->log( LOGDEBUG, "foward and reverse match" );
-# TODO: consider adding some karma here
+        $self->adjust_karma( 1 );  # whoppee, a match!
         return;
     };
 

plugins/karma

@@ -177,14 +177,14 @@ those senders haven't sent us any ham. As such, it's much safer to use.
 
 This plugin sets the connection note I<karma_history>. Your plugin can
 use the senders karma to be more gracious or rude to senders. The value of
-I<karma_history> is the number the nice connections minus naughty
+I<karma_history> is the number of nice connections minus naughty
 ones. The higher the number, the better you should treat the sender.
 
-When I<reject naughty> is set and a naughty sender is encountered, most
+To alter a connections karma based on its behavior, do this:
-plugins should skip processing. However, if you wish to toy with spammers by
+
-teergrubing, extending banner delays, limiting connections, limiting
+  $self->adjust_karma( -1 );  # lower karma (naughty)
-recipients, random disconnects, handoffs to rblsmtpd, and other fun tricks, 
+  $self->adjust_karma(  1 );  # raise karma (good)
-then connections with the I<naughty> note set are for you!
+
 
 =head1 EFFECTIVENESS
 
@@ -194,7 +194,7 @@ connections.
 
 This plugins effectiveness results from the propensity of naughty senders
 to be repeat offenders. Limiting them to a single offense per day(s) greatly
-reduces the number of useless tokens miscreants add to our Bayes databases.
+reduces the resources they can waste.
 
 Of the connections that had previously passed all other checks and were caught
 only by spamassassin and/or dspam, B<karma> rejected 31 percent. Since
@@ -207,7 +207,7 @@ Connection summaries are stored in a database. The database key is the int
 form of the remote IP. The value is a : delimited list containing a penalty
 box start time (if the server is/was on timeout) and the count of naughty,
 nice, and total connections. The database can be listed and searched with the
-karma_dump.pl script.
+karma_tool script.
 
 =head1 BUGS & LIMITATIONS
 
@@ -383,7 +383,7 @@ sub get_db_tie {
     my ( $self, $db, $lock ) = @_;
 
     tie( my %db, 'AnyDBM_File', $db, O_CREAT|O_RDWR, 0600) or do {
-        $self->log(LOGCRIT, "tie to database $db failed: $!");
+        $self->log(LOGCRIT, "error, tie to database $db failed: $!");
         close $lock;
         return;
     };
@@ -416,12 +416,12 @@ sub get_db_lock {
 
     # Check denysoft db
     open( my $lock, ">$db.lock" ) or do {
-        $self->log(LOGCRIT, "opening lockfile failed: $!");
+        $self->log(LOGCRIT, "error, opening lockfile failed: $!");
         return;
     };
 
     flock( $lock, LOCK_EX ) or do {
-        $self->log(LOGCRIT, "flock of lockfile failed: $!");
+        $self->log(LOGCRIT, "error, flock of lockfile failed: $!");
         close $lock;
         return;
     };
@@ -441,12 +441,12 @@ sub get_db_lock_nfs {
         blocking_timeout   => 10,      # 10 sec
         stale_lock_timeout => 30 * 60, # 30 min
     } or do {
-        $self->log(LOGCRIT, "nfs lockfile failed: $!");
+        $self->log(LOGCRIT, "error, nfs lockfile failed: $!");
         return;
     };
 
     open( my $lock, "+<$db.lock") or do {
-        $self->log(LOGCRIT, "opening nfs lockfile failed: $!");
+        $self->log(LOGCRIT, "error, opening nfs lockfile failed: $!");
         return;
     };
 

plugins/loop

@@ -2,7 +2,7 @@
 
 =head1 NAME
 
-check_loop - Detect mail loops
+loop - Detect mail loops
 
 =head1 DESCRIPTION
 

plugins/qmail_deliverable

@@ -77,7 +77,7 @@ sub register {
         $self->log(LOGWARN, "Odd number of arguments, using default config");
     } else {
         my %args = @args;
-        if ($args{server} =~ /^smtproutes:/) {
+        if ($args{server} && $args{server} =~ /^smtproutes:/) {
 
             my ($fallback, $port) = $args{server} =~ /:(?:(.*?):?)(\d+)/;
 
@@ -138,9 +138,7 @@ sub rcpt_handler {
 
     return DECLINED if $rv;
 
-    if ( defined $self->connection->notes('karma') ) {
+    $self->adjust_karma( -1 );
-        $self->connection->notes('karma', ($self->connection->notes('karma') - 1));
-    };
     return (DENY, "fail, no mailbox by that name. qd (#5.1.1)" );
 }
 

plugins/registry.txt

@@ -9,7 +9,7 @@
 3	ident::p0f					p0f		p0f
 5	karma						krm		karma
 6	dnsbl						dbl		dnsbl
-7	relay						rly		relay
+7	relay						rly		relay       check_relay,check_norelay,relay_only
 9	earlytalker					ear		early		check_earlytalker
 15	helo						hlo		helo		check_spamhelo
 16	tls							tls		tls
@@ -22,13 +22,14 @@
 #
 # Authentication
 #
-30	auth::vpopmail_sql			aut		vpsql
+30	auth::auth_vpopmail_sql		aut		vpsql
-31	auth::vpopmaild				vpd		vpopd
+31	auth::auth_vpopmaild		vpd		vpopd
-32	auth::vpopmail				vpo		vpop
+32	auth::auth_vpopmail			vpo		vpop
-33	auth::checkpasswd			ckp		chkpw
+33	auth::auth_checkpasswd		ckp		chkpw
-34	auth::cvs_unix_local		cvs		cvsul
+34	auth::auth_cvs_unix_local	cvs		cvsul
-35	auth::flat_file				flt		aflat
+35	auth::auth_flat_file		flt		aflat
-36	auth::ldap_bind				ldp		aldap
+36	auth::auth_ldap_bind		ldp		aldap
+37	auth::authdeny	        	dny		adeny
 #
 # Sender / From
 #
@@ -63,7 +64,7 @@
 70	virus::aveclient			ave		avirs
 71	virus::bitdefender			bit		bitdf
 72	virus::clamav				cav		clamv
-73	virus::clamdscan			cad		clamd
+73	virus::clamdscan			clm		clamd
 74	virus::hbedv				hbv		hbedv
 75	virus::kavscanner			kav		kavsc
 76	virus::klez_filter			klz		vklez

plugins/resolvable_fromhost

@@ -68,6 +68,7 @@ Default: temp (temporary, aka soft, aka 4xx).
 use strict;
 use warnings;
 
+use lib 'lib';
 use Qpsmtpd::Constants;
 use Qpsmtpd::DSN;
 use Qpsmtpd::TcpServer;
@@ -114,13 +115,14 @@ sub hook_mail {
     };
 
     my $result = $transaction->notes('resolvable_fromhost') or do {
+        $self->log(LOGINFO, 'error, missing result' );
         return Qpsmtpd::DSN->temp_resolver_failed( $self->get_reject_type(), '' );
     };
 
     return DECLINED if $result =~ /^(?:a|ip|mx)$/;         # success
     return DECLINED if $result =~ /^(?:whitelist|null|naughty)$/; # immunity
 
-    $self->log(LOGINFO, $result ); # log error
+    $self->log(LOGINFO, "fail, $result" ); # log error
 
     return Qpsmtpd::DSN->addr_bad_from_system( $self->get_reject_type(),
                             "FQDN required in the envelope sender");

plugins/sender_permitted_from

@@ -143,28 +143,18 @@ sub mail_handler {
     };
 
 # SPF result codes: pass fail softfail neutral none error permerror temperror
+    return $self->handle_code_none($reject, $why) if $code eq 'none';
+    return $self->handle_code_fail($reject, $why) if $code eq 'fail';
+    return $self->handle_code_softfail($reject, $why) if $code eq 'softfail';
+
     if    ( $code eq 'pass' ) {
         $self->log(LOGINFO, "pass, $code: $why" );
         return (DECLINED);
     }
-    elsif ( $code eq 'fail' ) {
-        $self->log(LOGINFO, "fail, $why" );
-        return (DENY, "SPF - forgery: $why") if $reject >= 3;
-        return (DENYSOFT, "SPF - $code: $why") if $reject >= 2;
-    }
-    elsif ( $code eq 'softfail' ) {
-        $self->log(LOGINFO, "fail, $why" );
-        return (DENY, "SPF - $code: $why") if $reject >= 4;
-        return (DENYSOFT, "SPF - $code: $why") if $reject >= 3;
-    }
     elsif ( $code eq 'neutral' ) {
         $self->log(LOGINFO, "fail, $code, $why" );
         return (DENY, "SPF - $code: $why") if $reject >= 5;
     }
-    elsif ( $code eq 'none' ) {
-        $self->log(LOGINFO, "fail, $code, $why" );
-        return (DENY, "SPF - $code: $why") if $reject >= 6;
-    }
     elsif ( $code eq 'error' ) {
         $self->log(LOGINFO, "fail, $code, $why" );
         return (DENY, "SPF - $code: $why") if $reject >= 6;
@@ -184,6 +174,44 @@ sub mail_handler {
     return (DECLINED);
 }
 
+sub handle_code_none {
+    my ($self, $reject, $why ) = @_;
+
+    if ( $reject >= 6 ) {
+        $self->log(LOGINFO, "fail, none, $why" );
+        return (DENY, "SPF - none: $why");
+    };
+
+    $self->log(LOGINFO, "pass, none, $why" );
+    return DECLINED;
+};
+
+sub handle_code_fail {
+    my ($self, $reject, $why ) = @_;
+
+    if ( $reject >= 2 ) {
+        $self->log(LOGINFO, "fail, $why" );
+        return (DENY, "SPF - forgery: $why") if $reject >= 3;
+        return (DENYSOFT, "SPF - fail: $why")
+    };
+
+    $self->log(LOGINFO, "pass, fail tolerated, $why" );
+    return DECLINED;
+};
+
+sub handle_code_softfail {
+    my ($self, $reject, $why ) = @_;
+
+    if ( $reject >= 3 ) {
+        $self->log(LOGINFO, "fail, soft, $why" );
+        return (DENY, "SPF - fail: $why") if $reject >= 4;
+        return (DENYSOFT, "SPF - fail: $why") if $reject >= 3;
+    };
+
+    $self->log(LOGINFO, "pass, softfail tolerated, $why" );
+    return DECLINED;
+};
+
 sub data_post_handler {
     my ($self, $transaction) = @_;
 

plugins/spamassassin

@@ -369,11 +369,12 @@ sub reject {
     my ($self, $transaction) = @_;
 
     my $sa_results = $self->get_spam_results($transaction) or do {
-        $self->log(LOGNOTICE, "skip, no results");
+        $self->log(LOGNOTICE, "error, no results");
         return DECLINED;
     };
-    my $score  = $sa_results->{score} or do {
+    my $score  = $sa_results->{score};
-        $self->log(LOGERROR, "skip, error getting score");
+    if ( ! defined $score ) {
+        $self->log(LOGERROR, "error, error getting score");
         return DECLINED;
     };
 
@@ -385,7 +386,7 @@ sub reject {
     };
 
     my $reject = $self->{_args}{reject} or do {
-        $self->log(LOGERROR, "skip, reject disabled ($status, $learn)");
+        $self->log(LOGERROR, "pass, reject disabled ($status, $learn)");
         return DECLINED;
     };
 
@@ -400,7 +401,7 @@ sub reject {
         }
     }
 
-    $self->connection->notes('karma', $self->connection->notes('karma') - 1);
+    $self->adjust_karma( -1 );
 # default of media_unsupported is DENY, so just change the message
     $self->log(LOGINFO, "fail, $status, > $reject, $learn");
     return ($self->get_reject_type(), "spam score exceeded threshold");

plugins/virus/clamdscan

@@ -140,7 +140,7 @@ sub data_post_handler {
 
     my $filename = $self->get_filename( $transaction ) or return DECLINED;
 
-    return (DECLINED) if $self->is_immune();
+    #return (DECLINED) if $self->is_immune();
     return (DECLINED) if $self->is_too_big( $transaction );
     return (DECLINED) if $self->is_not_multipart( $transaction );
 

plugins/whitelist

@@ -0,0 +1,223 @@
+
+=head1 NAME
+
+whitelist - whitelist override for other qpsmtpd plugins
+
+
+=head1 DESCRIPTION
+
+The B<whitelist> plugin allows selected hosts or senders or recipients 
+to be whitelisted as exceptions to later plugin processing. It is a more
+conservative variant of Devin Carraway's 'whitelist' plugin.
+
+
+=head1 CONFIGURATION
+
+To enable the plugin, add it to the qpsmtpd/config/plugins file as usual.
+It should precede any plugins you might wish to whitelist for.
+
+Several configuration files are supported, corresponding to different
+parts of the SMTP conversation:
+
+=over 4
+
+=item whitelisthosts
+
+Any IP address (or start-anchored fragment thereof) listed in the
+whitelisthosts file is exempted from any further validation during 
+'connect', and can be selectively exempted at other stages by 
+plugins testing for a 'whitelisthost' connection note.
+
+Similarly, if the environment variable $WHITELISTCLIENT is set
+(which can be done by tcpserver), the connection will be exempt from
+further 'connect' validation, and the host can be selectively 
+exempted by other plugins testing for a 'whitelistclient' connection 
+note.
+
+=item whitelisthelo
+
+Any host that issues a HELO matching an entry in whitelisthelo will
+be exempted from further validation at the 'helo' stage. Subsequent
+plugins can test for a 'whitelisthelo' connection note. Note that 
+this does not actually amount to an authentication in any meaningful 
+sense.
+
+=item whitelistsenders
+
+If the envelope sender of a mail (that which is sent as the MAIL FROM)
+matches an entry in whitelistsenders, or if the hostname component 
+matches, the mail will be exempted from any further validation within
+the 'mail' stage. Subsequent plugins can test for this exemption as a 
+'whitelistsender' transaction note.
+
+=item whitelistrcpt
+
+If any recipient of a mail (that sent as the RCPT TO) matches an
+entry from whitelistrcpt, or if the hostname component matches, no 
+further validation will be required for this recipient. Subsequent 
+plugins can test for this exemption using a 'whitelistrcpt' 
+transaction note, which holds the count of whitelisted recipients.
+
+=back
+
+whitelist_soft also supports per-recipient whitelisting when using
+the per_user_config plugin. To enable the per-recipient behaviour 
+(delaying all whitelisting until the rcpt part of the smtp 
+conversation, and using per-recipient whitelist configs, if 
+available), pass a true 'per_recipient' argument in the
+config/plugins invocation i.e.
+
+  whitelist_soft per_recipient 1
+
+By default global and per-recipient whitelists are merged; to turn off
+the merge behaviour pass a false 'merge' argument in the config/plugins
+invocation i.e.
+
+  whitelist_soft per_recipient 1 merge 0
+
+
+=head1 BUGS
+
+Whitelist lookups are all O(n) linear scans of configuration files, even
+though they're all associative lookups.  Something should be done about
+this when CDB/DB/GDBM configs are supported.
+
+
+=head1 AUTHOR
+
+Based on the 'whitelist' plugin by Devin Carraway <qpsmtpd@devin.com>.
+
+Modified by Gavin Carr <gavin@openfusion.com.au> to not inherit 
+whitelisting across hooks, but use per-hook whitelist notes instead.
+This is a more conservative approach e.g. whitelisting an IP will not
+automatically allow relaying from that IP.
+
+=cut
+
+my $VERSION = 0.02;
+
+# Default is to merge whitelists in per_recipient mode
+my %MERGE = (merge => 1);
+
+sub register {
+    my ($self, $qp, %arg) = @_;
+
+    $self->{_per_recipient} = 1 if $arg{per_recipient};
+    $MERGE{merge} = $arg{merge} if defined $arg{merge};
+
+    # Normal mode - whitelist per hook
+    unless ($arg{per_recipient}) {
+        $self->register_hook("connect", "check_host");
+        $self->register_hook("helo",    "check_helo");
+        $self->register_hook("ehlo",    "check_helo");
+        $self->register_hook("mail",    "check_sender");
+        $self->register_hook("rcpt",    "check_rcpt");
+    }
+
+    # Per recipient mode - defer all whitelisting to rcpt hook
+    else {
+        $self->register_hook("rcpt", "check_host");
+        $self->register_hook("helo", "helo_helper");
+        $self->register_hook("ehlo", "helo_helper");
+        $self->register_hook("rcpt", "check_helo");
+        $self->register_hook("rcpt", "check_sender");
+        $self->register_hook("rcpt", "check_rcpt");
+    }
+}
+
+sub check_host {
+    my ($self, $transaction, $rcpt) = @_;
+    my $ip = $self->qp->connection->remote_ip || return (DECLINED);
+
+    # From tcpserver
+    if (exists $ENV{WHITELISTCLIENT}) {
+        $self->qp->connection->notes('whitelistclient', 1);
+        $self->log(2, "host $ip is a whitelisted client");
+        return OK;
+    }
+
+    my $config_arg = $self->{_per_recipient} ? {rcpt => $rcpt, %MERGE} : {};
+    for my $h ($self->qp->config('whitelisthosts', $config_arg)) {
+        if ($h eq $ip or $ip =~ /^\Q$h\E/) {
+            $self->qp->connection->notes('whitelisthost', 1);
+            $self->log(2, "host $ip is a whitelisted host");
+            return OK;
+        }
+    }
+    return DECLINED;
+}
+
+sub helo_helper {
+    my ($self, $transaction, $helo) = @_;
+    $self->{_whitelist_soft_helo} = $helo;
+    return DECLINED;
+}
+
+sub check_helo {
+    my ($self, $transaction, $helo) = @_;
+
+    # If per_recipient will be rcpt hook, and helo actually rcpt
+    my $config_arg = {};
+    if ($self->{_per_recipient}) {
+        $config_arg = {rcpt => $helo, %MERGE};
+        $helo = $self->{_whitelist_soft_helo};
+    }
+
+    for my $h ($self->qp->config('whitelisthelo', $config_arg)) {
+        if ($helo and lc $h eq lc $helo) {
+            $self->qp->connection->notes('whitelisthelo', 1);
+            $self->log(2, "helo host $helo in whitelisthelo");
+            return OK;
+        }
+    }
+    return DECLINED;
+}
+
+sub check_sender {
+    my ($self, $transaction, $sender) = @_;
+
+    # If per_recipient will be rcpt hook, and sender actually rcpt
+    my $config_arg = {};
+    if ($self->{_per_recipient}) {
+        $config_arg = {rcpt => $sender, %MERGE};
+        $sender = $transaction->sender;
+    }
+
+    return DECLINED if $sender->format eq '<>';
+    my $addr = lc $sender->address or return DECLINED;
+    my $host = lc $sender->host    or return DECLINED;
+
+    for my $h ($self->qp->config('whitelistsenders', $config_arg)) {
+        next unless $h;
+        $h = lc $h;
+
+        if ($addr eq $h or $host eq $h) {
+            $transaction->notes('whitelistsender', 1);
+            $self->log(2, "envelope sender $addr in whitelistsenders");
+            return OK;
+        }
+    }
+    return DECLINED;
+}
+
+sub check_rcpt {
+    my ($self, $transaction, $rcpt) = @_;
+
+    my $addr = lc $rcpt->address or return DECLINED;
+    my $host = lc $rcpt->host    or return DECLINED;
+
+    my $config_arg = $self->{_per_recipient} ? {rcpt => $rcpt, %MERGE} : {};
+    for my $h ($self->qp->config('whitelistrcpt', $config_arg)) {
+        next unless $h;
+        $h = lc $h;
+
+        if ($addr eq $h or $host eq $h) {
+            my $note = $transaction->notes('whitelistrcpt');
+            $transaction->notes('whitelistrcpt', ++$note);
+            $self->log(2, "recipient $addr in whitelistrcpt");
+            return OK;
+        }
+    }
+    return DECLINED;
+}
+

run

@@ -11,6 +11,7 @@ PERL=/usr/bin/perl
 QMAILDUID=`id -u $QPUSER`
 NOFILESGID=`id -g $QPUSER`
 IP=`head -1 config/IP`
+PORT=25
 LANG=C
 
 # Remove the comments between the <start> and <end> tags to choose a
@@ -19,7 +20,7 @@ LANG=C
 # <start tcpserver>
 exec $BIN/softlimit -m $MAXRAM  \
   $BIN/tcpserver -c 10 -v -R -p \
-  -u $QMAILDUID -g $NOFILESGID $IP smtp   \
+  -u $QMAILDUID -g $NOFILESGID $IP $PORT  \
   ./qpsmtpd 2>&1
 # <end tcpserver>
 
@@ -30,7 +31,7 @@ exec $BIN/softlimit -m $MAXRAM  \
 #  exec $BIN/softlimit -m $MAXRAM   \
 #    $PERL -T ./qpsmtpd-forkserver  \
 #      --listen-address $IP         \
-#      --port 25                    \
+#      --port $PORT                 \
 #      --limit-connections 15       \
 #      --max-from-ip 5              \
 #      --user $QPUSER

t/config/plugins

@@ -30,7 +30,7 @@ parse_addr_withhelo
 quit_fortune
 # tls should load before count_unrecognized_commands
 #tls
-check_earlytalker
+earlytalker
 count_unrecognized_commands 4
 relay