qpsmtpd/plugins/async/rhsbl

#!perl -Tw

use Qpsmtpd::Plugin::Async::DNSBLBase;

sub init {
    my $self = shift;
    my $class = ref $self;

    no strict 'refs';
    push @{"${class}::ISA"}, 'Qpsmtpd::Plugin::Async::DNSBLBase';
}

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

    return DECLINED if $sender->format eq '<>';

    my %rhsbl_zones =
      map { (split /\s+/, $_, 2)[0, 1] } $self->qp->config('rhsbl_zones');
    return DECLINED unless %rhsbl_zones;

    my $sender_host = $sender->host;

    my @A_zones   = grep { defined($rhsbl_zones{$_}) } keys %rhsbl_zones;
    my @TXT_zones = grep { !defined($rhsbl_zones{$_}) } keys %rhsbl_zones;

    if (@A_zones) {

        # message templates for responding to the client
        $transaction->notes(rhsbl_templates =>
                     {map { +"$sender_host.$_" => $rhsbl_zones{$_} } @A_zones});
    }

    return DECLINED
      unless $class->lookup($self->qp,
                            [map { "$sender_host.$_" } @A_zones],
                            [map { "$sender_host.$_" } @TXT_zones],
                           );

    return YIELD;
}

sub process_a_result {
    my ($class, $qp, $result, $query) = @_;

    my $transaction = $qp->transaction;
    $transaction->notes('rhsbl',
                        $transaction->notes('rhsbl_templates')->{$query})
      unless $transaction->notes('rhsbl');
}

sub process_txt_result {
    my ($class, $qp, $result, $query) = @_;

    my $transaction = $qp->transaction;
    $transaction->notes('rhsbl', $result) unless $transaction->notes('rhsbl');
}

sub hook_rcpt {
    my ($self, $transaction, $rcpt) = @_;
    my $host = $transaction->sender->host;

    my $note = $transaction->notes('rhsbl');
    return (DENY, "Mail from $host rejected because it $note") if $note;
    return DECLINED;
}

=head1 NAME

rhsbl - handle RHSBL lookups

=head1 DESCRIPTION

Pluging that checks the host part of the sender's address against a
configurable set of RBL services.

=head1 CONFIGURATION

This plugin reads the lists to use from the rhsbl_zones configuration
file. Normal domain based dns blocking lists ("RBLs") which contain TXT
records are specified simply as:

  dsn.rfc-ignorant.org

To configure RBL services which do not contain TXT records in the DNS,
but only A records, specify, after a whitespace, your own error message
to return in the SMTP conversation e.g.

  abuse.rfc-ignorant.org does not support abuse@domain

=cut