*** postgrey.orig	Thu Sep  6 23:32:58 2007
--- postgrey	Sat Sep 15 19:15:58 2007
***************
*** 291,296 ****
--- 291,312 ----
              $self->mylog(1, "cleaning clients database finished. before: $nr_keys_before, after: $nr_keys_after");
          }
  
+         if($self->{postgrey}{targrey}) {
+             # 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(1, "cleaning tarpit blacklist database finished. before: $nr_keys_before, after: $nr_keys_after");
+         }
+ 
          $self->{postgrey}{last_maint_keys}=$now;
      }
  }
***************
*** 365,371 ****
          # whitelist if count is enough
          if(defined $cawl_count and $cawl_count >= $self->{postgrey}{awl_clients})
          {
!             if($now >= $cawl_last+3600) {
                  $cawl_count++; # for statistics
                  $cawl_db->{$cawl_key}=$cawl_count.','.$now;
              }
--- 381,387 ----
          # whitelist if count is enough
          if(defined $cawl_count and $cawl_count >= $self->{postgrey}{awl_clients})
          {
!             if($now >= $cawl_last + $self->{postgrey}{awl_delay}) {
                  $cawl_count++; # for statistics
                  $cawl_db->{$cawl_key}=$cawl_count.','.$now;
              }
***************
*** 374,379 ****
--- 390,417 ----
          }
      }
  
+     # check tarpit passed if targrey mode
+     if ($self->{postgrey}{targrey} && $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(1, "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) =
***************
*** 384,393 ****
      }
      my $val    = $db->{$key};
      my $first;
      my $last_was_successful=0;
      if(defined $val) {
          my $last;
!         ($first, $last) = 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}) {
--- 422,432 ----
      }
      my $val    = $db->{$key};
      my $first;
+     my $retry_count=0;
      my $last_was_successful=0;
      if(defined $val) {
          my $last;
!         ($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}) {
***************
*** 403,418 ****
          $first = $now;
      }
  
      # update (put as last element stripped host-part if it was stripped)
      if(defined $client_host) {
!         $db->{$key}="$first,$now,$client_host";
      }
      else {
!         $db->{$key}="$first,$now";
      }
  
-     my $diff = $self->{postgrey}{delay} - ($now - $first);
- 
      # auto whitelist clients
      # algorithm:
      # - on successful entry in the greylist db of a triplet:
--- 442,460 ----
          $first = $now;
      }
  
+     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,$retry_count,$client_host";
      }
      else {
!         $db->{$key}="$first,$now,$retry_count";
      }
  
      # auto whitelist clients
      # algorithm:
      # - on successful entry in the greylist db of a triplet:
***************
*** 420,442 ****
      #   - client whitelisted already? -> update last-seen timestamp
      if($self->{postgrey}{awl_clients}) {
          # greylisting succeeded
!         if($diff <= 0 and !$last_was_successful) {
              # enough time has passed (record only one attempt per hour)
!             if(! defined $cawl_last or $now >= $cawl_last + 3600) {
                  # ok, increase count
                  $cawl_count++;
                  $cawl_db->{$cawl_key}=$cawl_count.','.$now;
                  my $client = $attr->{client_name} ?
                      $attr->{client_name}.'['.$attr->{client_address}.']' :
                      $attr->{client_address};
!                 $self->mylog(1, "whitelisted: $client")
                      if $cawl_count==$self->{postgrey}{awl_clients};
              }
          }
      }
  
!     # not enough waited? -> greylist
!     if ($diff > 0 ) {
          my $msg = $self->{postgrey}{greylist_text};
          # Workaround for an Exchange bug related to Greylisting:
          # use DSN 4.2.0 instead of the default 4.7.1. This works
--- 462,502 ----
      #   - client whitelisted already? -> update last-seen timestamp
      if($self->{postgrey}{awl_clients}) {
          # greylisting succeeded
!         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 + $self->{postgrey}{awl_delay}) {
                  # ok, increase count
                  $cawl_count++;
                  $cawl_db->{$cawl_key}=$cawl_count.','.$now;
                  my $client = $attr->{client_name} ?
                      $attr->{client_name}.'['.$attr->{client_address}.']' :
                      $attr->{client_address};
!                 $self->mylog(1, "whitelisted: $attr->{client_name}"."[".$attr->{client_address}."]")
                      if $cawl_count==$self->{postgrey}{awl_clients};
              }
          }
      }
  
!     # not enough retry? -> greylist
!     if ($retry_count < $self->{postgrey}{retry_count}) {
!         if($self->{postgrey}{tarpit} && ! $self->{postgrey}{targrey}) {
!             # do tarpit and greylist if tarpit option only
!             # don't add message after greylist_action
!             return "SLEEP $self->{postgrey}{tarpit}, $self->{postgrey}{greylist_action}";
!         }
!         if($self->{postgrey}{targrey}) {
!             # do tarpit if targrey option
!             # 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 tarpit blacklisted
!         }
          my $msg = $self->{postgrey}{greylist_text};
          # Workaround for an Exchange bug related to Greylisting:
          # use DSN 4.2.0 instead of the default 4.7.1. This works
***************
*** 484,493 ****
      GetOptions(\%opt, 'help|h', 'man', 'version', 'noaction|no-action|n',
          'verbose|v', 'quiet|q', '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', 
          'whitelist-clients=s@', 'whitelist-recipients=s@',
!         'retry-window=s', 'greylist-action=s', 'greylist-text=s', 'privacy',
!         'hostname=s', 'exim', 'listen-queue-size=i'
      ) or exit(1);
      # note: lookup-by-subnet can be given for compatibility, but it is default
      # so do not do nothing with it...
--- 544,556 ----
      GetOptions(\%opt, 'help|h', 'man', 'version', 'noaction|no-action|n',
          'verbose|v', 'quiet|q', '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', 'auto-whitelist-delay=i',
          'whitelist-clients=s@', 'whitelist-recipients=s@',
!         'retry-window=s', 'retry-count=i',
!         'greylist-action=s', 'greylist-text=s', 'privacy',
!         'hostname=s', 'exim', 'listen-queue-size=i',
!         'tarpit:s', 'targrey',
      ) or exit(1);
      # note: lookup-by-subnet can be given for compatibility, but it is default
      # so do not do nothing with it...
***************
*** 577,583 ****
--- 640,648 ----
              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://postgrey.schweikert.ch/help/%r.html',
              whitelist_clients_files    => $opt{'whitelist-clients'} ||
***************
*** 588,593 ****
--- 653,662 ----
              privacy => defined $opt{'privacy'},
              hostname => defined $opt{hostname} ? $opt{hostname} : hostname,
              exim => defined $opt{'exim'},
+             tarpit           => defined $opt{'tarpit'} ?
+                 ($opt{'tarpit'} ne '' ?
+                     $opt{'tarpit'} : 65) : undef,
+             targrey          => defined $opt{'targrey'},
          },
      }, 'postgrey';
  
***************
*** 603,608 ****
--- 672,682 ----
          require Digest::SHA1;
      }
  
+     # --targrey needs tarpit sec
+     if(defined $opt{'targrey'} && ! defined $opt{'tarpit'}) {
+         $server->{postgrey}{tarpit} = 125;
+     }
+ 
      $0 = join(' ', @{$server->{server}{commandline}});
      $server->run;
  
***************
*** 681,686 ****
--- 755,767 ----
              -Env      => $self->{postgrey}{db_env}
          ) or die "ERROR: can't create database $self->{server}{dbdir}/postgrey_clients.db: $!\n";
      }
+     if($self->{postgrey}{targrey}) { # use targrey
+         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";
+     }
  }
  
  sub mux_input()