=head1 NAME

handler - generic email handler/redirector

=head1 DESCRIPTION

Generic plugin to reject, drop, redirect, or munge an email based on a 
numeric score passed as a transaction note e.g. by spam or virus filters. 
The intention is for this plugin to be able to implement most handling 
'policies' in one place, allowing filtering plugins (e.g. spam/virus/etc.) 
to be simpler, pluggable, and cumulative.

handler should appear in the qpsmtpd config/plugins file after the filter
plugins it is assocated with, but before any QUEUE plugins.

Note: redirection requires a recipients() mutator that is not available
in stock Qpsmtpd. The one-line patch should be available from wherever you
sourced this plugin.

Note: if you want to invoke 'handler' multiple times (e.g. for both spam
handling and virus handling), you can create symlinked versions and use
the symlink names in the config/plugins file e.g.

  spamhandler note spam_score redirect_threshold 7 redirect_recipient spam
  vhandler note virus_score redirect_threshold 1 redirect_recipient virus

=head1 CONFIG

handler accepts the following parameters either via the config/plugins
line or via a 'handler' (or your symlinked name, if applicable) config 
file (one parameter per line, name and value space-separated).

=over 4

=item note <name>

The name of the transaction note containing the numeric score to be used
to determine how we handle the mail. Default: spam_score.

=item reject_threshold <threshold>[-<max_threshold>]

The score at which the mail will be rejected outright (or a range
within which the score must fall if max_threshold is specified). This
should probably be pretty large e.g. for spamassassin, 15 or 20.
Rejection is a terminal state, so rejected mail is never redirected or
munged. Default: never reject.

=item reject_note <name>

A transaction note containing the message to be issued with a rejection.
The escape sequences %n and %v can be used as placeholders for the score
transaction note and its value, respectively. The default message is:
"%n too high - message denied." Default reject_note: none.

=item drop_threshold <threshold>[-<max_threshold>]

The score at which the mail will be dropped i.e. accepted, and then 
fed to /dev/null (or a range within which the score must fall if 
max_threshold is specified). Dropping the mail is a terminal state,
so rejected mail is never redirected or munged. Default: never drop.

=item redirect_threshold <threshold>[-<max_threshold>]

The score above which the mail will be redirected instead of delivered
to the specified recipients (or a range within which the score must fall
if max_threshold is specified). Requires the 'redirect_recipient'
parameter below. Default: none.

=item redirect_recipient <recipient_addr>

Email address to which mail scoring above the redirect_threshold (or 
within the reject_threshold range) is redirected (currently requires 
a one-line patch to Qpsmtpd::Transaction).

If the address is a standard email address it replaces the current 
recipient list completely. Otherwise, if the redirect address is a bare
username with no domain component then existing recipient domains are 
retained, and the username is munged as follows: 

=over 4

=item

if the address is a bare username ending in a hyphen (e.g. 'spam-'),
it is prefixed to existing recipient usernames (allowing per-user
mailboxes within a spam account and a spam-default catchall)

=item

if the address is a bare username beginning with a hyphen (e.g.
'-spam'), it is suffixed to existing recipient usernames (allowing
per-user spam mailboxes)

=item

otherwise the bare username (e.g. 'spam' replaces existing recipient
usernames (allowing per-domain spam mailboxes)

=back

Examples, spam to recipient gavin@openfusion.com.au:

  redirect_recipient spam@my.domain.com     # -> spam@mydomain.com
  redirect_recipient spam                   # -> spam@openfusion.com.au
  redirect_recipient spam-                  # -> spam-gavin@openfusion.com.au
  redirect_recipient -spam                  # -> gavin-spam@openfusion.com.au

=item munge_threshold <threshold>[-<max_threshold>]

The score above which the mail becomes a candidate for munging in
various ways (or a range within which the score must fall if
max_threshold is specified). See the 'munge_subject' parameter below.
Default: do not munge.

=item munge_subject <tag>

The tag (default: '***SPAM***') to prepend to the Subject header (if 
not already present) if the score exceeds munge_threshold above. 

=item per_recipient <boolean>

(only via config/plugins) Allow per-recipient 'handler' config files 
to be used. Note that because handler is a post_data plugin, it is 
required and assumed that all recipients are using the same config 
definitions (see e.g. the denysoft_multi_rcpt plugin).

=back

=head1 NOTES

Might be other actions that could usefully be included here, such as 
adding to blacklists or greylists or tarpits (e.g. Spam Cannibal).

Currently only tests transaction notes. Should probably extend this to
connection notes to as well, to allow connection plugins to be handled
too.

=head1 AUTHOR

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

=cut

use Mail::Address;

my $VERSION = 0.04;

my %DEFAULTS = (
  note => 'spam_score',
  munge_subject => '***SPAM***',
  reject_message => '%n too high - message denied',
);

my ($plugin) = (__PACKAGE__ =~ m/([^:]+)$/);

sub register {
  my ($self, $qp, %arg) = @_;
  $self->{_defaults} = { %DEFAULTS, %arg };
  $self->register_hook($arg{per_recipient} ? "rcpt" : "mail", "load_config");
  $self->register_hook("data_post", "check_score");
  $self->register_hook("queue", "check_drop");
}

sub load_config {
  my ($self, $transaction, $rcpt) = @_;

  # Setup only once (data plugin: must assume all recipients use the same config!)
  return DECLINED if $self->{_config};

  # Setup config from defaults and handler config
  my $config_arg = $self->{_defaults}->{per_recipient} ? { rcpt => $rcpt } : {};
  my @config = $self->qp->config($plugin, $config_arg);
  $self->{_config} = { 
    %{$self->{_defaults}},
    @config ? map { split /\s+/, $_, 2 } @config : ()
  };

  # Check redirect_recipient is set if redirect_threshold
  $self->log(LOGWARN, "$plugin: redirect_recipient is missing with redirect_threshold set")
    if $self->{_config}->{redirect_threshold} && 
     ! $self->{_config}->{redirect_recipient};

  # Check thresholds for max arguments
  for my $t (qw(reject_threshold drop_threshold redirect_threshold munge_threshold)) {
    if ($self->{_config}->{$t} && $self->{_config}->{$t} =~ m/[-,]/) {
      my ($min,$max) = split /[-,]/, $self->{_config}->{$t}, 2;
      $self->{_config}->{$t} = $min if $min  && $min =~ m/\d+/;
      $self->{_config}->{"${t}_max"} = $max if $max && $max =~ m/\d+/;
    }
  }

  $self->log(LOGDEBUG, "$plugin config: " . join(', ',
    map { $_ . '=' . $self->{_config}->{$_} } sort keys %{$self->{_config}}));
  return (DECLINED);
}

sub check_score {
  my ($self, $transaction) = @_;
  my $score = $transaction->notes($self->{_config}->{note}) or return DECLINED;
  $self->log(LOGNOTICE, $self->{_config}->{note} . ": $score");
  $transaction->header->add("X-\u$plugin-Score", $score);

  # Deny if reject threshold exceeded
  if (defined $self->{_config}->{reject_threshold} and 
    $score >= $self->{_config}->{reject_threshold} and
      (! exists $self->{_config}->{reject_threshold_max} or
       $score < $self->{_config}->{reject_threshold_max})) {
    my $reject_message = $transaction->notes($self->{_config}->{reject_note})
      if $self->{_config}->{reject_note};
    $reject_message ||= $self->{_config}->{reject_message}; 
    # Substitute %n and %v for score note name and value
    $reject_message =~ s/%n/$self->{_config}->{note}/g;
    $reject_message =~ s/%v/$score/g;
    return DENY, $reject_message;
  }

  if (defined $self->{_config}->{drop_threshold} and 
    $score >= $self->{_config}->{drop_threshold} and
      (! exists $self->{_config}->{drop_threshold_max} or
       $score < $self->{_config}->{drop_threshold_max})) {
    $transaction->notes('handler_drop' => 1);
    return DECLINED;
  }

  # Redirect if redirect threshold exceeded
  $self->redirect($transaction)
    if defined $self->{_config}->{redirect_threshold} and 
      $score >= $self->{_config}->{redirect_threshold} and
        (! exists $self->{_config}->{redirect_threshold_max} or
         $score < $self->{_config}->{redirect_threshold_max});

  # Munge if munge threshold exceeded
  $self->munge($transaction)
    if defined $self->{_config}->{munge_threshold} and 
      $score >= $self->{_config}->{munge_threshold} and
        (! exists $self->{_config}->{munge_threshold_max} or
         $score < $self->{_config}->{munge_threshold_max});

  return DECLINED;
}

sub munge {
  my ($self, $transaction) = @_;
  my $tag = $self->{_config}->{munge_subject};
  if ($tag) {
    my $subject = $transaction->header->get('Subject') || '';
    $transaction->header->replace('Subject', "$tag $subject");
    $transaction->header->add("X-\u$plugin-Munge", $tag);
  }

  return DECLINED;
}

sub redirect {
  my ($self, $transaction) = @_;
  $transaction->notes('handler_redirect') and return DECLINED;   # Once only
  my $rcpt = $self->{_config}->{redirect_recipient} or return DECLINED;

  # Full email address - replace recipients list
  if ($rcpt =~ m'@') {
    my @rcpt = Mail::Address->parse($rcpt);
    unless (@rcpt) {
      $self->log(LOGERROR, sprintf("failed to parse any redirect_recipient addresses: '%s'", $rcpt));
      return DECLINED;
    }
    # NB: requires non-standard recipients() mutator
    $transaction->recipients(@rcpt);
    $self->log(LOGNOTICE,"redirect: to " . join(',',map { $_->address } @rcpt));
    $transaction->header->add("X-\u$plugin-Redirect", join(',',map { $_->address } @rcpt));
  }

  # Recipient is username without domain
  else {
    for my $r ($transaction->recipients) {
      my $new = $rcpt;
      if (substr($rcpt,0,1) eq '-') {
        # Suffix username e.g. -spam
        $new = $r->user . $rcpt;
      } elsif (substr($rcpt,-1) eq '-') {
        # Prefix username e.g. spam-
        $new = $rcpt . $r->user;
      }
      $new .= '@' . $r->host if $r->host;
      my $old = $r->address;
      $r->address($new);
      $self->log(LOGNOTICE,sprintf("redirect: '%s' -> '%s'",$old,$new));
      $transaction->header->add("X-\u$plugin-Redirect", $new);
    }
  }

  $transaction->notes(handler_redirect => $rcpt);
  $transaction->notes(qpstats_queue_replace => '$plugin:redirect');

  return DECLINED;
}

sub check_drop
{
  my ($self, $transaction) = @_;

  # If handler_drop set, fake a queue and OK
  if ($transaction->notes('handler_drop')) {
    my $msg_id = $transaction->header->get('Message-Id') || '';
    $msg_id =~ s/[\r\n].*//s;  # don't allow newlines in the Message-Id here
    return (OK, "Queued! $msg_id");
  }
  
  return DECLINED;
}


# arch-tag: 09ce6583-fc2e-4b05-b8e4-d38df5810b92