=head1 NAME

denysoft_greylist

=head1 DESCRIPTION

Plugin to implement the 'greylisting' algorithm proposed by Evan 
Harris in http://projects.puremagic.com/greylisting/. Greylisting is 
a form of denysoft filter, where unrecognised new connections are 
temporarily denied for some initial period, to foil spammers using 
fire-and-forget spamware, http_proxies, etc.

Greylisting adds two main features: it tracks incoming connections 
using a triplet of remote IP address, sender, and recipient, rather 
than just using the remote IP; and it uses a set of timeout periods 
(black/grey/white) to control whether connections are allowed, instead 
of using connection counts or rates.

This plugin allows connection tracking on any or all of IP address, 
sender, and recipient (but uses IP address only, by default), with 
configurable greylist timeout periods. A simple dbm database is used 
for tracking connections, and relayclients are always allowed 
through. The plugin supports whitelisting using the whitelist_soft
plugin (optional).


=head1 CONFIG

The following parameters can be passed to denysoft_greylist:

=over 4

=item remote_ip <bool>

Whether to include the remote ip address in tracking connections.
Default: 1.

=item sender <bool>

Whether to include the sender in tracking connections. Default: 0.

=item recipient <bool>

Whether to include the recipient in tracking connections. Default: 0.

=item deny_late <bool>

Whether to defer denials during the 'mail' hook until 'data_post'
e.g. to allow per-recipient logging. Default: 0.

=item black_timeout <timeout_seconds>

The initial period, in seconds, for which we issue DENYSOFTs for 
connections from an unknown (or timed out) IP address and/or sender
and/or recipient (a 'connection triplet'). Default: 50 minutes.

=item grey_timeout <timeout_seconds>

The subsequent 'grey' period, after the initial black blocking period,
when we will accept a delivery from a formerly-unknown connection
triplet. If a new connection is received during this time, we will 
record a successful delivery against this IP address, which whitelists 
it for future deliveries (see following). Default: 3 hours 20 minutes.

=item white_timeout <timeout_seconds>

The period after which a known connection triplet will be considered 
stale, and we will issue DENYSOFTs again. New deliveries reset the 
timestamp on the address and renew this timeout. Default: 36 days.

=item testonly <bool>

Testing flag - if this is set we log and track connections as normal, 
but never actually issue DENYSOFTs. Useful for seeding the database 
and testing without actually impacting deliveries. Default: 0.

=back

=head1 BUGS

Database locking is implemented using flock, which may not work on 
network filesystems e.g. NFS. If this is a problem, you may want to
use something like File::NFSLock instead.

=head1 AUTHOR

Written by Gavin Carr <gavin@openfusion.com.au>.

=cut

BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) }
use AnyDBM_File;
use Fcntl qw(:DEFAULT :flock);
use strict;

my $VERSION = '0.05';

my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!);
my $DBDIR = -d "$QPHOME/var/db" ? "$QPHOME/var/db" : "$QPHOME/config";
my $DB = "$DBDIR/denysoft_greylist.dbm";
my $BLACK_DEFAULT = 50 * 60;
my $GREY_DEFAULT  = 3 * 3600 + 20 * 60;
my $WHITE_DEFAULT = 36 * 24 * 3600;

sub register {
  my ($self, $qp, %arg) = @_;
  $self->{_greylist_ip}     = $arg{remote_ip};
  $self->{_greylist_sender} = $arg{sender};
  $self->{_greylist_rcpt}   = $arg{recipient};
  $self->{_greylist_ip}	    = 1 if ! defined $self->{_greylist_ip};
  $self->{_greylist_sender} = 0 if ! defined $self->{_greylist_sender};
  $self->{_greylist_rcpt}   = 0 if ! defined $self->{_greylist_rcpt};
  $self->{_greylist_black}  = $arg{black_timeout} || $BLACK_DEFAULT;
  $self->{_greylist_grey}   = $arg{grey_timeout}  || $GREY_DEFAULT;
  $self->{_greylist_white}  = $arg{white_timeout} || $WHITE_DEFAULT;
  $self->{_greylist_deny_late} = $arg{deny_late};
  $self->{_greylist_testonly} = $arg{testonly};
  unless ($self->{_greylist_rcpt}) {
    $self->register_hook("mail", "mail_handler");
  } else {
    $self->register_hook("rcpt", "rcpt_handler");
  }
  $self->register_hook("data_post", "data_handler");
}

sub mail_handler {
  my ($self, $transaction, $sender) = @_;
  my ($status, $msg) = $self->denysoft_greylist($transaction, $sender, undef);
  if ($status == DENYSOFT) {
    return (DENYSOFT, $msg) unless $self->{_greylist_deny_late};
    $transaction->notes('denysoft_greylist', $msg) 
  }
  return (DECLINED);
}

sub rcpt_handler {
  my ($self, $transaction, $rcpt) = @_;
  my $sender = $transaction->sender;
  my ($status, $msg) = $self->denysoft_greylist($transaction, $sender, $rcpt);
  if ($status == DENYSOFT) {
    # Deny here (per-rcpt) unless this is a <> sender, for smtp probes
    return (DENYSOFT, $msg) if $sender->address;
    $transaction->notes('denysoft_greylist', $msg);
  }
  return (DECLINED);
}

sub data_handler {
  my ($self, $transaction) = @_;
  my $note = $transaction->notes('denysoft_greylist');
  return (DECLINED) unless $note;
  # Decline if ALL recipients are whitelisted
  if (($transaction->notes('whitelistrcpt')||0) == scalar($transaction->recipients)) {
    $self->log(4,"all recipients whitelisted - skipping");
    return (DECLINED);
  }
  return (DENYSOFT, $note);
}

sub denysoft_greylist {
  my ($self, $transaction, $sender, $rcpt) = @_;
  my $denymsg = "This mail is temporarily denied";

  # Always allow relayclients and whitelisted hosts/senders
  return (DECLINED) if exists $ENV{RELAYCLIENT};
  return (DECLINED) if $self->qp->connection->notes('whitelisthost');
  return (DECLINED) if $transaction->notes('whitelistsender');

  my $remote_ip = $self->qp->connection->remote_ip;
  my $fmt = "%s:%d:%d:%d";

  # Check denysoft db
  unless (open LOCK, ">$DB.lock") {
    $self->log(2, "opening lockfile failed: $!");
    return (DECLINED);
  }
  unless (flock LOCK, LOCK_EX) {
    $self->log(2, "flock of lockfile failed: $!");
    close LOCK;
    return (DECLINED);
  }
  my %db = ();
  unless (tie %db, 'AnyDBM_File', $DB, O_CREAT|O_RDWR, 0600) {
    $self->log(2, "tie to database $DB failed: $!");
    close LOCK;
    return (DECLINED);
  }
  my @key;
  push @key, $remote_ip             if $self->{_greylist_ip};
  push @key, $sender->address || '' if $self->{_greylist_sender};
  push @key, $rcpt->address         if $rcpt && $self->{_greylist_rcpt};
  my $key = join ':', @key;
  my ($ts, $new, $black, $white) = (0,0,0,0);
  if ($db{$key}) {
    ($ts, $new, $black, $white) = split /:/, $db{$key};
    $self->log(3, "ts: " . localtime($ts) . ", now: " . localtime);
    if (! $white) {
      # Black IP - deny, but don't update timestamp
      if (time - $ts < $self->{_greylist_black}) {
        $db{$key} = sprintf $fmt, $ts, $new, ++$black, 0;
        $self->log(2, "key $key black DENYSOFT - $black failed connections");
        untie %db;
        close LOCK;
        return $self->{_greylist_testonly} ? (DECLINED) : (DENYSOFT, $denymsg);
      }
      # Grey IP - accept unless timed out
      elsif (time - $ts < $self->{_greylist_grey}) {
        $db{$key} = sprintf $fmt, time, $new, $black, 1;
        $self->log(2, "key $key updated grey->white");
        untie %db;
        close LOCK;
        return (DECLINED);
      }
      else {
        $self->log(3, "key $key has timed out (grey)");
      }
    }
    # White IP - accept unless timed out
    else {
      if (time - $ts < $self->{_greylist_white}) {
        $db{$key} = sprintf $fmt, time, $new, $black, ++$white;
        $self->log(2, "key $key is white, $white deliveries");
        untie %db;
        close LOCK;
        return (DECLINED);
      }
      else {
        $self->log(3, "key $key has timed out (white)");
      }
    }
  }

  # New ip or entry timed out - record new and return DENYSOFT
  $db{$key} = sprintf $fmt, time, ++$new, $black, 0;
  $self->log(2, "key $key initial DENYSOFT, unknown");
  untie %db;
  close LOCK;
  return $self->{_greylist_testonly} ? (DECLINED) : (DENYSOFT, $denymsg);
}

# tag: plugin to implement greylisting