File: rhsbl

package info (click to toggle)
qpsmtpd 0.84-9
  • links: PTS
  • area: main
  • in suites: wheezy
  • size: 1,376 kB
  • sloc: perl: 8,012; sh: 382; makefile: 61
file content (94 lines) | stat: -rw-r--r-- 2,459 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
#!perl -w

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;
}

1;

=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