Check recipients of a bounce mail against a list of regular expressions

use Qpsmtpd::Constants;

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

  return (DECLINED) unless ($sender->format eq "<>" or $sender->user eq "MAILER-DAEMON");

  $self->log(LOGDEBUG, "sender is " . $sender->format);
  $transaction->notes('bounce',1);

  return (DECLINED);
}

sub hook_rcpt {
    my ($self, $transaction, $recipient) = @_;
    return (DECLINED)
      unless $recipient->host && $recipient->user;

    my $note = $transaction->notes('bounce');
    return DECLINED unless $note;

    my $rcpt = lc $recipient->user . '@' . $recipient->host;
    my ($re, $const, $comment, $str, $ok, $err);

    foreach ($self->qp->config("bounce_rcpt_regexp")) {
        s/^\s*//;
        ($re, $const, $comment) = split /\s+/, $_, 3;
        $str = undef;
        if ($re =~ m#^/(.*)/$#) {
            $re = $1;
            $ok = eval { $re = qr/$re/i; };
            if ($@) {
                ($err = $@) =~ s/\s*at \S+ line \d+\.\s*$//;
                $self->log(LOGWARN, "REGEXP '$re' not valid: $err");
                next;
            }
            $re = $ok;
        }
        else {
            $str = lc $re;
        }

        unless (defined $const) {
            $self->(LOGWARN, "rcpt_regexp - no return code");
            next;
        }

        $ok    = $const;
        $const = Qpsmtpd::Constants::return_code($const);
        unless (defined $const) {
            $self->log(LOGWARN,
                           "rcpt_regexp - '$ok' is not a valid "
                         . "constant, ignoring this line"
                      );
            next;
        }

        if (defined $str) {
            next unless $str eq $rcpt;
            $self->log(LOGDEBUG, "String $str matched $rcpt, returning $ok");
        }
        else {
            next unless $rcpt =~ $re;
            $self->log(LOGDEBUG, "RE $re matched $rcpt, returning $ok");
        }

        return ($const, $comment);
    }
    return (DECLINED);
}

=head1 NAME

bounce_rcpt_regexp - check recipients of a bounce mail against a list of 
regular expressions

=head1 DESCRIPTION

When B<bounce_rcpt_regexp> finds a bounce mail, i.e. one that has "<>" as the 
envelope sender or "MAILER-DAEMON" as the local part of the envelope sender, 
it reads a list of regular expressions, return codes and comments
from the I<rcpt_regexp> config file. If the regular expression does NOT match
I<m#^(/.*/)$#>, it is used as a string which is compared with I<eq lc($rcpt)>.
The recipient addresses are checked against this list, and if the first 
matches, the return code from that line and the comment are returned to
qpsmtpd. Return code can be any valid plugin return code from 
Qpsmtpd::Constants. Matching is always done case insenstive. 

=head1 CONFIG FILE

The config file I<bounce_rcpt_regexp> contains lines with a perl RE, including the 
"/"s, a return code and a comment, which will be returned to the sender, if 
the code is not OK or DECLINED. Example:

  # bounce_rcpt_regexp - config for rcpt_regexp plugin
  /me-.*@myhost.org/            DECLINED   Fall through to next rcpt plugin
  /me-.*@myotherhost.org/       DECLINED   Fall through to next rcpt plugin
  /.*/                          DENY       No such account - checking SPF records would prevent bouncing of joe-job emails

=head1 COPYRIGHT AND LICENSE

This plugin is based on the plugin B<rcpt_regexp> by Hanno Becker.

Copyright (c) 2005 Hanno Hecker

Copyright (c) 2007 Werner Fleck

This plugin is licensed under the same terms as the qpsmtpd package itself.
Please see the LICENSE file included with qpsmtpd for details.

=cut

# vim: ts=4 sw=4 expandtab syn=perl