karma: added adjust_karma method

makes it easier to set karma in plugins

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) = @_;
 

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/dspam

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

@@ -173,7 +173,7 @@ sub connect_handler {
     };
 
     $self->connection->notes('earlytalker', 1);
-    $self->connection->notes('karma', -1);
+    $self->adjust_karma( -1 );
     return DECLINED;
 }
 

plugins/helo

@@ -430,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
 

plugins/qmail_deliverable

@@ -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/spamassassin

@@ -401,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/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;
+}
+