From a69cd6bf64c31e46d66f44d3965d151c74a722f2 Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Wed, 23 May 2012 22:58:32 -0400
Subject: [PATCH 01/24] basicheaders: adding missing semicolon, fixed POD error

---
 plugins/check_basicheaders | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/plugins/check_basicheaders b/plugins/check_basicheaders
index 944ae9d..9d1589d 100644
--- a/plugins/check_basicheaders
+++ b/plugins/check_basicheaders
@@ -35,7 +35,7 @@ I would be surprised if a valid message ever had a date header older than a week
 
 Determine if the connection is denied. Use the I<reject 0> option when first enabling the plugin, and then watch your logs to see what would have been rejected. When you are no longer concerned that valid messages will be rejected, enable with I<reject 1>.
 
-  check_basicheaders [ reject 0 | 1 ]
+  check_basicheaders reject [ 0 | 1 ]
 
 Default policy is to reject.
 
@@ -116,7 +116,7 @@ sub hook_data_post {
 
     if ( ! $header->get('From') ) {
         $self->log(LOGINFO, "fail: no from");
-        return ($deny, "We require a valid From header")
+        return ($deny, "We require a valid From header");
     };
 
     my $date = $header->get('Date') or do {

From bf5f1db436dacc72127836f2bb2f6bb44423ab4b Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Fri, 18 May 2012 03:40:34 -0400
Subject: [PATCH 02/24] delete 3 relay plugins

---
 plugins/check_norelay | 58 ------------------------------
 plugins/check_relay   | 83 -------------------------------------------
 plugins/relay_only    | 36 -------------------
 3 files changed, 177 deletions(-)
 delete mode 100644 plugins/check_norelay
 delete mode 100644 plugins/check_relay
 delete mode 100644 plugins/relay_only

diff --git a/plugins/check_norelay b/plugins/check_norelay
deleted file mode 100644
index 5e317bc..0000000
--- a/plugins/check_norelay
+++ /dev/null
@@ -1,58 +0,0 @@
-#!perl -w
-=pod
-
-=head1 SYNOPSIS
-
-This plugin checks the norelayclients config file to see if 
-relaying is denied.
-
-This allows specific clients, such as the gateway, to be denied 
-relaying, even though they would be allowed relaying by the 
-relayclients file.
-
-=head1 CONFIG
-
-config/norelayclients
-
-Each line is:
-- a full IP address
-- partial IP address terminated by a dot for matching whole networks
-  e.g. 192.168.42.
-
-=head1 BUGS AND LIMITATIONS
-
-This plugin does not have a more_norelayclients map equivalent
-of the more_relayclients map of the check_relay plugin.
-
-=head1 AUTHOR
-
-Based on check_relay plugin from the qpsmtpd distribution.
-
-Copyright 2005 Gordon Rowell <gordonr@gormand.com.au>
-
-This software is free software and may be distributed under the same
-terms as qpsmtpd itself.
-
-=cut
-
-sub hook_connect {
-  my ($self, $transaction) = @_;
-  my $connection = $self->qp->connection;
-
-  # Check if this IP is not allowed to relay
-  my @no_relay_clients = $self->qp->config("norelayclients");
-  my %no_relay_clients = map { $_ => 1 } @no_relay_clients;
-  my $client_ip = $self->qp->connection->remote_ip;
-  while ($client_ip) {
-    if ( exists($no_relay_clients{$client_ip}) )
-    {
-      $connection->relay_client(0);
-      delete $ENV{RELAYCLIENT};
-      $self->log(LOGNOTICE, "check_norelay: $client_ip denied relaying");
-      last;
-    }
-    $client_ip =~ s/\d+\.?$//; # strip off another 8 bits
-  }
-  
-  return (DECLINED);
-}
diff --git a/plugins/check_relay b/plugins/check_relay
deleted file mode 100644
index 06034e7..0000000
--- a/plugins/check_relay
+++ /dev/null
@@ -1,83 +0,0 @@
-#!perl -w
-
-=head1 NAME
-
-check_relay
-
-=head1 SYNOPSIS
-
-Checks the relayclients config file and $ENV{RELAYCLIENT} to see if relaying is allowed.
-
-=cut
-
-use strict;
-use warnings;
-
-use Qpsmtpd::Constants;
-use Net::IP qw(:PROC);
-
-sub hook_connect {
-  my ($self, $transaction) = @_;
-  my $connection = $self->qp->connection;
-
-  # Check if this IP is allowed to relay
-  my $client_ip = $self->qp->connection->remote_ip;
-
-  # @crelay... for comparing, @srelay... for stripping
-  my (@crelay_clients, @srelay_clients);
-
-  my @relay_clients = $self->qp->config("relayclients");
-  for (@relay_clients) {
-    my ($range_ip, $range_prefix) = ip_splitprefix($_);
-    if($range_prefix){
-      # has a prefix, so due for comparing
-      push @crelay_clients, $_;
-    }
-    else {
-      # has no prefix, so due for splitting
-      push @srelay_clients, $_;
-    }
-  }
-  
-  if (@crelay_clients){
-    my ($range_ip, $range_prefix, $rversion, $begin, $end, $bin_client_ip);
-    my $cversion = ip_get_version($client_ip);
-    for (@crelay_clients) {
-      # Get just the IP from the CIDR range, to get the IP version, so we can
-      # get the start and end of the range
-      ($range_ip, $range_prefix) = ip_splitprefix($_);
-      $rversion = ip_get_version($range_ip);
-      ($begin, $end) = ip_normalize($_, $rversion);
-
-      # expand the client address (zero pad it) before converting to binary
-      $bin_client_ip = ip_iptobin(ip_expand_address($client_ip, $cversion), $cversion);
-
-      if (ip_bincomp($bin_client_ip, 'gt', ip_iptobin($begin, $rversion)) 
-        && ip_bincomp($bin_client_ip, 'lt', ip_iptobin($end, $rversion)))
-      {
-        $connection->relay_client(1);
-        last;
-      }
-    }
-  }
-
-  # If relay_client is already set, no point checking again
-  if (@srelay_clients && !$connection->relay_client) {
-    my $more_relay_clients = $self->qp->config("morerelayclients", "map");
-    my %srelay_clients = map { $_ => 1 } @srelay_clients;
-    $client_ip =~ s/::/:/;
-	($connection->relay_client(1) && undef($client_ip)) if $client_ip eq ":1";
-
-    while ($client_ip) {
-      if (exists($ENV{RELAYCLIENT}) or
-          exists($srelay_clients{$client_ip}) or
-          exists($more_relay_clients->{$client_ip}))
-      {
-        $connection->relay_client(1);
-        last;
-      }
-      $client_ip =~ s/(\d|\w)+(:|\.)?$//; # strip off another 8 bits
-    }
-  }
-  return (DECLINED);
-}
diff --git a/plugins/relay_only b/plugins/relay_only
deleted file mode 100644
index e6414e9..0000000
--- a/plugins/relay_only
+++ /dev/null
@@ -1,36 +0,0 @@
-#!perl -w
-
-=head1 NAME
-
-relay_only - this plugin only permits relaying
-
-=head1 SYNOPSIS
-
-# in config/plugins
-
-check_relay
-
-relay_only
-
-# other rcpt hooks go here
-
-=head1 DESCRIPTION
-
-This plugin can be used for the case where a server is used as the smart
-relay host for internal users and external/authenticated users, but should
-not be considered a normal inbound MX server
-
-It should be configured to be run _AFTER_ check_relay and before other
-RCPT hooks!  Only clients that have authenticated or are listed in the
-relayclient file will be allowed to send mail.
-
-=cut
-
-sub hook_rcpt {
-  if ( shift->qp->connection->relay_client ) {
-    return (OK);
-  }
-  else {
-    return (DENY);
-  }
-}

From 974f1a95e8dd4e381052ef4ae7da316731f07001 Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Fri, 18 May 2012 03:43:06 -0400
Subject: [PATCH 03/24] new relay plugin, with tests!

replaces functionality of previous 3 relay plugins
---
 config.sample/norelayclients |   5 +
 config.sample/plugins        |   8 +-
 plugins/relay                | 237 +++++++++++++++++++++++++++++++++++
 t/plugin_tests/relay         |  81 ++++++++++++
 4 files changed, 327 insertions(+), 4 deletions(-)
 create mode 100644 config.sample/norelayclients
 create mode 100644 plugins/relay
 create mode 100644 t/plugin_tests/relay

diff --git a/config.sample/norelayclients b/config.sample/norelayclients
new file mode 100644
index 0000000..0ad5e1a
--- /dev/null
+++ b/config.sample/norelayclients
@@ -0,0 +1,5 @@
+# sample entries, used for testing
+192.168.99.5
+192.168.99.6
+192.168.98.
+# add your own entries below...
diff --git a/config.sample/plugins b/config.sample/plugins
index 785c7f7..bbcf50a 100644
--- a/config.sample/plugins
+++ b/config.sample/plugins
@@ -32,7 +32,7 @@ quit_fortune
 #tls
 check_earlytalker
 count_unrecognized_commands 4
-check_relay
+relay
 
 require_resolvable_fromhost
 
@@ -85,6 +85,6 @@ dspam learn_from_sa 7 reject 1
 
 # If you need to run the same plugin multiple times, you can do
 # something like the following
-#    check_relay
-#    check_relay:0 somearg
-#    check_relay:1 someotherarg
+#    relay
+#    relay:0 somearg
+#    relay:1 someotherarg
diff --git a/plugins/relay b/plugins/relay
new file mode 100644
index 0000000..d8a643b
--- /dev/null
+++ b/plugins/relay
@@ -0,0 +1,237 @@
+#!perl -w
+
+=head1 SYNOPSIS
+
+relay - control whether relaying is permitted
+
+=head1 DESCRIPTION
+
+relay - check the following places to see if relaying is allowed:
+
+I<$ENV{RELAYCLIENT}>
+
+I<config/norelayclients>, I<config/relayclients>, I<config/morerelayclients> 
+
+The search order is as shown and cascades until a match is found or the list
+is exhausted. 
+
+Note that I<norelayclients> is the first file checked. A match there will
+override matches in the subsequent files.
+
+=head1 CONFIG
+
+Enable this plugin by adding it to config/plugins above the rcpt_* plugins
+
+ # other plugins...
+
+ relay
+
+ # rcpt_* go here
+
+=head2 relayclients
+
+A list of IP addresses that are permitted to relay mail through this server.
+
+Each line in I<relayclients> is one of:
+ - a full IP address
+
+ - partial IP address terminated by a dot or colon for matching whole networks
+     192.168.42.
+     fdda:b13d:e431:ae06:
+     ...
+
+ - a network/mask, aka a CIDR block
+     10.1.0.0/24
+     fdda:b13d:e431:ae06::/64
+     ...
+
+=head2 morerelayclients
+
+Additional IP addresses that are permitted to relay. The syntax of the config
+file is identical to I<relayclients> except that CIDR (net/mask) entries are
+not supported. If you have many (>50) IPs allowed to relay, most should likely
+be listed in I<morerelayclients> where lookups are faster.
+
+
+=head2 norelayclients
+
+I<norelayclients> allows specific clients, such as a mail gateway, to be denied
+relaying, even though they would be allowed by I<relayclients>. This is most
+useful when a block of IPs is allowed in relayclients, but several IPs need to
+be excluded.
+
+The file format is the same as morerelayclients.
+
+=head2 RELAY ONLY
+
+The relay only option restricts connections to only clients that have relay
+permission. All other connections are denied during the RCPT phase of the
+SMTP conversation.
+
+This option is useful when a server is used as the smart relay host for
+internal users and external/authenticated users, but should not be considered
+a normal inbound MX server.
+
+It should be configured to be run before other RCPT hooks! Only clients that
+have authenticated or are listed in the relayclient file will be allowed to
+send mail.
+
+To enable relay only mode, set the B<only> option to any true value in
+I<config/plugins> as shown:
+
+  relay only 1
+
+=head1 AUTHOR
+
+2012 - Matt Simerson - Merged check_relay, check_norelay, and relayonly
+
+2005 - check_norelay - Copyright Gordon Rowell <gordonr@gormand.com.au>
+
+200? - check_relay plugin
+
+200? - relay_only plugin
+
+=head1 LICENSE
+
+This software is free software and may be distributed under the same
+terms as qpsmtpd itself.
+
+=cut
+
+use strict;
+use warnings;
+
+use Qpsmtpd::Constants;
+use Net::IP qw(:PROC);
+
+sub register {
+    my ($self, $qp) = shift, shift;
+    $self->log(LOGERROR, "Bad arguments") if @_ % 2;
+    $self->{_args} = { @_ };
+
+    if ( $self->{_args}{only} ) {
+        $self->register_hook('rcpt', 'relay_only');
+    };
+};
+
+sub is_in_norelayclients {
+    my $self = shift;
+
+    my %no_relay_clients = map { $_ => 1 } $self->qp->config('norelayclients');
+
+    my $ip = $self->qp->connection->remote_ip;
+
+    while ( $ip ) {
+        if ( exists $no_relay_clients{$ip} ) {
+            $self->log(LOGNOTICE, "$ip in norelayclients");
+            return 1;
+        }
+        $ip =~ s/(\d|\w)+(:|\.)?$// or last; # strip off another octet
+    };
+
+    $self->log(LOGDEBUG, "no match in norelayclients");
+    return;
+};
+
+sub populate_relayclients {
+    my $self = shift;
+
+    foreach ( $self->qp->config('relayclients') ) {
+        my ($network, $netmask) = ip_splitprefix($_);
+        if ( $netmask ) {
+            push @{ $self->{_cidr_blocks} }, $_;
+            next;
+        }
+        $self->{_octets}{$_} = 1;   # no prefix, split
+    }
+};
+
+sub is_in_cidr_block {
+    my $self = shift;
+
+    my $ip = $self->qp->connection->remote_ip;
+    my $cversion = ip_get_version($ip);
+    for ( @{ $self->{_cidr_blocks} } ) {
+        my ($network, $mask) = ip_splitprefix($_); # split IP & CIDR range
+        my $rversion = ip_get_version($network);   # get IP version (4 vs 6)
+        my ($begin, $end) = ip_normalize($_, $rversion); # get pool start/end
+
+# expand the client address (zero pad it) before converting to binary
+        my $bin_ip = ip_iptobin(ip_expand_address($ip, $cversion), $cversion);
+
+        if (    ip_bincomp($bin_ip, 'gt', ip_iptobin($begin, $rversion)) 
+             && ip_bincomp($bin_ip, 'lt', ip_iptobin($end,   $rversion))
+           ) {
+            $self->log(LOGINFO, "pass: cidr match ($ip)");
+            return 1;
+        }
+    }
+
+    $self->log(LOGDEBUG, "no cidr match");
+    return;
+};
+
+sub is_octet_match {
+    my $self = shift;
+
+    my $ip = $self->qp->connection->remote_ip;
+    $ip =~ s/::/:/;
+
+    if ( $ip eq ':1' ) {
+        $self->log(LOGINFO, "pass: octet matched localhost ($ip)");
+        return 1;
+    };
+
+    my $more_relay_clients = $self->qp->config('morerelayclients', 'map');
+
+    while ($ip) {
+        if ( exists $self->{_octets}{$ip} ) {
+            $self->log(LOGINFO, "pass: octet match in relayclients ($ip)");
+            return 1;
+        };
+
+        if ( exists $more_relay_clients->{$ip} ) {
+            $self->log(LOGINFO, "pass: octet match in morerelayclients ($ip)");
+            return 1;
+        };
+        $ip =~ s/(\d|\w)+(:|\.)?$// or last; # strip off another 8 bits
+    }
+
+    $self->log(LOGDEBUG, "no octet match" );
+    return;
+}
+
+sub hook_connect {
+    my ($self, $transaction) = @_;
+
+    if ( $self->is_in_norelayclients() ) {
+        $self->qp->connection->relay_client(0);
+        delete $ENV{RELAYCLIENT};
+        return (DECLINED);
+    }
+
+    if ( $ENV{RELAYCLIENT} ) {
+        $self->qp->connection->relay_client(1);
+        $self->log(LOGINFO, "pass: enabled by env");
+        return (DECLINED);
+    };
+
+    $self->populate_relayclients();
+
+    if ( $self->is_in_cidr_block() || $self->is_octet_match() ) {
+        $self->qp->connection->relay_client(1);
+        return (DECLINED);
+    };
+
+    $self->log(LOGINFO, "skip: no match");
+    return (DECLINED);
+}
+
+sub relay_only {
+    my $self = shift;
+    if ( $self->qp->connection->relay_client ) {
+        return (OK);
+    };
+    return (DENY);
+}
+
diff --git a/t/plugin_tests/relay b/t/plugin_tests/relay
new file mode 100644
index 0000000..3d1b91e
--- /dev/null
+++ b/t/plugin_tests/relay
@@ -0,0 +1,81 @@
+#!perl -w
+
+use strict;
+use warnings;
+
+use Qpsmtpd::Constants;
+
+sub register_tests {
+    my $self = shift;
+
+    $self->register_test('test_relay_only', 2);
+    $self->register_test('test_is_octet_match', 3);
+    $self->register_test('test_is_in_cidr_block', 4);
+    $self->register_test('test_is_in_norelayclients', 5);
+}
+
+sub test_relay_only {
+    my $self = shift;
+
+    $self->qp->connection->relay_client(0);
+    my $r = $self->relay_only();
+    cmp_ok( $r, '==', DENY, "relay_only -");
+
+    $self->qp->connection->relay_client(1);
+    $r = $self->relay_only();
+    cmp_ok( $r, '==', OK, "relay_only +");
+
+    $self->qp->connection->relay_client(0);
+};
+
+sub test_is_octet_match {
+    my $self = shift;
+
+    $self->populate_relayclients();
+
+    $self->qp->connection->remote_ip('192.168.1.1');
+    ok( $self->is_octet_match(), "match, +");
+
+    $self->qp->connection->remote_ip('192.169.1.1');
+    ok( ! $self->is_octet_match(), "nope, -");
+
+    $self->qp->connection->remote_ip('10.10.10.10');
+    ok( ! $self->is_octet_match(), "nope, -");
+};
+
+sub test_is_in_cidr_block {
+    my $self = shift;
+
+    $self->qp->connection->remote_ip('192.168.1.1');
+    $self->{_cidr_blocks} = [ '192.168.1.0/24' ];
+    ok( $self->is_in_cidr_block(), "match, +" );
+
+    $self->{_cidr_blocks} = [ '192.168.0.0/24' ];
+    ok( ! $self->is_in_cidr_block(), "nope, -" );
+
+
+    $self->qp->connection->remote_ip('fdda:b13d:e431:ae06:00a1::');
+    $self->{_cidr_blocks} = [ 'fdda:b13d:e431:ae06::/64' ];
+    ok( $self->is_in_cidr_block(), "match, +" );
+
+    $self->{_cidr_blocks} = [ 'fdda:b13d:e431:be17::' ];
+    ok( ! $self->is_in_cidr_block(), "nope, -" );
+};
+
+sub test_is_in_norelayclients {
+    my $self = shift;
+
+    my @matches = qw/ 192.168.99.5 192.168.98.1 192.168.98.255 /;
+    my @false = qw/ 192.168.99.7 192.168.109.7 /;
+
+    foreach ( @matches ) {
+        $self->qp->connection->remote_ip($_);
+        ok( $self->is_in_norelayclients(), "match, + ($_)");
+    };
+
+    foreach ( @false ) {
+        $self->qp->connection->remote_ip($_);
+        ok( ! $self->is_in_norelayclients(), "match, + ($_)");
+    };
+};
+

From 2727b8529cea314bdae9bc551c9919c530308025 Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Mon, 21 May 2012 15:02:12 -0400
Subject: [PATCH 04/24] relay: added note to UPGRADING, dates to plugin author

---
 plugins/relay | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/plugins/relay b/plugins/relay
index d8a643b..5a2086a 100644
--- a/plugins/relay
+++ b/plugins/relay
@@ -85,11 +85,11 @@ I<config/plugins> as shown:
 
 2012 - Matt Simerson - Merged check_relay, check_norelay, and relayonly
 
+2006 - relay_only  - John Peackock
+
 2005 - check_norelay - Copyright Gordon Rowell <gordonr@gormand.com.au>
 
-200? - check_relay plugin
-
-200? - relay_only plugin
+2002 - check_relay - Ask Bjorn Hansen
 
 =head1 LICENSE
 

From 8795d4fd6e6a5cd1b0f12b63dd91b466b83c87f3 Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Mon, 21 May 2012 15:36:37 -0400
Subject: [PATCH 05/24] relay: use IETF IP testing addresses

---
 config.sample/norelayclients |  8 ++++----
 config.sample/relayclients   |  2 +-
 t/plugin_tests/relay         | 16 ++++++++--------
 3 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/config.sample/norelayclients b/config.sample/norelayclients
index 0ad5e1a..5fab985 100644
--- a/config.sample/norelayclients
+++ b/config.sample/norelayclients
@@ -1,5 +1,5 @@
-# sample entries, used for testing
-192.168.99.5
-192.168.99.6
-192.168.98.
+# test entries - http://tools.ietf.org/html/rfc5737
+192.0.99.5
+192.0.99.6
+192.0.98.
 # add your own entries below...
diff --git a/config.sample/relayclients b/config.sample/relayclients
index 5bbb91d..13c9be7 100644
--- a/config.sample/relayclients
+++ b/config.sample/relayclients
@@ -2,4 +2,4 @@
 # e.g. "127.0.0.1", or "192.168."
 127.0.0.1 
 # leading/trailing whitespace is ignored
- 192.168. 
+ 192.0. 
diff --git a/t/plugin_tests/relay b/t/plugin_tests/relay
index 3d1b91e..988c184 100644
--- a/t/plugin_tests/relay
+++ b/t/plugin_tests/relay
@@ -33,24 +33,24 @@ sub test_is_octet_match {
 
     $self->populate_relayclients();
 
-    $self->qp->connection->remote_ip('192.168.1.1');
+    $self->qp->connection->remote_ip('192.0.1.1');
     ok( $self->is_octet_match(), "match, +");
 
-    $self->qp->connection->remote_ip('192.169.1.1');
+    $self->qp->connection->remote_ip('192.51.1.1');
     ok( ! $self->is_octet_match(), "nope, -");
 
-    $self->qp->connection->remote_ip('10.10.10.10');
+    $self->qp->connection->remote_ip('203.0.113.0');
     ok( ! $self->is_octet_match(), "nope, -");
 };
 
 sub test_is_in_cidr_block {
     my $self = shift;
 
-    $self->qp->connection->remote_ip('192.168.1.1');
-    $self->{_cidr_blocks} = [ '192.168.1.0/24' ];
+    $self->qp->connection->remote_ip('192.0.1.1');
+    $self->{_cidr_blocks} = [ '192.0.1.0/24' ];
     ok( $self->is_in_cidr_block(), "match, +" );
 
-    $self->{_cidr_blocks} = [ '192.168.0.0/24' ];
+    $self->{_cidr_blocks} = [ '192.0.0.0/24' ];
     ok( ! $self->is_in_cidr_block(), "nope, -" );
 
 
@@ -65,8 +65,8 @@ sub test_is_in_cidr_block {
 sub test_is_in_norelayclients {
     my $self = shift;
 
-    my @matches = qw/ 192.168.99.5 192.168.98.1 192.168.98.255 /;
-    my @false = qw/ 192.168.99.7 192.168.109.7 /;
+    my @matches = qw/ 192.0.99.5 192.0.98.1 192.0.98.255 /;
+    my @false = qw/ 192.0.99.7 192.0.109.7 /;
 
     foreach ( @matches ) {
         $self->qp->connection->remote_ip($_);

From 732202ae37763edc1c26d50935258ba24412c814 Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Mon, 21 May 2012 16:35:24 -0400
Subject: [PATCH 06/24] another test tweak, for switching from 192.168 to 192.0

---
 t/config.t | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/t/config.t b/t/config.t
index 2def46c..f134e7a 100644
--- a/t/config.t
+++ b/t/config.t
@@ -20,7 +20,7 @@ is($smtpd->config('me'), 'some.host.example.org', 'config("me")');
 # test for ignoring leading/trailing whitespace (relayclients has a
 # line with both)
 my $relayclients = join ",", sort $smtpd->config('relayclients');
-is($relayclients, '127.0.0.1,192.168.', 'config("relayclients") are trimmed');
+is($relayclients, '127.0.0.1,192.0.', 'config("relayclients") are trimmed');
 
 unlink "./config.sample/me";
 

From 2910702a4d50c09f45802e5e8765f48c4e6d7f5a Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Mon, 21 May 2012 21:58:24 -0400
Subject: [PATCH 07/24] relay: update MANIFEST

---
 MANIFEST | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/MANIFEST b/MANIFEST
index 9a7654e..ed6a279 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -78,8 +78,7 @@ plugins/check_bogus_bounce
 plugins/check_basicheaders
 plugins/check_earlytalker
 plugins/check_loop
-plugins/check_norelay
-plugins/check_relay
+plugins/relay
 plugins/check_spamhelo
 plugins/connection_time
 plugins/content_log
@@ -114,7 +113,6 @@ plugins/quit_fortune
 plugins/random_error
 plugins/rcpt_ok
 plugins/rcpt_regexp
-plugins/relay_only
 plugins/require_resolvable_fromhost
 plugins/rhsbl
 plugins/sender_permitted_from

From 5a8a9be26c11a0559c16ccabca9191aa5d5d5903 Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Sun, 20 May 2012 21:46:47 -0400
Subject: [PATCH 08/24] make SPF level 2 a little more lenient

---
 plugins/sender_permitted_from | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/plugins/sender_permitted_from b/plugins/sender_permitted_from
index 2353493..17805f1 100644
--- a/plugins/sender_permitted_from
+++ b/plugins/sender_permitted_from
@@ -167,7 +167,7 @@ sub hook_rcpt {
     }
     elsif ( $code eq 'permerror' ) {
         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 'temperror' ) {
         return (DENYSOFT, "SPF - $code: $why") if $reject >= 2;

From 1a1dcc3e5302983d73a41e3db8bf99abb79fa44e Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Mon, 21 May 2012 16:11:49 -0400
Subject: [PATCH 09/24] auth: eval 'use' so plugins can be enabled by default

and tested.
---
 config.sample/plugins                | 4 ++++
 config.sample/smtpauth-checkpassword | 1 +
 plugins/auth/auth_vpopmail           | 4 ++--
 plugins/auth/auth_vpopmail_sql       | 9 ++++++++-
 4 files changed, 15 insertions(+), 3 deletions(-)
 create mode 100644 config.sample/smtpauth-checkpassword

diff --git a/config.sample/plugins b/config.sample/plugins
index bbcf50a..fe51829 100644
--- a/config.sample/plugins
+++ b/config.sample/plugins
@@ -45,6 +45,10 @@ check_spamhelo
 # sender_permitted_from
 # greylisting p0f genre,windows
 
+auth/auth_checkpassword checkpw /usr/local/vpopmail/bin/vchkpw true /usr/bin/true
+auth/auth_vpopmail
+auth/auth_vpopmaild
+auth/auth_vpopmail_sql
 auth/auth_flat_file
 auth/authdeny
 
diff --git a/config.sample/smtpauth-checkpassword b/config.sample/smtpauth-checkpassword
new file mode 100644
index 0000000..a029f3d
--- /dev/null
+++ b/config.sample/smtpauth-checkpassword
@@ -0,0 +1 @@
+/usr/local/vpopmail/bin/vchkpw /bin/true
diff --git a/plugins/auth/auth_vpopmail b/plugins/auth/auth_vpopmail
index 43720c6..91a5ac6 100644
--- a/plugins/auth/auth_vpopmail
+++ b/plugins/auth/auth_vpopmail
@@ -45,7 +45,7 @@ use warnings;
 use Qpsmtpd::Auth;
 use Qpsmtpd::Constants;
 
-#use vpopmail;    # we eval this in $test_vpopmail
+#use vpopmail;    # we eval this in $test_vpopmail_module
 
 sub register {
     my ($self, $qp) = @_;
@@ -86,7 +86,7 @@ sub test_vpopmail_module {
     my $self = shift;
 # vpopmail will not allow vauth_getpw to succeed unless the requesting user is vpopmail or root.
 # by default, qpsmtpd runs as the user 'qpsmtpd' and does not have permission.
-    eval "use vpopmail";
+    eval 'use vpopmail';
     if ( $@ ) {
         $self->log(LOGERROR, "skip: is vpopmail perl module installed?");
         return;
diff --git a/plugins/auth/auth_vpopmail_sql b/plugins/auth/auth_vpopmail_sql
index ca00531..dd9b3cb 100644
--- a/plugins/auth/auth_vpopmail_sql
+++ b/plugins/auth/auth_vpopmail_sql
@@ -69,11 +69,18 @@ use warnings;
 use Qpsmtpd::Auth;
 use Qpsmtpd::Constants;
 
-use DBI;
+#use DBI;  # done in ->register
 
 sub register {
     my ( $self, $qp ) = @_;
 
+    eval 'use DBI';
+    if ( $@ ) {
+        warn "plugin disabled. is DBI installed?\n";
+        $self->log(LOGERROR, "skip: plugin disabled. is DBI installed?\n");
+        return;
+    };
+
     $self->register_hook('auth-plain',    'auth_vmysql');
     $self->register_hook('auth-login',    'auth_vmysql');
     $self->register_hook('auth-cram-md5', 'auth_vmysql');

From 55b5f343655e1e4e320f145010d043f73b9ef97b Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Mon, 21 May 2012 18:06:22 -0400
Subject: [PATCH 10/24] auth_vpopmail_sql test, eval 'use DBI' before testing

---
 t/plugin_tests/auth/auth_vpopmail     |  2 +-
 t/plugin_tests/auth/auth_vpopmail_sql | 13 +++++++++----
 2 files changed, 10 insertions(+), 5 deletions(-)

diff --git a/t/plugin_tests/auth/auth_vpopmail b/t/plugin_tests/auth/auth_vpopmail
index fb9c724..5213890 100644
--- a/t/plugin_tests/auth/auth_vpopmail
+++ b/t/plugin_tests/auth/auth_vpopmail
@@ -23,7 +23,7 @@ sub test_auth_vpopmail {
 
     if ( ! $self->test_vpopmail_module ) {
         warn "vpopmail plugin not configured\n";
-        foreach ( 0..2) { ok( 1, "test_auth_vpopmail, skipped") };
+        foreach ( 0..2) { ok( 1, "skipped") };
         return;
     };
 
diff --git a/t/plugin_tests/auth/auth_vpopmail_sql b/t/plugin_tests/auth/auth_vpopmail_sql
index 0e6c84e..1af4871 100644
--- a/t/plugin_tests/auth/auth_vpopmail_sql
+++ b/t/plugin_tests/auth/auth_vpopmail_sql
@@ -6,6 +6,11 @@ use warnings;
 sub register_tests {
     my $self = shift;
 
+    eval 'use DBI';
+    if ( $@ ) {
+        warn "skipping auth_vpopmail_sql tests, is DBI installed?\n";
+        return;
+    };
     $self->register_test("auth_vpopmail_sql", 3);
 }
 
@@ -15,7 +20,7 @@ sub auth_vpopmail_sql {
 
     my $dbh = $self->get_db_handle() or do {
             foreach ( 0..2 ) {
-                ok( 1, "auth_vpopmail_sql, skipped (no DB)" );
+                ok( 1, "skipped (no DB)" );
             };
             return;
         };
@@ -24,11 +29,11 @@ sub auth_vpopmail_sql {
     my $vuser = $self->get_vpopmail_user( $dbh, 'postmaster@example.com' );
     if ( ! $vuser || ! $vuser->{pw_passwd} ) {
         foreach ( 0..1 ) {
-            ok( 1, "auth_vpopmail_sql, no example.com domain" );
+            ok( 1, "no example.com domain" );
         };
         return;
     };
-    ok( ref $vuser, "auth_vpopmail_sql, found example.com domain" );
+    ok( ref $vuser, "found example.com domain" );
 
     ok( $self->auth_vmysql(
             $self->qp->transaction,
@@ -38,6 +43,6 @@ sub auth_vpopmail_sql {
             $vuser->{pw_passwd},
             $ticket,
         ),
-        "auth_vpopmail_sql, postmaster"
+        "postmaster"
     );
 }

From c61fb67e9b654d5472ca576c8fa59b8559789cb7 Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Mon, 21 May 2012 18:08:39 -0400
Subject: [PATCH 11/24] checkpassword: remove newlines that appeared

---
 plugins/auth/auth_checkpassword | 1 +
 1 file changed, 1 insertion(+)

diff --git a/plugins/auth/auth_checkpassword b/plugins/auth/auth_checkpassword
index 4f4f9a2..28d7894 100644
--- a/plugins/auth/auth_checkpassword
+++ b/plugins/auth/auth_checkpassword
@@ -124,6 +124,7 @@ sub auth_checkpassword {
 
     my $binary = $self->connection->notes('auth_checkpassword_bin');
     my $true = $self->connection->notes('auth_checkpassword_true');
+    chomp ($binary, $true);
 
     my $sudo = get_sudo($binary);
 

From 9e70da4951d3544d771ce2ca06fa07e8cc0a5c8d Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Mon, 21 May 2012 18:17:34 -0400
Subject: [PATCH 12/24] auth: adding tests (should have attached with a
 previous commit)

---
 t/Test/Qpsmtpd/Plugin.pm | 55 +++-------------------------------------
 1 file changed, 3 insertions(+), 52 deletions(-)

diff --git a/t/Test/Qpsmtpd/Plugin.pm b/t/Test/Qpsmtpd/Plugin.pm
index 6e7773d..cafa0d0 100644
--- a/t/Test/Qpsmtpd/Plugin.pm
+++ b/t/Test/Qpsmtpd/Plugin.pm
@@ -5,8 +5,10 @@ package Test::Qpsmtpd::Plugin;
 package Qpsmtpd::Plugin;
 
 use strict;
-use Test::More;
+use warnings;
+
 use Qpsmtpd::Constants;
+use Test::More;
 
 sub register_tests {
     # Virtual base method - implement in plugin
@@ -38,55 +40,4 @@ sub run_tests {
     }
 }
 
-sub validate_password {
-    my ( $self, %a ) = @_;
-
-    my ($pkg, $file, $line) = caller();
-
-    my $src_clear     = $a{src_clear};
-    my $src_crypt     = $a{src_crypt};
-    my $attempt_clear = $a{attempt_clear};
-    my $attempt_hash  = $a{attempt_hash};
-    my $method        = $a{method} or die "missing method";
-    my $ticket        = $a{ticket};
-    my $deny          = $a{deny} || DENY;
-
-    if ( ! $src_crypt && ! $src_clear ) {
-        $self->log(LOGINFO, "fail: missing password");
-        return ( $deny, "$file - no such user" );
-    };
-
-    if ( ! $src_clear && $method =~ /CRAM-MD5/i ) {
-        $self->log(LOGINFO, "skip: cram-md5 not supported w/o clear pass");
-        return ( DECLINED, $file );
-    }
-
-    if ( defined $attempt_clear ) {
-        if ( $src_clear && $src_clear eq $attempt_clear ) {
-            $self->log(LOGINFO, "pass: clear match");
-            return ( OK, $file );
-        };
-
-        if ( $src_crypt && $src_crypt eq crypt( $attempt_clear, $src_crypt ) ) {
-            $self->log(LOGINFO, "pass: crypt match");
-            return ( OK, $file );
-        }
-    };
-
-    if ( defined $attempt_hash && $src_clear ) {
-        if ( ! $ticket ) {
-            $self->log(LOGERROR, "skip: missing ticket");
-            return ( DECLINED, $file );
-        };
-
-        if ( $attempt_hash eq hmac_md5_hex( $ticket, $src_clear ) ) {
-            $self->log(LOGINFO, "pass: hash match");
-            return ( OK, $file );
-        };
-    };
-
-    $self->log(LOGINFO, "fail: wrong password");
-    return ( $deny, "$file - wrong password" );
-};
-
 1;

From 7713333d318e99e1af683560fcd3dbd0918380ae Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Wed, 30 May 2012 14:01:25 -0400
Subject: [PATCH 13/24] p0f: POD improvements

---
 plugins/ident/p0f | 50 +++++++++++++++++++++++++----------------------
 1 file changed, 27 insertions(+), 23 deletions(-)

diff --git a/plugins/ident/p0f b/plugins/ident/p0f
index 2386980..d820cc7 100644
--- a/plugins/ident/p0f
+++ b/plugins/ident/p0f
@@ -11,9 +11,9 @@ implement more sophisticated anti-spam policies.
 
 =head1 DESCRIPTION
 
-This p0f module inserts a 'p0f' note that other qpsmtpd plugins can inspect.
-It includes the following information about the TCP fingerprint (link,
-detail, distance, uptime, genre). Here's an example connection note:
+This p0f module inserts a I<p0f> connection note with information deduced
+from the TCP fingerprint. The note typically includes at least the link,
+detail, distance, uptime, genre. Here's a p0f v2 example:
 
  genre    => FreeBSD
  detail   => 6.x (1)
@@ -26,20 +26,29 @@ Which was parsed from this p0f fingerprint:
   24.18.227.2:39435 - FreeBSD 6.x (1) (up: 1390 hrs)
     -> 208.75.177.101:25 (distance 17, link: ethernet/modem)
 
+When using p0f v3, the following additional values may also be available in
+the I<p0f> connection note:
+
+=over 4
+
+magic, status, first_seen, last_seen, total_conn, uptime_min, up_mod_days, last_nat, last_chg, distance, bad_sw, os_match_q, os_name, os_flavor, http_name, http_flavor, link_type, and language.
+
+=back
+
 =head1 MOTIVATION
 
 This p0f plugin provides a way to make sophisticated policies for email
 messages. For example, the vast majority of email connections to my server
-from Windows computers are spam (>99%). But, I have a few clients that use
-Exchange servers so I can't just block email from all Windows computers.
+from Windows computers are spam (>99%). But, I have clients with
+Exchange servers so I can't block email from all Windows computers.
 
-Same goes for greylisting. Finance companies (AmEx, BoA, etc) just love to
-send notices that they won't queue and retry. Either they deliver at that
-instant or never. When I enable greylisting, I lose valid messages. Grrr.
+Same goes for greylisting. Finance companies (AmEx, BoA, etc) send notices
+that they don't queue and retry. They deliver immediately or never. Enabling
+greylisting means maintaining manual whitelists or losing valid messages.
 
-So, while I'm not willing to use greylisting, and I'm not willing to block
-connections from Windows computers, I am quite willing to greylist all email
-from Windows computers.
+While I'm not willing to use greylisting for every connection, and I'm not
+willing to block connections from Windows computers, I am willing to greylist
+all email from Windows computers.
 
 =head1 CONFIGURATION
 
@@ -47,7 +56,7 @@ Configuration consists of two steps: starting p0f and configuring this plugin.
 
 =head2 start p0f
 
-Create a startup script for PF that creates a communication socket when your
+Create a startup script for p0f that creates a communication socket when your
 server starts up.
 
 p0f v2 example:
@@ -73,10 +82,9 @@ It's even possible to run both versions of p0f simultaneously:
 
 =head2 local_ip
 
-Use the local_ip option to override the IP address of your mail server. This
-is useful if your mail server has a private IP because it is running behind
-a firewall. For example, my mail server has the IP 127.0.0.6, but the world
-knows my mail server as 208.75.177.101.
+Use I<local_ip> to override the IP address of your mail server. This is useful
+if your mail server runs on a private IP behind a firewall. My mail server has
+the IP 127.0.0.6, but the world knows my mail server as 208.75.177.101.
 
 Example config/plugins entry with local_ip override:
 
@@ -107,15 +115,11 @@ Version 2 code heavily based upon the p0fq.pl included with the p0f distribution
 
 =head1 AUTHORS
 
-Robert Spier ( original author )
+2004 - Robert Spier ( original author )
 
-Matt Simerson
+2010 - Matt Simerson - added local_ip option
 
-=head1 CHANGES
-
-Added local_ip option - Matt Simerson (5/2010)
-
-Refactored and added p0f v3 support - Matt Simerson (4/2012)
+2012 - Matt Simerson - refactored, v3 support
 
 =cut
 

From 0826b86dde850c44faeef2b61bac7fb10a6df57e Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Wed, 30 May 2012 14:02:37 -0400
Subject: [PATCH 14/24] fix typo

---
 lib/Qpsmtpd/Transaction.pm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/Qpsmtpd/Transaction.pm b/lib/Qpsmtpd/Transaction.pm
index 0dabffa..8c55d90 100644
--- a/lib/Qpsmtpd/Transaction.pm
+++ b/lib/Qpsmtpd/Transaction.pm
@@ -358,7 +358,7 @@ the C<DATA> command. If you need the size that will be queued, use
    + $transaction->body_length;
 
 The line above is of course only valid in I<hook_queue( )>, as other plugins
-may add headers and qpsmtpd will add it's I<Received:> header.
+may add headers and qpsmtpd will add its I<Received:> header.
 
 =head2 body_length( )
 

From 99c0aa8abdc37c44691c4b9bc6cd1773c4dab1ad Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Sat, 2 Jun 2012 02:45:25 -0400
Subject: [PATCH 15/24] new karma plugin

---
 plugins/karma | 455 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 455 insertions(+)
 create mode 100644 plugins/karma

diff --git a/plugins/karma b/plugins/karma
new file mode 100644
index 0000000..9dcf846
--- /dev/null
+++ b/plugins/karma
@@ -0,0 +1,455 @@
+#!perl -w
+
+=head1 NAME
+
+karma - reward nice and penalize naughty mail senders
+
+=head1 SYNOPSIS
+
+Karma tracks sender history, providing the ability to deliver differing levels
+of service to naughty, nice, and unknown senders.
+
+=head1 DESCRIPTION
+
+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.
+
+Karma provides other plugins with a karma value they can use to be more
+lenient, strict, or skip processing entirely.
+
+Karma is small, fast, and ruthlessly efficient. Karma can be used to craft
+custom connection policies such as these two examples: 
+
+=over 4 
+
+Hi there, well behaved sender. Please help yourself to TLS, AUTH, greater
+concurrency, multiple recipients, no delays, and other privileges.
+
+Hi there, naughty sender. Enjoy this poke in the eye with a sharp stick. Bye.
+
+=back 
+
+=head1 CONFIG
+
+=head2 negative <integer>
+
+How negative a senders karma can get before we penalize them for sending a
+naughty message. Karma is the number of nice - naughty connections. 
+
+Default: 1
+
+Examples:
+
+ negative 1:  0 nice - 1 naughty = karma -1, penalize
+ negative 1:  1 nice - 1 naughty = karma  0, okay
+ negative 2:  1 nice - 2 naughty = karma -1, okay
+ negative 2:  1 nice - 3 naughty = karma -2, penalize
+
+With the default negative limit of one, there's a very small chance you could
+penalize a "mostly good" sender. Raising it to 2 reduces that possibility to
+improbable.
+
+=head2 penalty_days <days>
+
+The number of days a naughty sender is refused connections. Use a decimal
+value to penalize for portions of days.
+
+  karma penalty_days 1
+
+Default: 1
+
+=head2 reject
+
+  karma reject [ 0 | 1 | connect | zombie ]
+
+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<zombie> setting and the
+B<reaper> plugin.
+
+=head2 db_dir <path>
+
+Path to a directory in which the DB will be stored. This directory must be
+writable by the qpsmtpd user. If unset, the first usable directory from the
+following list will be used:
+
+=over 4
+
+=item /var/lib/qpsmtpd/karma
+
+=item I<BINDIR>/var/db (where BINDIR is the location of the qpsmtpd binary)
+
+=item I<BINDIR>/config
+
+=back
+
+=head2 loglevel
+
+Adjust the quantity of logging for this plugin. See docs/logging.pod
+
+=head1 BENEFITS
+
+Karma reduces the resources wasted by naughty mailers. 
+When used with the 
+I<reject connect> setting, 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
+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.
+
+This plugin does not penalize connections with transaction notes I<relayclient>
+or I<whitelisthost> set. These notes would have been set by the B<relay>, 
+B<whitelist>, and B<dns_whitelist_soft> plugins. Obviously, those plugins must
+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
+other plugins to make that determination and communicate it to this plugin by
+incrementing or decrementing the transaction note B<karma>. Raise it for good
+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
+the penalty box will be tersely disconnected for I<penalty_days>. Here is
+an example connection from an IP in the penalty box:
+
+ 73122 Connection from smtp.midsetmediacorp.com [64.185.226.65]
+ 73122 (connect) ident::geoip: US, United States
+ 73122 (connect) ident::p0f: Windows 7 or 8
+ 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 click, disconnecting
+ 73122 (post-connection) connection_time: 1.048 s.
+
+If we only sets negative karma, we will almost certainly penalize servers we
+want to receive mail from. For example, a Yahoo user sends an egregious spam
+to a user on our server. Now nobody on our server can receive email from that
+Yahoo server for I<penalty_days>. This should happen approximately 0% of
+the time if we are careful to also set positive karma.
+
+=head1 USING KARMA
+
+To get rid of naughty connections as fast as possible, run karma before other
+connection plugins. Plugins that trigger DNS lookups or impose time delays
+should run after B<karma>. In this example, karma runs before all but the
+ident plugins.
+
+ 89011 Connection from Unknown [69.61.27.204]
+ 89011 (connect) ident::geoip: US, United States
+ 89011 (connect) ident::p0f: Linux 3.x
+ 89011 (connect) karma: fail, 1 naughty, 0 nice, 1 connects
+ 89011 550 You were naughty. You are penalized for 0.99 more days.
+ 89011 click, disconnecting
+ 89011 (post-connection) connection_time: 0.118 s.
+ 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.
+
+=head1 USING KARMA IN OTHER PLUGINS
+
+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
+ones. The higher the number, the better you should treat the sender.
+
+When I<reject zombie> is set and a naughty sender is encountered, most
+plugins should skip processing. However, if you wish to toy with spammers by
+teergrubing, extending banner delays, limiting connections, limiting
+recipients, random disconnects, handoffs to rblsmtpd, and other fun tricks, 
+then connections with the I<zombie> note set are for you!
+
+=head1 EFFECTIVENESS
+
+In the first 24 hours, B<karma> rejected 8% of all connections. After one
+week of running with I<penalty_days 1>, karma has rejected 15% of all
+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.
+
+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
+spamassassin and dspam consume more resources than others plugins, this plugin
+seems to be a very big win.
+
+=head1 DATABASE
+
+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.
+
+=head1 BUGS & LIMITATIONS
+
+This plugin is reactionary. Like the FBI, it doesn't punish until
+after a crime has been committed. It an "abuse me once, shame on you,
+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
+very lightweight tests.
+
+=head1 AUTHOR
+
+ 2012 - Matt Simerson - msimerson@cpan.org
+
+=head1 ACKNOWLEDGEMENTS
+
+Gavin Carr's DB implementation in the greylisting plugin.
+
+=cut
+
+use strict;
+use warnings;
+
+use Qpsmtpd::Constants;
+
+BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) }
+use AnyDBM_File;
+use Fcntl qw(:DEFAULT :flock LOCK_EX LOCK_NB);
+use Net::IP;
+
+sub register {
+    my ($self, $qp ) = shift, shift;
+    $self->log(LOGERROR, "Bad arguments") if @_ % 2;
+    $self->{_args} = { @_ };
+    $self->{_args}{negative}     ||= 1;
+    $self->{_args}{penalty_days} ||= 1;
+    $self->{_args}{reject_type}  ||= 'disconnect';
+
+    if ( ! defined $self->{_args}{reject} ) {
+        $self->{_args}{reject} = 'zombie';
+    };
+    #$self->prune_db();    # keep the DB compact
+    $self->register_hook('connect',           'connect_handler');
+    $self->register_hook('disconnect',        'disconnect_handler');
+}
+
+sub connect_handler {
+    my $self = shift;
+
+    $self->connection->notes('karma', 0);  # default
+
+    return DECLINED if $self->is_immune();
+
+    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();
+
+    if ( ! $tied->{$key} ) {
+        $self->log(LOGINFO, "pass, no record");
+        return $self->cleanup_and_return($tied, $lock );
+    };
+
+    my ($penalty_start_ts, $naughty, $nice, $connects) = $self->parse_value( $tied->{$key} );
+    my $summary = "$naughty naughty, $nice nice, $connects connects";
+    my $karma = 0;
+    if ( $naughty || $nice ) {
+        $karma = $nice || 0 - $naughty || 0;
+        $self->connection->notes('karma_history', $karma );
+    };
+
+    my $happy_return = $karma > 3 ? DONE : DECLINED;  # skip other connection tests?
+    if ( ! $penalty_start_ts ) {
+        $self->log(LOGINFO, "pass, no penalty ($summary)");
+        return $self->cleanup_and_return($tied, $lock, $happy_return );
+        return $self->cleanup_and_return($tied, $lock );
+    };
+
+    my $days_old = (time - $penalty_start_ts) / 86400;
+    if ( $days_old >= $self->{_args}{penalty_days} ) {
+        $self->log(LOGINFO, "pass, penalty expired ($summary)");
+        return $self->cleanup_and_return($tied, $lock );
+    };
+
+    $tied->{$key} = join(':', $penalty_start_ts, $naughty, $nice, ++$connects);
+    $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.";
+
+    return $self->get_reject( $mess );
+}
+
+sub disconnect_handler {
+    my $self = shift;
+
+    my $karma = $self->connection->notes('karma') or do {
+        $self->log(LOGDEBUG, "no karma");
+        return DECLINED;
+    };
+
+    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();
+
+    my ($penalty_start_ts, $naughty, $nice, $connects) = $self->parse_value( $tied->{$key} );
+
+    if ( $karma < 0 ) {
+        $naughty++;
+        my $negative_limit = 0 - $self->{_args}{negative};
+        my $karma_history  = ($nice || 0) - $naughty;
+        if ( $karma_history <= $negative_limit ) {
+            $self->log(LOGINFO, "negative, sent to penalty box");
+            $penalty_start_ts = sprintf "%s", time;
+        }
+        else {
+            $self->log(LOGINFO, "negative");
+        };
+    }
+    elsif ($karma > 1) {
+        $nice++;
+        $self->log(LOGINFO, "positive");
+    }
+
+    $tied->{$key} = join(':', $penalty_start_ts, $naughty, $nice, ++$connects);
+    return $self->cleanup_and_return($tied, $lock );
+}
+
+sub parse_value {
+    my ($self, $value) = @_;
+
+    my $penalty_start_ts = my $naughty = my $nice = my $connects = 0;
+    if ( $value  ) {
+        ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, $value;
+        $penalty_start_ts ||= 0;
+        $nice    ||= 0;
+        $naughty ||= 0;
+        $connects ||= 0;
+    };
+    return ($penalty_start_ts, $naughty, $nice, $connects );
+};
+
+sub cleanup_and_return {
+    my ($self, $tied, $lock, $return_val ) = @_;
+
+    untie $tied;
+    close $lock;
+    return ($return_val) if defined $return_val;  # explicit override
+    return (DECLINED);
+};
+
+sub get_db_key {
+    my $self = shift;
+    my $nip = Net::IP->new( $self->qp->connection->remote_ip );
+    return $nip->intip;   # convert IP to an int
+};
+
+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: $!");
+        close $lock;
+        return;
+    };
+    return \%db;
+};
+
+sub get_db_location {
+    my $self = shift;
+
+    # Setup database location
+    my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!);
+    my @candidate_dirs = ( $self->{args}{db_dir},
+        "/var/lib/qpsmtpd/karma", "$QPHOME/var/db", "$QPHOME/config", '.' );
+
+    my $dbdir;
+    for my $d ( @candidate_dirs ) {
+        next if ! $d || ! -d $d;   # impossible
+        $dbdir = $d;
+        last;   # first match wins
+    }
+    my $db = "$dbdir/karma.dbm";
+    $self->log(LOGDEBUG,"using $db as karma database");
+    return $db;
+};
+
+sub get_db_lock {
+    my ($self, $db) = @_;
+
+    return $self->get_db_lock_nfs($db) if $self->{_args}{nfslock};
+
+    # Check denysoft db
+    open( my $lock, ">$db.lock" ) or do {
+        $self->log(LOGCRIT, "opening lockfile failed: $!");
+        return;
+    };
+
+    flock( $lock, LOCK_EX ) or do {
+        $self->log(LOGCRIT, "flock of lockfile failed: $!");
+        close $lock;
+        return;
+    };
+
+    return $lock;
+}
+
+sub get_db_lock_nfs {
+    my ($self, $db) = @_;
+
+    require File::NFSLock;
+
+    ### set up a lock - lasts until object looses scope
+    my $nfslock = new File::NFSLock {
+        file      => "$db.lock",
+        lock_type => LOCK_EX|LOCK_NB,
+        blocking_timeout   => 10,      # 10 sec
+        stale_lock_timeout => 30 * 60, # 30 min
+    } or do {
+        $self->log(LOGCRIT, "nfs lockfile failed: $!");
+        return;
+    };
+
+    open( my $lock, "+<$db.lock") or do {
+        $self->log(LOGCRIT, "opening nfs lockfile failed: $!");
+        return;
+    };
+
+    return $lock;
+};
+
+sub prune_db {
+    my $self = shift;
+
+    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 $count = keys %$tied;
+
+    my $pruned = 0;
+    foreach my $key ( keys %$tied ) {
+        my $ts = $tied->{$key};
+        my $days_old = ( time - $ts ) / 86400;
+        next if $days_old < $self->{_args}{penalty_days} * 2;
+        delete $tied->{$key};
+        $pruned++;
+    };
+    untie $tied;
+    close $lock;
+    $self->log( LOGINFO, "pruned $pruned of $count DB entries" );
+    return $self->cleanup_and_return( $tied, $lock, DECLINED );
+};
+

From 85982d00f8fc07cf69aa30c5ef83f489a7cee373 Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Sat, 2 Jun 2012 15:09:21 -0400
Subject: [PATCH 16/24] restore validate_password test

not sure how/why that got removed, but it wasn't intentional
---
 t/Test/Qpsmtpd/Plugin.pm | 51 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 51 insertions(+)

diff --git a/t/Test/Qpsmtpd/Plugin.pm b/t/Test/Qpsmtpd/Plugin.pm
index cafa0d0..81969d1 100644
--- a/t/Test/Qpsmtpd/Plugin.pm
+++ b/t/Test/Qpsmtpd/Plugin.pm
@@ -40,4 +40,55 @@ sub run_tests {
     }
 }
 
+sub validate_password {
+    my ( $self, %a ) = @_;
+
+    my ($pkg, $file, $line) = caller();
+
+    my $src_clear     = $a{src_clear};
+    my $src_crypt     = $a{src_crypt};
+    my $attempt_clear = $a{attempt_clear};
+    my $attempt_hash  = $a{attempt_hash};
+    my $method        = $a{method} or die "missing method";
+    my $ticket        = $a{ticket};
+    my $deny          = $a{deny} || DENY;
+
+    if ( ! $src_crypt && ! $src_clear ) {
+        $self->log(LOGINFO, "fail: missing password");
+        return ( $deny, "$file - no such user" );
+    };
+
+    if ( ! $src_clear && $method =~ /CRAM-MD5/i ) {
+        $self->log(LOGINFO, "skip: cram-md5 not supported w/o clear pass");
+        return ( DECLINED, $file );
+    }
+
+    if ( defined $attempt_clear ) {
+        if ( $src_clear && $src_clear eq $attempt_clear ) {
+            $self->log(LOGINFO, "pass: clear match");
+            return ( OK, $file );
+        };
+
+        if ( $src_crypt && $src_crypt eq crypt( $attempt_clear, $src_crypt ) ) {
+            $self->log(LOGINFO, "pass: crypt match");
+            return ( OK, $file );
+        }
+    };
+
+    if ( defined $attempt_hash && $src_clear ) {
+        if ( ! $ticket ) {
+            $self->log(LOGERROR, "skip: missing ticket");
+            return ( DECLINED, $file );
+        };
+
+        if ( $attempt_hash eq hmac_md5_hex( $ticket, $src_clear ) ) {
+            $self->log(LOGINFO, "pass: hash match");
+            return ( OK, $file );
+        };
+    };
+
+    $self->log(LOGINFO, "fail: wrong password");
+    return ( $deny, "$file - wrong password" );
+};
+
 1;

From 980c2a28bb0faa088d5d1ed7a7088a48f2e4e53f Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Sat, 2 Jun 2012 21:47:12 -0400
Subject: [PATCH 17/24] comment out vpopmail/checkpasswd plugins in config

---
 config.sample/plugins | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/config.sample/plugins b/config.sample/plugins
index fe51829..e03310b 100644
--- a/config.sample/plugins
+++ b/config.sample/plugins
@@ -45,10 +45,10 @@ check_spamhelo
 # sender_permitted_from
 # greylisting p0f genre,windows
 
-auth/auth_checkpassword checkpw /usr/local/vpopmail/bin/vchkpw true /usr/bin/true
-auth/auth_vpopmail
-auth/auth_vpopmaild
-auth/auth_vpopmail_sql
+#auth/auth_checkpassword checkpw /usr/local/vpopmail/bin/vchkpw true /usr/bin/true
+#auth/auth_vpopmail
+#auth/auth_vpopmaild
+#auth/auth_vpopmail_sql
 auth/auth_flat_file
 auth/authdeny
 

From 9c1e62371b809e1c6e9e43167a8f8c50b94d6527 Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Sat, 2 Jun 2012 22:56:05 -0400
Subject: [PATCH 18/24] added new t/config directory, with developer tests

run when $ENV{QPSMTPD_DEVELOPER} is set

plugins file is same as in config.sample, but with more stuff enabled
---
 config.sample/flat_auth_pw |  1 +
 t/Test/Qpsmtpd.pm          |  1 +
 t/config.t                 | 15 ++++--
 t/config/badhelo           |  4 ++
 t/config/badrcptto         |  9 ++++
 t/config/dnsbl_zones       |  1 +
 t/config/flat_auth_pw      |  2 +
 t/config/plugins           | 94 ++++++++++++++++++++++++++++++++++++++
 t/config/rcpthosts         |  1 +
 t/config/relayclients      |  5 ++
 t/plugin_tests.t           |  8 ++++
 11 files changed, 137 insertions(+), 4 deletions(-)
 create mode 100644 t/config/badhelo
 create mode 100644 t/config/badrcptto
 create mode 100644 t/config/dnsbl_zones
 create mode 100644 t/config/flat_auth_pw
 create mode 100644 t/config/plugins
 create mode 100644 t/config/rcpthosts
 create mode 100644 t/config/relayclients

diff --git a/config.sample/flat_auth_pw b/config.sample/flat_auth_pw
index 292d9f5..cdae7f7 100644
--- a/config.sample/flat_auth_pw
+++ b/config.sample/flat_auth_pw
@@ -1,2 +1,3 @@
+# example entries
 good@example.com:good_pass
 bad@example.com:bad_pass
diff --git a/t/Test/Qpsmtpd.pm b/t/Test/Qpsmtpd.pm
index 83805df..48041ee 100644
--- a/t/Test/Qpsmtpd.pm
+++ b/t/Test/Qpsmtpd.pm
@@ -69,6 +69,7 @@ sub input {
 }
 
 sub config_dir {
+    return './t/config' if $ENV{QPSMTPD_DEVELOPER};
     './config.sample';
 }
 
diff --git a/t/config.t b/t/config.t
index f134e7a..8b6b11e 100644
--- a/t/config.t
+++ b/t/config.t
@@ -5,12 +5,17 @@ use strict;
 use lib 't';
 use_ok('Test::Qpsmtpd');
 
+my @mes;
+
 BEGIN { # need this to happen before anything else
     my $cwd = `pwd`;
     chomp($cwd);
-    open my $me_config, '>', "./config.sample/me";
-    print $me_config "some.host.example.org";
-    close $me_config;
+    @mes = qw{ ./config.sample/me ./t/config/me };
+    foreach my $f ( @mes ) {
+        open my $me_config, '>', $f;
+        print $me_config "some.host.example.org";
+        close $me_config;
+    };
 }
 
 ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection");
@@ -22,6 +27,8 @@ is($smtpd->config('me'), 'some.host.example.org', 'config("me")');
 my $relayclients = join ",", sort $smtpd->config('relayclients');
 is($relayclients, '127.0.0.1,192.0.', 'config("relayclients") are trimmed');
 
-unlink "./config.sample/me";
+foreach my $f ( @mes ) {
+    unlink $f if -f $f;
+};
 
 
diff --git a/t/config/badhelo b/t/config/badhelo
new file mode 100644
index 0000000..a13ebfa
--- /dev/null
+++ b/t/config/badhelo
@@ -0,0 +1,4 @@
+# these domains never uses their domain when greeting us, so reject transactions
+aol.com
+yahoo.com
+
diff --git a/t/config/badrcptto b/t/config/badrcptto
new file mode 100644
index 0000000..a7f88ca
--- /dev/null
+++ b/t/config/badrcptto
@@ -0,0 +1,9 @@
+######## entries used for testing ###
+bad@example.com
+@bad.example.com
+########    Example patterns   #######
+# Format is pattern\s+Response
+# Don't forget to anchor the pattern if required
+!       Sorry, bang paths not accepted here
+@.*@    Sorry, multiple at signs not accepted here
+%       Sorry, percent hack not accepted here 
diff --git a/t/config/dnsbl_zones b/t/config/dnsbl_zones
new file mode 100644
index 0000000..1053328
--- /dev/null
+++ b/t/config/dnsbl_zones
@@ -0,0 +1 @@
+zen.spamhaus.org
diff --git a/t/config/flat_auth_pw b/t/config/flat_auth_pw
new file mode 100644
index 0000000..292d9f5
--- /dev/null
+++ b/t/config/flat_auth_pw
@@ -0,0 +1,2 @@
+good@example.com:good_pass
+bad@example.com:bad_pass
diff --git a/t/config/plugins b/t/config/plugins
new file mode 100644
index 0000000..4a18615
--- /dev/null
+++ b/t/config/plugins
@@ -0,0 +1,94 @@
+#
+#  Example configuration file for plugins
+#
+
+# enable this to get configuration via http; see perldoc
+# plugins/http_config for details.
+#   http_config http://localhost/~smtpd/config/  http://www.example.com/smtp.pl?config=
+
+# hosts_allow does not work with the tcpserver deployment model!
+#   perldoc plugins/hosts_allow for an alternative.
+#
+# The hosts_allow module must be loaded if you want the -m / --max-from-ip /
+# my $MAXCONNIP = 5; # max simultaneous connections from one IP
+# settings... without this it will NOT refuse more than $MAXCONNIP connections
+# from one IP!
+hosts_allow
+
+# information plugins
+ident/geoip
+#ident/p0f /tmp/.p0f_socket version 3
+connection_time
+
+# enable to accept MAIL FROM:/RCPT TO: addresses without surrounding <>
+dont_require_anglebrackets
+
+# enable to reject MAIL FROM:/RCPT TO: parameters if client helo was HELO
+# (strict RFC 821)... this is not used in EHLO ...
+parse_addr_withhelo
+
+quit_fortune
+# tls should load before count_unrecognized_commands
+#tls
+check_earlytalker
+count_unrecognized_commands 4
+check_relay
+
+require_resolvable_fromhost
+
+rhsbl
+dnsbl
+check_badmailfrom
+check_badrcptto
+check_spamhelo
+
+sender_permitted_from
+greylisting p0f genre,windows
+
+auth/auth_checkpassword checkpw /usr/local/vpopmail/bin/vchkpw true /usr/bin/true
+auth/auth_vpopmail
+auth/auth_vpopmaild
+auth/auth_vpopmail_sql
+auth/auth_flat_file
+auth/authdeny
+
+# this plugin needs to run after all other "rcpt" plugins
+rcpt_ok
+
+check_basicheaders days 5 reject_type temp
+domainkeys
+
+# content filters
+virus/klez_filter
+
+
+# You can run the spamassassin plugin with options.  See perldoc
+# plugins/spamassassin for details.
+#
+spamassassin
+
+# 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
+
+# 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
+
+# You must enable a queue plugin - see the options in plugins/queue/ - for example:
+
+# queue to a maildir
+# queue/maildir /home/spamtrap/mail
+
+# queue the mail with qmail-queue
+queue/qmail-queue
+
+
+# If you need to run the same plugin multiple times, you can do
+# something like the following
+#    check_relay
+#    check_relay:0 somearg
+#    check_relay:1 someotherarg
diff --git a/t/config/rcpthosts b/t/config/rcpthosts
new file mode 100644
index 0000000..2fbb50c
--- /dev/null
+++ b/t/config/rcpthosts
@@ -0,0 +1 @@
+localhost
diff --git a/t/config/relayclients b/t/config/relayclients
new file mode 100644
index 0000000..5bbb91d
--- /dev/null
+++ b/t/config/relayclients
@@ -0,0 +1,5 @@
+# Format is IP, or IP part with trailing dot
+# e.g. "127.0.0.1", or "192.168."
+127.0.0.1 
+# leading/trailing whitespace is ignored
+ 192.168. 
diff --git a/t/plugin_tests.t b/t/plugin_tests.t
index e1f3050..69344c1 100644
--- a/t/plugin_tests.t
+++ b/t/plugin_tests.t
@@ -7,3 +7,11 @@ my $qp = Test::Qpsmtpd->new();
 
 $qp->run_plugin_tests();
 
+foreach my $file ( 
+        "./t/config/greylist.dbm",
+        "./t/config/greylist.dbm.lock"
+        ) {
+    next if ! -f $file;
+    unlink $file;
+};
+

From 54ac009807d727d84f730b6dda2cc3ee201ef0f0 Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Sat, 2 Jun 2012 23:24:25 -0400
Subject: [PATCH 19/24] added plugin name that uses them to the config files

---
 config.sample/norelayclients | 1 +
 config.sample/relayclients   | 1 +
 2 files changed, 2 insertions(+)

diff --git a/config.sample/norelayclients b/config.sample/norelayclients
index 5fab985..1ac21a4 100644
--- a/config.sample/norelayclients
+++ b/config.sample/norelayclients
@@ -1,3 +1,4 @@
+# used by plugins/relay
 # test entries - http://tools.ietf.org/html/rfc5737
 192.0.99.5
 192.0.99.6
diff --git a/config.sample/relayclients b/config.sample/relayclients
index 13c9be7..792c76b 100644
--- a/config.sample/relayclients
+++ b/config.sample/relayclients
@@ -1,3 +1,4 @@
+# used by plugins/relay
 # Format is IP, or IP part with trailing dot
 # e.g. "127.0.0.1", or "192.168."
 127.0.0.1 

From 1eb996a1f51b1fc533bb61a27deca84662a3fdb0 Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Sat, 2 Jun 2012 23:44:47 -0400
Subject: [PATCH 20/24] added note in file telling which plugin uses it

---
 config.sample/flat_auth_pw | 1 +
 1 file changed, 1 insertion(+)

diff --git a/config.sample/flat_auth_pw b/config.sample/flat_auth_pw
index cdae7f7..fcf3b3c 100644
--- a/config.sample/flat_auth_pw
+++ b/config.sample/flat_auth_pw
@@ -1,3 +1,4 @@
+# used by plugins/auth/auth_flat_file
 # example entries
 good@example.com:good_pass
 bad@example.com:bad_pass

From 0d2a9bf8875a7d42c83f2a5e0a6a378738c04602 Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Sat, 2 Jun 2012 14:46:29 -0400
Subject: [PATCH 21/24] Plugin.pm: added is_immune

---
 lib/Qpsmtpd/Plugin.pm | 31 +++++++++++++++++++++++++++++++
 1 file changed, 31 insertions(+)

diff --git a/lib/Qpsmtpd/Plugin.pm b/lib/Qpsmtpd/Plugin.pm
index d56a289..8ab8baf 100644
--- a/lib/Qpsmtpd/Plugin.pm
+++ b/lib/Qpsmtpd/Plugin.pm
@@ -210,6 +210,37 @@ sub compile {
     die "eval $@" if $@;
 }
 
+sub is_immune {
+    my $self = shift;
+
+    if ( $self->qp->connection->relay_client() ) {
+        # set by plugins/relay, or Qpsmtpd::Auth
+        $self->log(LOGINFO, "skip, relay client");
+        return 1;
+    };
+    if ( $self->qp->connection->notes('whitelisthost') ) {
+        # set by plugins/dns_whitelist_soft or plugins/whitelist
+        $self->log(LOGINFO, "skip, whitelisted host");
+        return 1;
+    };
+    if ( $self->qp->transaction->notes('whitelistsender') ) {
+        # set by plugins/whitelist
+        $self->log(LOGINFO, "skip, whitelisted sender");
+        return 1;
+    };
+    if ( $self->connection->notes('zombie') ) {
+        # see plugins/reaper
+        $self->log(LOGINFO, "skip, zombie");
+        return 1;
+    };
+    if ( $self->connection->notes('rejected') ) {
+        # http://www.steve.org.uk/Software/ms-lite/
+        $self->log(LOGINFO, "skip, already rejected");
+        return 1;
+    };
+    return;
+};
+
 sub _register_standard_hooks {
   my ($plugin, $qp) = @_;
 

From 041f64a47463f018691f367bd2cc952c784e3e91 Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Sun, 3 Jun 2012 17:12:17 -0400
Subject: [PATCH 22/24] renamed reaper -> naughty

---
 lib/Qpsmtpd/Plugin.pm | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/lib/Qpsmtpd/Plugin.pm b/lib/Qpsmtpd/Plugin.pm
index 8ab8baf..a50df97 100644
--- a/lib/Qpsmtpd/Plugin.pm
+++ b/lib/Qpsmtpd/Plugin.pm
@@ -228,9 +228,9 @@ sub is_immune {
         $self->log(LOGINFO, "skip, whitelisted sender");
         return 1;
     };
-    if ( $self->connection->notes('zombie') ) {
-        # see plugins/reaper
-        $self->log(LOGINFO, "skip, zombie");
+    if ( $self->connection->notes('naughty') ) {
+        # see plugins/naughty
+        $self->log(LOGINFO, "skip, naughty");
         return 1;
     };
     if ( $self->connection->notes('rejected') ) {

From 22c0f23226cb1cf5c4a56aedf6b00c544f930be5 Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Sun, 3 Jun 2012 19:59:07 -0400
Subject: [PATCH 23/24] imported karma_tool

---
 plugins/karma_tool | 250 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 250 insertions(+)
 create mode 100755 plugins/karma_tool

diff --git a/plugins/karma_tool b/plugins/karma_tool
new file mode 100755
index 0000000..eb6012c
--- /dev/null
+++ b/plugins/karma_tool
@@ -0,0 +1,250 @@
+#!/usr/bin/perl
+package Karma;
+
+use strict;
+use warnings;
+
+BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) }
+use AnyDBM_File;
+use Data::Dumper;
+use Fcntl qw(:DEFAULT :flock LOCK_EX LOCK_NB);
+use Net::IP qw(:PROC);
+use POSIX qw(strftime);
+
+my $self = bless( { args => { db_dir => 'config' }, }, 'Karma' );
+my $command = $ARGV[0];
+
+if ( ! $command ) {
+    $self->usage();
+}
+elsif ( $command eq 'capture' ) {
+    $self->capture( $ARGV[1] );
+}
+elsif ( $command eq 'release' ) {
+    $self->capture( $ARGV[1] );
+}
+elsif ( $command eq 'prune' ) {
+    $self->prune_db( $ARGV[1] || 7 );
+}
+elsif ( $command eq 'list' ) {
+    $self->main();
+};
+
+exit(0);
+
+sub usage {
+    print <<EO_HELP
+ karma_tool [ list search prune capture release ]
+
+list takes no arguments.
+
+search [ naughty nice both ]
+  and returns a list of matching IPs
+
+capture [ IP ]
+  sends an IP to the penalty box
+
+release [ IP ]
+  remove an IP from the penalty box
+
+prune takes no arguments.
+  prunes database of entries older than 7 days
+
+EO_HELP
+;
+};
+
+sub capture {
+    my $self = shift;
+    my $ip = shift or return;
+    is_ip( $ip ) or do {
+        warn "not an IP: $ip\n";
+        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 );
+
+    $tied->{$key} = join(':', time, 1, 0, 1);
+    return $self->cleanup_and_return( $tied, $lock );
+};
+
+sub release {
+    my $self = shift;
+    my $ip = shift or return;
+    is_ip( $ip ) or do {
+        warn "not an IP: $ip\n";
+        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 );
+
+    $tied->{$key} = join(':', 0, 1, 0, 1);
+    return $self->cleanup_and_return( $tied, $lock );
+};
+
+sub main {
+    my $self = shift;
+
+    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 %totals;
+
+    print "      IP Address                 Penalty        Naughty  Nice  Connects  Hostname\n";
+    foreach my $r ( sort keys %$tied ) {
+        my $ip = ip_bintoip( ip_inttobin( $r, 4 ), 4);
+        my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, $tied->{$r};
+        $naughty ||= '';
+        $nice    ||= '';
+        $connects ||= '';
+        my $time_human = '';
+        if ( $command eq 'search' ) {
+            my $search = $ARGV[1];
+            if ( $search eq 'nice' ) {
+                next if ! $nice;
+            }
+            elsif ( $search eq 'naughty' ) {
+                next if ! $naughty;
+            }
+            elsif ( $search eq 'both' ) {
+                next if ! $naughty || ! $nice;
+            }
+            elsif ( is_ip() && $search ne $ip ) {
+                next;
+            }
+        };
+        if ( $penalty_start_ts ) {
+            $time_human = strftime "%a %b %e %H:%M", localtime $penalty_start_ts;
+        };
+        my $hostname = '';
+        if ( $naughty && $nice ) {
+            $hostname = `dig +short -x $ip`; chomp $hostname;
+        };
+        printf(" %-18s  %24s    %3s     %3s     %3s    %30s\n", $ip, $time_human, $naughty, $nice, $connects, $hostname);
+        $totals{naughty}  += $naughty  if $naughty;
+        $totals{nice}     += $nice     if $nice;
+        $totals{connects} += $connects if $connects;
+    };
+    print Dumper(\%totals);
+}
+
+sub is_ip {
+    my $ip = shift || $ARGV[0];
+    return 1 if $ip =~ /^(\d{1,3}\.){3}\d{1,3}$/;
+    return;
+};
+
+sub cleanup_and_return {
+    my ($self, $tied, $lock ) = @_;
+    untie $tied;
+    close $lock;
+};
+
+sub get_db_key {
+    my $self = shift;
+    my $nip = Net::IP->new( shift );
+    return $nip->intip;   # convert IP to an int
+};
+
+sub get_db_tie {
+    my ( $self, $db, $lock ) = @_;
+
+    tie( my %db, 'AnyDBM_File', $db, O_CREAT|O_RDWR, 0600) or do {
+        warn "tie to database $db failed: $!";
+        close $lock;
+        return;
+    };
+    return \%db;
+};
+
+sub get_db_location {
+    my $self = shift;
+
+    # Setup database location
+    my @candidate_dirs = ( $self->{args}{db_dir},
+        "/var/lib/qpsmtpd/karma", "./var/db", "./config", '.' );
+
+    my $dbdir;
+    for my $d ( @candidate_dirs ) {
+        next if ! $d || ! -d $d;   # impossible
+        $dbdir = $d;
+        last;   # first match wins
+    }
+    my $db = "$dbdir/karma.dbm";
+    print "using karma db at $db\n";
+    return $db;
+};
+
+sub get_db_lock {
+    my ($self, $db) = @_;
+
+    return $self->get_db_lock_nfs($db) if $self->{_args}{nfslock};
+
+    # Check denysoft db
+    open( my $lock, ">$db.lock" ) or do {
+        warn "opening lockfile failed: $!";
+        return;
+    };
+
+    flock( $lock, LOCK_EX ) or do {
+        warn "flock of lockfile failed: $!";
+        close $lock;
+        return;
+    };
+
+    return $lock;
+}
+
+sub get_db_lock_nfs {
+    my ($self, $db) = @_;
+
+    require File::NFSLock;
+
+    ### set up a lock - lasts until object looses scope
+    my $nfslock = new File::NFSLock {
+        file      => "$db.lock",
+        lock_type => LOCK_EX|LOCK_NB,
+        blocking_timeout   => 10,      # 10 sec
+        stale_lock_timeout => 30 * 60, # 30 min
+    } or do {
+        warn "nfs lockfile failed: $!";
+        return;
+    };
+
+    open( my $lock, "+<$db.lock") or do {
+        warn "opening nfs lockfile failed: $!";
+        return;
+    };
+
+    return $lock;
+};
+
+sub prune_db {
+    my $self = shift;
+    my $prune_days = shift;
+
+    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 $count = keys %$tied;
+
+    my $pruned = 0;
+    foreach my $key ( keys %$tied ) {
+        my ($ts, $naughty, $nice, $connects) = split /:/, $tied->{$key};
+        my $days_old = ( time - $ts ) / 86400;
+        next if $days_old < $prune_days;
+        delete $tied->{$key};
+        $pruned++;
+    };
+    untie $tied;
+    close $lock;
+    warn "pruned $pruned of $count DB entries";
+    return $self->cleanup_and_return( $tied, $lock );
+};
+

From e6ea23c92f56137e394f47b4c4a9173954e47556 Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Sun, 3 Jun 2012 20:16:24 -0400
Subject: [PATCH 24/24] relay: clean up trailing whitespace

---
 plugins/relay | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/plugins/relay b/plugins/relay
index 5a2086a..12814b8 100644
--- a/plugins/relay
+++ b/plugins/relay
@@ -10,10 +10,10 @@ relay - check the following places to see if relaying is allowed:
 
 I<$ENV{RELAYCLIENT}>
 
-I<config/norelayclients>, I<config/relayclients>, I<config/morerelayclients> 
+I<config/norelayclients>, I<config/relayclients>, I<config/morerelayclients>
 
 The search order is as shown and cascades until a match is found or the list
-is exhausted. 
+is exhausted.
 
 Note that I<norelayclients> is the first file checked. A match there will
 override matches in the subsequent files.
@@ -159,7 +159,7 @@ sub is_in_cidr_block {
 # expand the client address (zero pad it) before converting to binary
         my $bin_ip = ip_iptobin(ip_expand_address($ip, $cversion), $cversion);
 
-        if (    ip_bincomp($bin_ip, 'gt', ip_iptobin($begin, $rversion)) 
+        if (    ip_bincomp($bin_ip, 'gt', ip_iptobin($begin, $rversion))
              && ip_bincomp($bin_ip, 'lt', ip_iptobin($end,   $rversion))
            ) {
             $self->log(LOGINFO, "pass: cidr match ($ip)");