--- postgrey-1.27/postgrey	2006-07-17 21:53:30.000000000 +0900
+++ targrey/postgrey	2006-11-14 13:28:38.000000000 +0900
@@ -225,6 +225,22 @@
             $self->mylog(2, "cleaning clients database finished. before: $nr_keys_before, after: $nr_keys_after");
         }
 
+        if($self->{postgrey}{tarpit}) {
+            # cleanup tarpit blacklist database
+			my $tarpit_db = $self->{postgrey}{db_tarpit};
+            ($nr_keys_before, $nr_keys_after) = (0, 0);
+            while (my ($key, $tarpit_last_seen) = each %$tarpit_db) {
+                $nr_keys_before++;
+                if($now - $tarpit_last_seen > $retry_window) {
+                    delete $tarpit_db->{$key};
+                }
+                else {
+                    $nr_keys_after++;
+                }
+            }
+            $self->mylog(2, "cleaning tarpit blacklist database finished. before: $nr_keys_before, after: $nr_keys_after");
+        }
+
         $self->{postgrey}{last_maint_keys}=$now;
     }
 }
@@ -279,7 +295,7 @@
         # whitelist if count is enough
         if(defined $cawl_count and $cawl_count >= $self->{postgrey}{awl_clients})
         {
-            if($now >= $cawl_last+3600) {
+            if($now >= $cawl_last + $self->{postgrey}{awl_delay}) {
                 $cawl_count++; # for statistics
                 $cawl_db->{$cawl_key}=$cawl_count.','.$now;
             }
@@ -287,6 +303,28 @@
         }
     }
 
+	# check tarpit passed
+	if($self->{postgrey}{tarpit} && $attr->{protocol_state} eq 'DATA') { # passed tarpit
+		# remove tarpit blacklist
+		my $tarpit_db = $self->{postgrey}{db_tarpit};
+		my $tarpit_key = $attr->{client_address};
+		delete $tarpit_db->{$tarpit_key};
+
+		# auto whitelist clients by tarpit
+		if ($self->{postgrey}{awl_clients}) {
+            # enough time has passed (record only one attempt per hour)
+            if(! defined $cawl_last or $now >= $cawl_last + $self->{postgrey}{awl_delay}) {
+                # ok, increase count
+                $cawl_count++;
+                $cawl_db->{$cawl_key}=$cawl_count.','.$now;
+                $self->mylog(2, "tarpit whitelisted: $attr->{client_name}"."[".$attr->{client_address}."]")
+                    if $cawl_count==$self->{postgrey}{awl_clients};
+            }
+		}
+
+		return 'DUNNO';
+	}
+
     # lookup
     my $sender = $self->do_sender_substitutions($attr->{sender});
     my ($client_net, $client_host) =
@@ -297,10 +335,11 @@
     }
     my $val    = $db->{$key};
     my $first;
+    my $retry_count=0;
     my $last_was_successful=0;
     if(defined $val) {
         my $last;
-        ($first, $last) = split(/,/,$val);
+        ($first, $last, $retry_count) = split(/,/,$val);
         # find out if the last time was unsuccessful, so that we can add a header
         # to say how much had to be waited
         if($last - $first >= $self->{postgrey}{delay}) {
@@ -316,12 +355,18 @@
         $first = $now;
     }
 
+    $self->mylog(4, "request age ".($now - $first));
+    my $diff = $self->{postgrey}{delay} - ($now - $first);
+
+    # enough waited? -> increase retry_count
+    $retry_count++ if($diff <= 0);
+
     # update (put as last element stripped host-part if it was stripped)
     if(defined $client_host) {
-        $db->{$key}="$first,$now,$client_host";
+        $db->{$key}="$first,$now,$retry_count,$client_host";
     }
     else {
-        $db->{$key}="$first,$now";
+        $db->{$key}="$first,$now,$retry_count";
     }
 
     # do maintenance if one hour has passed since the last one
@@ -330,9 +375,6 @@
         $self->do_maintenance($now);
     }
 
-    $self->mylog(4, "request age ".($now - $first));
-    my $diff = $self->{postgrey}{delay} - ($now - $first);
-
     # auto whitelist clients
     # algorithm:
     # - on successful entry in the greylist db of a triplet:
@@ -340,20 +382,32 @@
     #   - client whitelisted already? -> update last-seen timestamp
     if($self->{postgrey}{awl_clients}) {
         # greylisting succeeded
-        if($diff <= 0 and !$last_was_successful) {
+        if($retry_count >= $self->{postgrey}{retry_count} and !$last_was_successful) {
             # enough time has passed (record only one attempt per hour)
-            if(! defined $cawl_last or $now >= $cawl_last + 3600) {
+            if(! defined $cawl_last or $now >= $cawl_last + $self->{postgrey}{awl_delay}) {
                 # ok, increase count
                 $cawl_count++;
                 $cawl_db->{$cawl_key}=$cawl_count.','.$now;
-                $self->mylog(2, "whitelisted: $attr->{client_name}")
+                $self->mylog(2, "whitelisted: $attr->{client_name}"."[".$attr->{client_address}."]")
                     if $cawl_count==$self->{postgrey}{awl_clients};
             }
         }
     }
 
-    # not enough waited? -> greylist
-    if ($diff > 0 ) {
+    # not enough retry? -> greylist
+    if ($retry_count < $self->{postgrey}{retry_count}) {
+		if($self->{postgrey}{tarpit}) { # do tarpit
+			# add tarpit blacklist
+			my $tarpit_db = $self->{postgrey}{db_tarpit};
+			my $tarpit_key = $attr->{client_address};
+			my $tarpit_last = $tarpit_db->{$tarpit_key};
+			$tarpit_last = 0 unless (defined $tarpit_last);
+			$tarpit_db->{$tarpit_key} = "$now" if ($now >= $tarpit_last+300); # update if 5min ago
+
+			# return sleep if not tarpit blacklisted
+			return "SLEEP $self->{postgrey}{tarpit}" if ($tarpit_last == 0);
+			# greylist if tapit blacklisted
+		}
         my $msg = $self->{postgrey}{greylist_text};
         $msg =~ s/\%s/$diff/;
         my $recip_domain = $attr->{recipient}; $recip_domain =~ s/.*\@//;
@@ -389,10 +443,12 @@
     GetOptions(\%opt, 'help|h', 'man', 'version', 'noaction|no-action|n',
         'verbose|v', 'daemonize|d', 'unix|u=s', 'inet|i=s', 'user=s', 'group=s',
         'dbdir=s', 'pidfile=s', 'delay=i', 'max-age=i',
-        'lookup-by-subnet', 'lookup-by-host', 'auto-whitelist-clients:s', 
+        'lookup-by-subnet', 'lookup-by-host',
+        'auto-whitelist-clients:s', 'auto-whitelist-delay=i',
         'whitelist-clients=s@', 'whitelist-recipients=s@',
-        'retry-window=s', 'greylist-action=s', 'greylist-text=s', 'privacy',
-        'hostname=s', 'exim'
+        'retry-window=s', 'retry-count=i',
+        'greylist-action=s', 'greylist-text=s', 'privacy',
+        'hostname=s', 'exim', 'tarpit:s',
     ) or exit(1);
     # note: lookup-by-subnet can be given for compatibility, but it is default
     # so do not do nothing with it...
@@ -461,7 +517,9 @@
             awl_clients      => defined $opt{'auto-whitelist-clients'} ?
                 ($opt{'auto-whitelist-clients'} ne '' ?
                     $opt{'auto-whitelist-clients'} : 5) : 5,
+            awl_delay        => $opt{'auto-whitelist-delay'} || 3600,
             retry_window     => $retry_window,
+            retry_count      => $opt{'retry-count'} || 1,
             greylist_action  => $opt{'greylist-action'} || 'DEFER_IF_PERMIT',
             greylist_text    => $opt{'greylist-text'} || 'Greylisted, see http://isg.ee.ethz.ch/tools/postgrey/help/%r.html',
             whitelist_clients_files    => $opt{'whitelist-clients'} ||
@@ -472,6 +530,9 @@
             privacy => defined $opt{'privacy'},
             hostname => defined $opt{hostname} ? $opt{hostname} : hostname,
             exim => defined $opt{'exim'},
+            tarpit           => defined $opt{'tarpit'} ?
+                ($opt{'tarpit'} ne '' ?
+                    $opt{'tarpit'} : 5) : undef,
         },
     }, 'postgrey';
 
@@ -554,6 +615,13 @@
             -Flags    => DB_CREATE,
             -Env      => $self->{postgrey}{db_env}
         ) or die "ERROR: can't create database $self->{server}{dbdir}/postgrey_clients.db: $!\n";
+	}
+	if($self->{postgrey}{tarpit}) { # use tarpit
+        tie(%{$self->{postgrey}{db_tarpit}}, 'BerkeleyDB::Btree',
+            -Filename => 'tarpit_clients.db',
+            -Flags    => DB_CREATE,
+            -Env      => $self->{postgrey}{db_env}
+        ) or die "ERROR: can't create database $self->{server}{dbdir}/tarpit_clients.db: $!\n";
     }
 }