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

lib/Qpsmtpd/Plugin.pm

@@ -287,7 +287,8 @@ sub adjust_karma {
 
     my $karma = $self->connection->notes('karma') || 0;
     $karma += $value;
-    $self->connection->notes('karma', $value);
+    $self->log(LOGDEBUG, "karma adjust: $value ($karma)");
+    $self->connection->notes('karma', $karma);
     return $value;
 };
 

log/summarize

@@ -33,6 +33,7 @@ my %formats = (
     rhsbl                 => "%-3.3s",
     relay                 => "%-3.3s",
     karma                 => "%-3.3s",
+    fcrdns                => "%-3.3s",
     earlytalker           => "%-3.3s",
     check_earlytalker     => "%-3.3s",
     helo                  => "%-3.3s",
@@ -182,6 +183,7 @@ sub parse_line {
     return ( 'info',     $pid, undef, undef, $message ) if substr($message, 0, 24) eq 'Permissions on spool_dir';
     return ( 'info',     $pid, undef, undef, $message ) if substr($message, 0, 13) eq 'Listening on ';
 
+    return ( 'err',      $pid, undef, undef, $message ) if $line =~ /at [\S]+ line \d/; # generic perl error
     print "UNKNOWN LINE: $line\n";
     return ( 'unknown',  $pid, undef, undef, $message );
 };

log/watch

@@ -9,7 +9,7 @@ use File::Tail;
 
 my $dir = get_qp_dir() or die "unable to find QP home dir";
 my $file = "$dir/log/main/current";
-my $fh = File::Tail->new(name=>$file, interval=>1, maxinterval=>1, debug =>1, tail =>100 );
+my $fh = File::Tail->new(name=>$file, interval=>1, maxinterval=>1, debug =>1, tail =>300 );
 
 while ( defined (my $line = $fh->read) ) {
     my (undef, $line) = split /\s/, $line, 2; # strip off tai timestamps

plugins/badmailfrom

@@ -44,7 +44,7 @@ is a Perl pattern expression. Don't forget to anchor the pattern
 anywhere in the string.
 
  ^streamsendbouncer@.*\.mailengine1\.com$    Your right-hand side VERP doesn't fool me
- ^return.*@.*\.pidplate\.biz$                I don' want it regardless of subdomain
+ ^return.*@.*\.pidplate\.biz$                I don't want it regardless of subdomain
  ^admin.*\.ppoonn400\.com$
 
 

plugins/badrcptto

@@ -64,6 +64,7 @@ sub hook_rcpt {
         my ($bad, $reason) = split /\s+/, $line, 2;
         next if ! $bad;
         if ( $self->is_match( $to, lc($bad), $host ) ) {
+            $self->adjust_karma( -2 );
             if ( $reason ) {
                 return (DENY, "mail to $bad not accepted here");
             }

plugins/dnsbl

@@ -191,6 +191,8 @@ sub hook_connect {
 
             next if ! $result;
 
+            $self->adjust_karma( -1 );
+
             if ( ! $dnsbl ) { ($dnsbl) = ($result =~ m/(?:\d+\.){4}(.*)/); };
             if ( ! $dnsbl ) {  $dnsbl = $result; };
 

plugins/dspam

@@ -493,7 +493,7 @@ sub reject_agree {
     if ( $d->{class} eq 'Innocent' ) {
         if ( $sa->{is_spam} eq 'No' ) {
             if ( $d->{confidence} > .9 ) {
-                $self->adjust_karma( 2 );
+                $self->adjust_karma( 1 );
             };
             $self->log(LOGINFO, "pass, agree, $status");
             return DECLINED;
@@ -634,14 +634,14 @@ sub autolearn_karma {
     my $karma = $self->connection->notes('karma');
     return if ! defined $karma;
 
-    if ( $karma <= -1  && $response->{result} eq 'Innocent' ) {
+    if ( $karma < -1  && $response->{result} eq 'Innocent' ) {
-        $self->log(LOGINFO, "training bad karma FN as spam");
+        $self->log(LOGINFO, "training bad karma ($karma) FN as spam");
         $self->train_error_as_spam( $transaction );
         return 1;
     };
 
-    if ( $karma >= 1 && $response->{result} eq 'Spam' ) {
+    if ( $karma > 1 && $response->{result} eq 'Spam' ) {
-        $self->log(LOGINFO, "training good karma FP as ham");
+        $self->log(LOGINFO, "training good karma ($karma) FP as ham");
         $self->train_error_as_ham( $transaction );
         return 1;
     };

plugins/earlytalker

@@ -163,6 +163,13 @@ sub connect_handler {
     return DECLINED unless $self->{_args}{'check-at'}{CONNECT};
     return DECLINED if $self->is_immune();
 
+    # senders with good karma skip the delay
+    my $karma = $self->connection->notes('karma_history');
+    if (defined $karma && $karma > 5) {
+        $self->log(LOGINFO, "skip, karma $karma");
+        return DECLINED;
+    };
+
     $in->add(\*STDIN) or return DECLINED;
     if (! $in->can_read($self->{_args}{'wait'})) {
         return $self->log_and_pass();
@@ -195,7 +202,7 @@ sub data_handler {
 sub log_and_pass {
     my $self = shift;
     my $ip = $self->qp->connection->remote_ip || 'remote host';
-    $self->log(LOGINFO, "pass, $ip said nothing spontaneous");
+    $self->log(LOGINFO, "pass, not spontaneous");
     return DECLINED;
 }
 
@@ -207,7 +214,7 @@ sub log_and_deny {
     $self->connection->notes('earlytalker', 1);
     $self->adjust_karma( -1 );
 
-    my $log_mess = "$ip started talking before we said hello";
+    my $log_mess = "remote started talking before we said hello";
     my $smtp_msg = 'Connecting host started transmitting before SMTP greeting';
 
     return $self->get_reject( $smtp_msg, $log_mess );

plugins/fcrdns

@@ -0,0 +1,280 @@
+#!perl -w
+
+=head1 NAME
+
+Forward Confirmed RDNS - http://en.wikipedia.org/wiki/FCrDNS
+
+=head1 DESCRIPTION
+
+Determine if the SMTP sender has matching forward and reverse DNS. 
+
+Sets the connection note fcrdns.
+
+=head1 WHY IT WORKS
+
+The reverse DNS of zombie PCs is out of the spam operators control. Their
+only way to pass this test is to limit themselves to hosts with matching
+forward and reverse DNS. At present, this presents a significant hurdle.
+
+=head1 VALIDATION TESTS
+
+=over 4
+
+=item has_reverse_dns
+
+Determine if the senders IP address resolves to a hostname.
+
+=item has_forward_dns
+
+If the remote IP has a PTR hostname(s), see if that host has an A or AAAA. If
+so, see if any of the host IPs (A or AAAA records) match the remote IP.
+
+Since the dawn of SMTP, having matching DNS has been a standard expected and
+oft required of mail servers. While requiring matching DNS is prudent,
+requiring an exact match will reject valid email. This often hinders the
+use of FcRDNS. While testing this plugin, I noticed that mx0.slc.paypal.com
+sends mail from an IP that reverses to mx1.slc.paypal.com. While that's
+technically an error, so too would rejecting that connection.
+
+To avoid false positives, matches are extended to the first 3 octets of the
+IP and the last two labels of the FQDN. The following are considered a match:
+
+  192.0.1.2, 192.0.1.3
+
+  foo.example.com, bar.example.com
+
+This allows FcRDNS to be used without rejecting mail from orgs with
+pools of servers where the HELO name and IP don't exactly match. This list
+includes Yahoo, Gmail, PayPal, cheaptickets.com, exchange.microsoft.com, etc.
+
+=back
+
+=head1 CONFIGURATION
+
+=head2 timeout [seconds]
+
+Default: 5
+
+The number of seconds before DNS queries timeout.
+
+=head2 reject [ 0 | 1 | naughty ]
+
+Default: 1
+
+0: do not reject
+
+1: reject
+
+naughty: naughty plugin handles rejection
+
+=head2 reject_type [ temp | perm | disconnect ]
+
+Default: disconnect
+
+What type of rejection should be sent? See docs/config.pod
+
+=head2 loglevel
+
+Adjust the quantity of logging for this plugin. See docs/logging.pod
+
+
+=head1 RFC 1912, RFC 5451
+
+From Wikipedia summary:
+
+1. First a reverse DNS lookup (PTR query) is performed on the IP address, which returns a list of zero or more PTR records. (has_reverse_dns)
+
+2. For each domain name returned in the PTR query results, a regular 'forward' DNS lookup (type A or AAAA query) is then performed on that domain name. (has_forward_dns)
+
+3. Any A or AAAA record returned by the second query is then compared against the original IP address (check_ip_match), and if there is a match, then the FCrDNS check passes.
+
+
+=head1 AUTHOR
+
+2013 - Matt Simerson
+
+=cut
+
+use strict;
+use warnings;
+
+use Qpsmtpd::Constants;
+
+use Net::DNS;
+
+sub register {
+    my ($self, $qp) = (shift, shift);
+    $self->{_args} = { @_ };
+    $self->{_args}{reject_type} = 'temp';
+    $self->{_args}{timeout} ||= 5;
+    $self->{_args}{ptr_hosts} = {};
+
+    if ( ! defined $self->{_args}{reject} ) {
+        $self->{_args}{reject} = 0;
+    };
+
+    $self->init_resolver();
+
+    $self->register_hook('connect',   'connect_handler');
+    $self->register_hook('data_post', 'data_post_handler');
+};
+
+sub connect_handler {
+    my ($self) = @_;
+
+    return DECLINED if $self->is_immune();
+
+    # run a couple cheap tests before the more expensive DNS tests
+    foreach my $test ( qw/ invalid_localhost is_not_fqdn / ) {
+        $self->$test() or return DECLINED;
+    };
+
+    $self->has_reverse_dns() or return DECLINED;
+    $self->has_forward_dns() or return DECLINED;
+
+    $self->log(LOGINFO, "pass");
+    return DECLINED;
+}
+
+sub data_post_handler {
+    my ($self, $transaction) = @_;
+
+    my $match = $self->connection->notes('fcrdns_match') || 0;
+    $transaction->header->add('X-Fcrdns', $match ? 'Yes' : 'No', 0 );
+    return (DECLINED);
+};
+
+sub init_resolver {
+    my $self = shift;
+    return $self->{_resolver} if $self->{_resolver};
+    $self->log( LOGDEBUG, "initializing Net::DNS::Resolver");
+    $self->{_resolver} = Net::DNS::Resolver->new(dnsrch => 0);
+    my $timeout = $self->{_args}{timeout} || 5;
+    $self->{_resolver}->tcp_timeout($timeout);
+    $self->{_resolver}->udp_timeout($timeout);
+    return $self->{_resolver};
+};
+
+sub invalid_localhost {
+    my ( $self ) = @_;
+    return 1 if lc $self->qp->connection->remote_host ne 'localhost';
+    if (   $self->qp->connection->remote_ip ne '127.0.0.1'
+        && $self->qp->connection->remote_ip ne '::1' ) {
+        $self->adjust_karma( -1 );
+        $self->log( LOGINFO, "fail, not localhost" );
+        return;
+    };
+    $self->adjust_karma( 1 );
+    $self->log( LOGDEBUG, "pass, is localhost" );
+    return 1;
+};
+
+sub is_not_fqdn {
+    my ($self) = @_;
+    my $host = $self->qp->connection->remote_host or return 1;
+    return 1 if $host eq 'Unknown'; # QP assigns this to a "no DNS result"
+
+    # Since QP looked it up, perform some quick validation
+    if ( $host !~ /\./ ) { # has no dots
+        $self->adjust_karma( -1 );
+        $self->log(LOGINFO, "fail, not FQDN");
+        return;
+    };
+    if ( $host =~ /[^a-zA-Z0-9\-\.]/ ) {
+        $self->adjust_karma( -1 );
+        $self->log(LOGINFO, "fail, invalid FQDN chars");
+        return;
+    };
+    return 1;
+};
+
+sub has_reverse_dns {
+    my ( $self ) = @_;
+
+    my $res = $self->init_resolver();
+    my $ip  = $self->qp->connection->remote_ip;
+
+    my $query = $res->query( $ip ) or do {
+        if ( $res->errorstring eq 'NXDOMAIN' ) {
+            $self->adjust_karma( -1 );
+            $self->log( LOGINFO, "fail, no rDNS: ".$res->errorstring );
+            return;
+        };
+        $self->log( LOGINFO, "fail, error getting rDNS: ".$res->errorstring );
+        return;
+    };
+
+    my $hits = 0;
+    $self->{_args}{ptr_hosts} = {};  # reset hash
+    for my $rr ($query->answer) {
+        next if $rr->type ne 'PTR';
+        $hits++;
+        $self->{_args}{ptr_hosts}{ $rr->ptrdname } = 1;
+        $self->log(LOGDEBUG, "PTR: " . $rr->ptrdname );
+    };
+    if ( ! $hits ) {
+        $self->adjust_karma( -1 );
+        $self->log( LOGINFO, "fail, no PTR records");
+        return;
+    };
+
+    $self->log(LOGDEBUG, "has rDNS");
+    return 1;
+};
+
+sub has_forward_dns {
+    my ( $self ) = @_;
+
+    my $res = $self->init_resolver();
+
+    foreach my $host ( keys %{ $self->{_args}{ptr_hosts} } ) {
+
+        $host .= '.' if '.' ne substr( $host, -1, 1); # fully qualify name
+        my $query = $res->search($host) or do {
+            if ( $res->errorstring eq 'NXDOMAIN' ) {
+                $self->log(LOGDEBUG, "host $host does not exist" );
+                next;
+            }
+            $self->log(LOGDEBUG, "query for $host failed (", $res->errorstring, ")" );
+            next;
+        };
+
+        my $hits = 0;
+        foreach my $rr ($query->answer) {
+            next unless $rr->type =~ /^(?:A|AAAA)$/;
+            $hits++;
+            $self->check_ip_match( $rr->address ) and return 1;
+        }
+        if ( $hits ) {
+            $self->log(LOGDEBUG, "PTR host has forward DNS") if $hits;
+            return 1;
+        };
+    };
+    $self->adjust_karma( -1 );
+    $self->log(LOGINFO, "fail, no PTR hosts have forward DNS");
+    return;
+};
+
+sub check_ip_match {
+    my $self = shift;
+    my $ip = shift or return;
+
+    if ( $ip eq $self->qp->connection->remote_ip ) {
+        $self->log( LOGDEBUG, "forward ip match" );
+        $self->connection->notes('fcrdns_match', 1);
+        $self->adjust_karma( 1 );
+        return 1;
+    };
+
+# TODO: make this IPv6 compatible
+    my $dns_net = join('.', (split(/\./, $ip))[0,1,2] );
+    my $rem_net = join('.', (split(/\./, $self->qp->connection->remote_ip))[0,1,2] );
+
+    if ( $dns_net eq $rem_net ) {
+        $self->log( LOGNOTICE, "forward network match" );
+        $self->connection->notes('fcrdns_match', 1);
+        return 1;
+    };
+    return;
+};
+

plugins/headers

@@ -126,13 +126,14 @@ sub hook_data_post {
     };
 
     my $header = $transaction->header or do {
-        return $self->get_reject( "missing headers", "missing headers" );
+        return $self->get_reject( "Headers are missing", "missing headers" );
     };
 
     return (DECLINED, "immune") if $self->is_immune();
 
     foreach my $h ( @required_headers ) {
         next if $header->get($h);
+        $self->adjust_karma( -1 );
         return $self->get_reject( "We require a valid $h header", "no $h header");
     };
 
@@ -140,11 +141,18 @@ sub hook_data_post {
         next if ! $header->get($h);          # doesn't exist
         my @qty = $header->get($h);
         next if @qty == 1;                   # only 1 header
-        return $self->get_reject("Only one $h header allowed. See RFC 5322", "too many $h headers");
+        $self->adjust_karma( -1 );
+        return $self->get_reject(
+            "Only one $h header allowed. See RFC 5322, Section 3.6",
+            "too many $h headers",
+        );
     };
 
     my $err_msg = $self->invalid_date_range();
-    return $self->get_reject($err_msg, $err_msg) if $err_msg;
+    if ( $err_msg ) {
+        $self->adjust_karma( -1 );
+        return $self->get_reject($err_msg, $err_msg);
+    };
 
     $self->log( LOGINFO, 'pass' );
     return (DECLINED);

plugins/helo

@@ -256,7 +256,10 @@ sub helo_handler {
 
     foreach my $test ( @{ $self->{_helo_tests} } ) {
         my @err = $self->$test( $host );
-        return $self->get_reject( @err ) if scalar @err;
+        if ( scalar @err ) {
+            $self->adjust_karma( -1 );
+            return $self->get_reject( @err );
+        };
     };
 
     $self->log(LOGINFO, "pass");
@@ -389,6 +392,8 @@ sub is_not_fqdn {
 sub no_forward_dns {
     my ( $self, $host ) = @_;
 
+    return if $self->is_address_literal( $host );
+
     my $res = $self->init_resolver();
 
     $host = "$host." if $host !~ /\.$/;   # fully qualify name
@@ -396,7 +401,7 @@ sub no_forward_dns {
 
     if (! $query) {
         if ( $res->errorstring eq 'NXDOMAIN' ) {
-            return ("HELO hostname does not exist", "HELO hostname does not exist");
+            return ("HELO hostname does not exist", "no such host");
         }
         $self->log(LOGERROR, "skip, query failed (", $res->errorstring, ")" );
         return;
@@ -411,7 +416,7 @@ sub no_forward_dns {
         $self->log(LOGDEBUG, "pass, forward DNS") if $hits;
         return;
     };
-    return ("helo hostname did not resolve", "fail, HELO forward DNS");
+    return ("HELO hostname did not resolve", "no forward DNS");
 };
 
 sub no_reverse_dns {
@@ -451,7 +456,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" );
-        $self->adjust_karma( 1 );  # whoppee, a match!
+        $self->adjust_karma( 1 );  # a perfect match
         return;
     };
 
@@ -465,7 +470,7 @@ sub no_matching_dns {
     };
 
     $self->log( LOGINFO, "fail, no forward or reverse DNS match" );
-    return ("That HELO hostname fails forward and reverse DNS checks", "no matching DNS");
+    return ("That HELO hostname fails FCrDNS", "no matching DNS");
 };
 
 sub check_ip_match {

plugins/hosts_allow

@@ -68,6 +68,7 @@ sub hook_pre_connection {
 
     my $remote = $args{remote_ip};
     my $max    = $args{max_conn_ip};
+    my $karma  = $self->connection->notes('karma_history');
 
     if ( $max ) {
         my $num_conn = 1; # seed with current value
@@ -75,17 +76,18 @@ sub hook_pre_connection {
         foreach my $rip (@{$args{child_addrs}}) {
             ++$num_conn if (defined $rip && $rip eq $raddr);
         }
+        $max = $self->karma_bump( $karma, $max ) if defined $karma;
         if ($num_conn > $max ) {
             my $err_mess = "too many connections from $remote";
             $self->log(LOGINFO, "fail: $err_mess ($num_conn > $max)");
-            return (DENYSOFT, "Sorry, $err_mess, try again later");
+            return (DENYSOFT, "$err_mess, try again later");
         }
     }
 
     my @r = $self->in_hosts_allow( $remote );
     return @r if scalar @r;
 
-    $self->log( LOGDEBUG, "pass" );
+    $self->log(LOGDEBUG, "pass" );
     return (DECLINED);
 }
 
@@ -113,3 +115,17 @@ sub in_hosts_allow {
 
     return;
 };
+
+sub karma_bump {
+    my ($self, $karma, $max) = @_;
+
+    if ( $karma  > 5 ) {
+        $self->log(LOGDEBUG, "increasing max connects for positive karma");
+        return $max + 3;
+    };
+    if ( $karma <= 0 ) {
+        $self->log(LOGINFO, "limiting max connects to 1 (karma $karma)");
+        return 1;
+    };
+    return $max;
+};

plugins/ident/geoip

@@ -58,6 +58,12 @@ IP of your mail server.
 
 Default: none. (no distance calculations)
 
+=head2 too_far <distance in km>
+
+Assign negative karma to connections further than this many km.
+
+Default: none
+
 =head2 db_dir </path/to/GeoIP>
 
 The path to the GeoIP database directory.
@@ -159,7 +165,12 @@ sub connect_handler {
     push @msg_parts, $c_code          if $c_code;
     #push @msg_parts, $c_name          if $c_name;
     push @msg_parts, $city            if $city;
-    push @msg_parts, "\t$distance km" if $distance;
+    if ( $distance ) {
+        push @msg_parts, "\t$distance km";
+        if ( $self->{_args}{too_far} && $distance > $self->{_args}{too_far} ) {
+            $self->adjust_karma( -1 );
+        };
+    };
     $self->log(LOGINFO, join( ", ", @msg_parts) );
 
     return DECLINED;

plugins/ident/p0f

@@ -99,6 +99,14 @@ Example entry specifying p0f version 2
 
   ident/p0f /tmp/.p0f_socket version 2
 
+=head2 smite_os
+
+Assign -1 karma to senders whose OS match the regex pattern supplied. I only recommend using with this p0f 3, as it's OS database is far more reliable than p0f v2.
+
+Example entry:
+
+  ident/p0f /tmp/.p0f_socket smite_os windows
+
 =head1 Environment requirements
 
 p0f v3 requires only the remote IP.
@@ -119,7 +127,7 @@ Version 2 code heavily based upon the p0fq.pl included with the p0f distribution
 
 2010 - Matt Simerson - added local_ip option
 
-2012 - Matt Simerson - refactored, v3 support
+2012 - Matt Simerson - refactored, added v3 support
 
 =cut
 
@@ -284,7 +292,7 @@ sub test_v2_response {
         return;
     }
     elsif ($type == 2) {
-        $self->log(LOGWARN, "skip, this connection is no longer in the cache");
+        $self->log(LOGWARN, "skip, connection not in the cache");
         return;
     }
     return 1;
@@ -358,6 +366,10 @@ sub store_v3_results {
         $r{uptime} = $r{uptime_min} if $r{uptime_min};
     };
 
+    if ( $r{genre} && $self->{_args}{smite_os} ) {
+        my $sos = $self->{_args}{smite_os};
+        $self->adjust_karma( -1 ) if $r{genre} =~ /$sos/i;
+    };
     $self->connection->notes('p0f', \%r);
     $self->log(LOGINFO, "$r{os_name} $r{os_flavor}");
     $self->log(LOGDEBUG, join(' ', @values ));

plugins/karma

@@ -6,7 +6,7 @@ karma - reward nice and penalize naughty mail senders
 
 =head1 SYNOPSIS
 
-Karma tracks sender history, providing the ability to deliver differing levels
+Karma tracks sender history, allowing us to provide differing levels
 of service to naughty, nice, and unknown senders.
 
 =head1 DESCRIPTION
@@ -14,7 +14,7 @@ of service to naughty, nice, and unknown senders.
 Karma records the number of nice, naughty, and total connections from mail
 senders. After sending a naughty message, if a sender has more naughty than
 nice connections, they are penalized for I<penalty_days>. Connections
-from senders in the penalty box are tersely disconnected.
+from senders in the penalty box are rejected per the settings in I<reject>.
 
 Karma provides other plugins with a karma value they can use to be more
 lenient, strict, or skip processing entirely.
@@ -24,10 +24,9 @@ custom connection policies such as these two examples:
 
 =over 4 
 
-Hi there, well behaved sender. Please help yourself to TLS, AUTH, greater
+Hi there, well behaved sender. Please help yourself to greater concurrency, multiple recipients, no delays, and other privileges.
-concurrency, multiple recipients, no delays, and other privileges.
 
-Hi there, naughty sender. Enjoy this poke in the eye with a sharp stick. Bye.
+Hi there, naughty sender. You get a max concurrency of 1, and SMTP delays.
 
 =back 
 
@@ -99,7 +98,7 @@ Karma reduces the resources wasted by naughty mailers.  When used with
 I<reject connect>, naughty senders are disconnected in about 0.1 seconds.
 
 The biggest gains to be had are by having heavy plugins (spamassassin, dspam,
-virus filters) set the B<karma> transaction note (see KARMA) when they encounter
+virus filters) set the B<karma> connection note (see KARMA) when they encounter
 naughty senders. Reasons to send servers to the penalty box could include
 sending a virus, early talking, or sending messages with a very high spam
 score.
@@ -111,16 +110,9 @@ run before B<karma> for that to work.
 
 =head1 KARMA
 
-No attempt is made by this plugin to determine what karma is. It is up to
+No attempt is made by this plugin to determine karma. It is up to other
-other plugins to make that determination and communicate it to this plugin by
+plugins to reward well behaved senders with positive karma and smite poorly
-incrementing or decrementing the transaction note B<karma>. Raise it for good
+behaved senders with negative karma. See B<USING KARMA IN OTHER PLUGINS>
-karma and lower it for bad karma. This is best done like so:
-
- # only if karma plugin loaded
- if ( defined $connection->notes('karma') ) {   
-   $connection->notes('karma', $connection->notes('karma') - 1); # bad
-   $connection->notes('karma', $connection->notes('karma') + 1); # good 
- };
 
 After the connection ends, B<karma> will record the result. Mail servers whose
 naughty connections exceed nice ones are sent to the penalty box. Servers in
@@ -133,7 +125,7 @@ an example connection from an IP in the penalty box:
  73122 (connect) earlytalker: pass: 64.185.226.65 said nothing spontaneous
  73122 (connect) relay: skip: no match
  73122 (connect) karma: fail
- 73122 550 You were naughty. You are penalized for 0.99 more days.
+ 73122 550 You were naughty. You are cannot connect for 0.99 more days.
  73122 click, disconnecting
  73122 (post-connection) connection_time: 1.048 s.
 
@@ -148,11 +140,11 @@ the time if we are careful to also set positive karma.
 Karma maintains a history for each IP. When a senders history has decreased
 below -5 and they have never sent a good message, they get a karma bonus.
 The bonus tacks on an extra day of blocking for every naughty message they
-sent us.
+send.
 
 Example: an unknown sender delivers a spam. They get a one day penalty_box.
 After 5 days, 5 spams, 5 penalties, and 0 nice messages, they get a six day
-penalty. The next offence gets a 7 day penalty, and so on.
+penalty. The next offense gets a 7 day penalty, and so on.
 
 =head1 USING KARMA
 
@@ -171,7 +163,7 @@ ident plugins.
  88798 cleaning up after 89011
 
 Unlike RBLs, B<karma> only penalizes IPs that have sent us spam, and only when
-those senders haven't sent us any ham. As such, it's much safer to use.
+those senders have sent us more spam than ham.
 
 =head1 USING KARMA IN OTHER PLUGINS
 
@@ -203,20 +195,19 @@ seems to be a very big win.
 
 =head1 DATABASE
 
-Connection summaries are stored in a database. The database key is the int
+Connection summaries are stored in a database. The database key is the integer
-form of the remote IP. The value is a : delimited list containing a penalty
+value of the remote IP. The DB 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_tool script.
 
 =head1 BUGS & LIMITATIONS
 
-This plugin is reactionary. Like the FBI, it doesn't punish until
+This plugin is reactionary. Like the FBI, it doesn't do anything until
-after a crime has been committed. It an "abuse me once, shame on you,
+after a crime has been committed.
-abuse me twice, shame on me" policy.
 
 There is little to be gained by listing servers that are already on DNS
-blacklists, send to non-existent users, earlytalkers, etc. Those already have
+blacklists, send to invalid users, earlytalkers, etc. Those already have
 very lightweight tests.
 
 =head1 AUTHOR
@@ -255,6 +246,32 @@ sub register {
     $self->register_hook('disconnect',        'disconnect_handler');
 }
 
+sub hook_pre_connection {
+    my ($self,$transaction,%args) = @_;
+
+    $self->connection->notes('karma_history', 0);
+
+    my $remote_ip = $args{remote_ip};
+    #my $max_conn = $args{max_conn_ip};
+
+    my $db   = $self->get_db_location();
+    my $lock = $self->get_db_lock( $db ) or return DECLINED;
+    my $tied = $self->get_db_tie( $db, $lock ) or return DECLINED;
+    my $key  = $self->get_db_key( $remote_ip ) or do {
+        $self->log( LOGINFO, "skip, unable to get DB key" );
+        return DECLINED;
+    };
+
+    if ( ! $tied->{$key} ) {
+        $self->log(LOGDEBUG, "pass, no record");
+        return $self->cleanup_and_return($tied, $lock );
+    };
+
+    my ($penalty_start_ts, $naughty, $nice, $connects) = $self->parse_value( $tied->{$key} );
+    $self->calc_karma($naughty, $nice);
+    return $self->cleanup_and_return($tied, $lock );
+};
+
 sub connect_handler {
     my $self = shift;
 
@@ -294,7 +311,7 @@ sub connect_handler {
     $self->cleanup_and_return($tied, $lock );
 
     my $left = sprintf "%.2f", $self->{_args}{penalty_days} - $days_old;
-    my $mess = "You were naughty. You are penalized for $left more days.";
+    my $mess = "You were naughty. You cannot connect for $left more days.";
 
     return $self->get_reject( $mess, $karma );
 }
@@ -313,29 +330,34 @@ sub disconnect_handler {
     my $key  = $self->get_db_key();
 
     my ($penalty_start_ts, $naughty, $nice, $connects) = $self->parse_value( $tied->{$key} );
+    my $history  = ($nice || 0) - $naughty;
+    my $log_mess = '';
 
-    if ( $karma < 0 ) {
+    if ( $karma < -1 ) {   # they achieved at least 2 strikes
-        $naughty++;
+        $history--;
         my $negative_limit = 0 - $self->{_args}{negative};
-        my $history  = ($nice || 0) - $naughty;
         if ( $history <= $negative_limit ) {
             if ( $nice == 0 && $history < -5 ) {
-                $self->log(LOGINFO, "penalty box bonus!");
+                $log_mess = ", penalty box bonus!";
                 $penalty_start_ts = sprintf "%s", time + abs($history) * 86400;
             }
             else {
                 $penalty_start_ts = sprintf "%s", time;
             };
-            $self->log(LOGINFO, "negative, sent to penalty box ($history)");
+            $log_mess = "negative, sent to penalty box" . $log_mess;
         }
         else {
-            $self->log(LOGINFO, "negative");
+            $log_mess = "negative";
         };
     }
     elsif ($karma > 1) {
         $nice++;
-        $self->log(LOGINFO, "positive");
+        $log_mess = "positive";
     }
+    else {
+        $log_mess = "neutral";
+    }
+    $self->log(LOGINFO, $log_mess . ", (msg: $karma, his: $history)" );
 
     $tied->{$key} = join(':', $penalty_start_ts, $naughty, $nice, ++$connects);
     return $self->cleanup_and_return($tied, $lock );
@@ -361,6 +383,7 @@ sub calc_karma {
 
     my $karma = ( $nice || 0 ) - ( $naughty || 0 );
     $self->connection->notes('karma_history', $karma );
+    $self->adjust_karma( 1 ) if $karma > 10;
     return $karma;
 };
 
@@ -375,7 +398,11 @@ sub cleanup_and_return {
 
 sub get_db_key {
     my $self = shift;
-    my $nip = Net::IP->new( $self->qp->connection->remote_ip ) or return;
+    my $ip = shift || $self->qp->connection->remote_ip;
+    my $nip = Net::IP->new( $ip ) or do {
+        $self->log(LOGERROR, "skip, unable to determine remote IP");
+        return;
+    };
     return $nip->intip;   # convert IP to an int
 };
 

plugins/karma_tool

@@ -26,6 +26,9 @@ elsif ( $command eq 'release' ) {
 elsif ( $command eq 'prune' ) {
     $self->prune_db( $ARGV[1] || 7 );
 }
+elsif ( $command eq 'search' && is_ip( $ARGV[1] ) ) {
+    $self->show_ip( $ARGV[1] );
+}
 elsif ( $command eq 'list' | $command eq 'search' ) {
     $self->main();
 };
@@ -76,10 +79,7 @@ sub capture {
 sub release {
     my $self = shift;
     my $ip = shift or return;
-    is_ip( $ip ) or do {
+    is_ip( $ip ) or do { warn "not an IP: $ip\n"; return; };
-        warn "not an IP: $ip\n";
-        return;
-    };
 
     my $db   = $self->get_db_location();
     my $lock = $self->get_db_lock( $db ) or return;
@@ -92,6 +92,27 @@ sub release {
     return $self->cleanup_and_return( $tied, $lock );
 };
 
+sub show_ip {
+    my $self = shift;
+    my $ip = shift or return;
+    my $db   = $self->get_db_location();
+    my $lock = $self->get_db_lock( $db ) or return;
+    my $tied = $self->get_db_tie( $db, $lock ) or return;
+    my $key  = $self->get_db_key( $ip );
+
+    my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, $tied->{$key};
+    $naughty ||= 0;
+    $nice    ||= 0;
+    $connects ||= 0;
+    my $time_human = '';
+    if ( $penalty_start_ts ) {
+        $time_human = strftime "%a %b %e %H:%M", localtime $penalty_start_ts;
+    };
+    my $hostname = `dig +short -x $ip` || ''; chomp $hostname;
+    print "      IP Address                 Penalty        Naughty  Nice  Connects  Hostname\n";
+    printf(" %-18s  %24s    %3s     %3s     %3s    %-30s\n", $ip, $time_human, $naughty, $nice, $connects, $hostname);
+};
+
 sub main {
     my $self = shift;
 
@@ -140,8 +161,8 @@ sub main {
 
 sub is_ip {
     my $ip = shift || $ARGV[0];
-    return 1 if $ip =~ /^(\d{1,3}\.){3}\d{1,3}$/;
+    new Net::IP( $ip ) or return;
-    return;
+    return 1;
 };
 
 sub cleanup_and_return {
@@ -152,7 +173,7 @@ sub cleanup_and_return {
 
 sub get_db_key {
     my $self = shift;
-    my $nip = Net::IP->new( shift );
+    my $nip = Net::IP->new( shift ) or return;
     return $nip->intip;   # convert IP to an int
 };
 

plugins/naughty

@@ -30,8 +30,8 @@ For efficiency, other plugins should skip processing naughty connections.
 Plugins like SpamAssassin and DSPAM can benefit from using naughty connections
 to train their filters.
 
-Since so many connections are from blacklisted IPs, naughty significantly
+Since many connections are from blacklisted IPs, naughty significantly
-reduces the resources required to disposing of them. Over 80% of my
+reduces the resources required to dispose of them. Over 80% of my
 connections are disposed of after after a few DNS queries (B<dnsbl> or one DB
 query (B<karma>) and 0.01s of compute time.
 
@@ -56,7 +56,7 @@ deployment models.
 
 When a user authenticates, the naughty flag on their connection is cleared.
 This is to allow users to send email from IPs that fail connection tests such
-as B<dnsbl>. Keep in mind that if I<reject connect> is set, connections will
+as B<dnsbl>. Note that if I<reject connect> is set, connections will
 not get the chance to authenticate. To allow clients a chance to authenticate,
 I<reject mail> works well.
 
@@ -86,7 +86,7 @@ Solutions are to make sure B<naughty> is listed before rcpt_ok in config/plugins
 or set naughty to run in a phase after the one you wish to complete.
 In this case, use data instead of rcpt to disconnect after rcpt_ok. The latter
 is particularly useful if your rcpt plugins skip naughty testing. In that case,
-any recipient is accepted for naughty connections, which prevents spammers
+any recipient is accepted for naughty connections, which inhibits spammers
 from detecting address validity.
 
 =head2 reject_type [ temp | perm | disconnect ]

plugins/qmail_deliverable

@@ -45,6 +45,19 @@ option must be enabled in order for user-ext@example.org addresses to work.
 
 Default: 0
 
+=item reject
+
+karma reject [ 0 | 1 | connect | naughty ]
+
+I<0> will not reject any connections.
+
+I<1> will reject naughty senders.
+
+I<connect> is the most efficient setting.
+
+To reject at any other connection hook, use the I<naughty> setting and the
+B<naughty> plugin.
+
 =back
 
 =head1 CAVEATS
@@ -155,6 +168,9 @@ sub register {
         if ( $args{vpopmail_ext} ) {
             $Qmail::Deliverable::VPOPMAIL_EXT = $args{vpopmail_ext};
         };
+        if ( $args{reject} ) {
+            $self->{_args}{reject} = $args{reject};
+        };
     }
     $self->register_hook("rcpt", "rcpt_handler");
 }
@@ -206,7 +222,8 @@ sub rcpt_handler {
         return DECLINED;
     };
 
-    return (DENY, "Sorry, no mailbox by that name. qd (#5.1.1)" );
+    $self->adjust_karma( -1 );
+    return $self->get_reject( "Sorry, no mailbox by that name. qd (#5.1.1)" );
 }
 
 sub _smtproute {

plugins/registry.txt

@@ -10,6 +10,7 @@
 5	karma						krm		karma
 6	dnsbl						dbl		dnsbl
 7	relay						rly		relay       check_relay,check_norelay,relay_only
+8   fcrdns						dns		fcrdn
 9	earlytalker					ear		early		check_earlytalker
 15	helo						hlo		helo		check_spamhelo
 16	tls							tls		tls

plugins/relay

@@ -241,6 +241,7 @@ sub hook_connect {
 # 95586 (connect) relay: pass, octet match in relayclients (127.0.0.)
 
     if ( $self->is_in_cidr_block() || $self->is_octet_match() ) {
+        $self->adjust_karma( 2 ); # big karma boost!
         $self->qp->connection->relay_client(1);
         return (DECLINED);
     };

plugins/resolvable_fromhost

@@ -109,21 +109,26 @@ sub hook_mail {
     return DECLINED if $resolved;  # success, no need to continue
     #return DECLINED if $sender->host;  # reject later
 
-    if ( ! $self->{_args}{reject} ) {;
-        $self->log(LOGINFO, 'skip, reject disabled' );
-        return DECLINED;
-    };
-
     my $result = $transaction->notes('resolvable_fromhost') or do {
-        $self->log(LOGINFO, 'error, missing result' );
+        if ( $self->{_args}{reject} ) {;
-        return Qpsmtpd::DSN->temp_resolver_failed( $self->get_reject_type(), '' );
+            $self->log(LOGINFO, 'error, missing result' );
+            return Qpsmtpd::DSN->temp_resolver_failed( $self->get_reject_type(), '' );
+        };
+        $self->log(LOGINFO, 'error, missing result, reject disabled' );
+        return DECLINED;
     };
 
     return DECLINED if $result =~ /^(?:a|ip|mx)$/;         # success
     return DECLINED if $result =~ /^(?:whitelist|null|naughty)$/; # immunity
 
-    $self->log(LOGINFO, "fail, $result" ); # log error
+    $self->adjust_karma( -1 );
 
+    if ( ! $self->{_args}{reject} ) {;
+        $self->log(LOGINFO, "fail, reject disabled, $result" );
+        return DECLINED;
+    };
+
+    $self->log(LOGINFO, "fail, $result" ); # log error
     return Qpsmtpd::DSN->addr_bad_from_system( $self->get_reject_type(),
                             "FQDN required in the envelope sender");
 }
@@ -134,6 +139,7 @@ sub check_dns {
     # we can't even parse a hostname out of the address
     if ( ! $host ) {
         $transaction->notes('resolvable_fromhost', 'unparsable host');
+        $self->adjust_karma( -1 );
         return;
     };
 
@@ -142,6 +148,7 @@ sub check_dns {
     if ( $host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/ ) {
         $self->log(LOGINFO, "skip, $host is an IP");
         $transaction->notes('resolvable_fromhost', 'ip');
+        $self->adjust_karma( -1 );
         return 1;
     };
 
@@ -150,8 +157,9 @@ sub check_dns {
     $res->udp_timeout(30);
 
     my $has_mx = $self->get_and_validate_mx( $res, $host, $transaction );
-    return 1 if $has_mx == 1;  # success!
+    return 1 if $has_mx == 1;  # success, has MX!
     return if $has_mx == -1;   # has invalid MX records
+    # at this point, no MX for fh is resolvable
 
     my @host_answers = $self->get_host_records( $res, $host, $transaction );
     foreach my $rr (@host_answers) {
@@ -189,6 +197,7 @@ sub get_and_validate_mx {
 
     my @mx = mx($res, $host);
     if ( ! scalar @mx ) {    # no mx records
+        $self->adjust_karma( -1 );
         $self->log(LOGINFO, "$host has no MX");
         return 0;
     };
@@ -203,8 +212,9 @@ sub get_and_validate_mx {
     }
 
     # if there are MX records, and we got here, none are valid
-    $self->log(LOGINFO, "fail, invalid MX for $host");
+    #$self->log(LOGINFO, "fail, invalid MX for $host");
     $transaction->notes('resolvable_fromhost', "invalid MX for $host");
+    $self->adjust_karma( -1 );
     return -1;
 };
 

plugins/sender_permitted_from

@@ -144,10 +144,16 @@ 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';
+    if ( $code eq 'fail' ) {
-    return $self->handle_code_softfail($reject, $why) if $code eq 'softfail';
+        $self->adjust_karma( -1 );
-
+        return $self->handle_code_fail($reject, $why);
-    if    ( $code eq 'pass' ) {
+    }
+    elsif ( $code eq 'softfail' ) {
+        $self->adjust_karma( -1 );
+        return $self->handle_code_softfail($reject, $why);
+    }
+    elsif ( $code eq 'pass' ) {
+        $self->adjust_karma( 1 );
         $self->log(LOGINFO, "pass, $code: $why" );
         return (DECLINED);
     }
@@ -158,12 +164,12 @@ sub mail_handler {
     elsif ( $code eq 'error' ) {
         $self->log(LOGINFO, "fail, $code, $why" );
         return (DENY, "SPF - $code: $why") if $reject >= 6;
-        return (DENYSOFT, "SPF - $code: $why") if $reject >= 2;
+        return (DENYSOFT, "SPF - $code: $why") if $reject > 3;
     }
     elsif ( $code eq 'permerror' ) {
         $self->log(LOGINFO, "fail, $code, $why" );
         return (DENY, "SPF - $code: $why") if $reject >= 6;
-        return (DENYSOFT, "SPF - $code: $why") if $reject >= 3;
+        return (DENYSOFT, "SPF - $code: $why") if $reject > 3;
     }
     elsif ( $code eq 'temperror' ) {
         $self->log(LOGINFO, "fail, $code, $why" );

plugins/spamassassin

@@ -134,7 +134,7 @@ Make the "subject munge string" configurable
   * added support for per-user SpamAssassin preferences
   * updated get_spam_results so that score=N.N works (as well as hits=N.N)
   * rewrote the X-Spam-* header additions so that SA generated headers are
-    not discarded. Admin can alter SA headers with add_header in their SA
+    preserved. Admins can alter SA headers with add_header in their SA
     config. Subverting their changes there is unexpected. Making them read
     code to figure out why is an unnecessary hurdle.
   * added assemble_message, so we can calc content size which spamd wants
@@ -144,7 +144,6 @@ Make the "subject munge string" configurable
 use strict;
 use warnings;
 
-use lib 'lib';
 use Qpsmtpd::Constants;
 use Qpsmtpd::DSN;
 
@@ -314,6 +313,10 @@ sub connect_to_spamd_socket {
         return;
     };
 
+    # Sanitize for use with taint mode
+    $socket =~ /^([\w\/.-]+)$/;
+    $socket = $1;
+
     socket(my $SPAMD, PF_UNIX, SOCK_STREAM, 0) or do {
         $self->log(LOGERROR, "Could not open socket: $!");
         return;
@@ -393,8 +396,11 @@ sub reject {
     my $ham_or_spam = $sa_results->{is_spam} eq 'Yes' ? 'Spam' : 'Ham';
     my $status = "$ham_or_spam, $score";
     my $learn = '';
-    if ( $sa_results->{autolearn} ) {
+    my $al = $sa_results->{autolearn};
-        $learn = "learn=". $sa_results->{autolearn};
+    if ( $al ) {
+        $self->adjust_karma( 1 )  if $al eq 'ham';
+        $self->adjust_karma( -1 ) if $al eq 'spam';
+        $learn = "learn=". $al;
     };
 
     my $reject = $self->{_args}{reject} or do {
@@ -413,8 +419,6 @@ sub reject {
         }
     }
 
-    $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");
 }
@@ -473,7 +477,7 @@ sub parse_spam_header {
     }
     $r{is_spam} = $is_spam;
 
-    # backwards compatibility for SA versions < 3
+    # compatibility for SA versions < 3
     if ( defined $r{hits} && ! defined $r{score} ) {
         $r{score} = delete $r{hits};
     };

plugins/virus/clamdscan

@@ -168,10 +168,7 @@ sub data_post_handler {
         $self->log( LOGNOTICE, "fail, found virus $found" );
 
         $self->connection->notes('naughty', 1); # see plugins/naughty
-
+        $self->adjust_karma( -1 );
-        if ( defined $self->connection->notes('karma') ) {
-            $self->connection->notes('karma', ($self->connection->notes('karma') - 1));
-        };
 
         if ( $self->{_args}{deny_viruses} ) {
             return ( DENY, "Virus found: $found" );

plugins/whitelist

@@ -1,3 +1,4 @@
+#!perl -w
 
 =head1 NAME
 
@@ -97,7 +98,6 @@ automatically allow relaying from that IP.
 use strict;
 use warnings;
 
-use lib 'lib';
 use Qpsmtpd::Constants;
 
 my $VERSION = 0.02;
@@ -138,7 +138,8 @@ sub check_host {
     # From tcpserver
     if (exists $ENV{WHITELISTCLIENT}) {
         $self->qp->connection->notes('whitelistclient', 1);
-        $self->log(2, "pass, host $ip is a whitelisted client");
+        $self->log(2, "pass, is whitelisted client");
+        $self->adjust_karma( 5 );
         return OK;
     }
 
@@ -146,7 +147,8 @@ sub check_host {
     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, "pass, host $ip is a whitelisted host");
+            $self->log(2, "pass, is a whitelisted host");
+            $self->adjust_karma( 5 );
             return OK;
         }
     }