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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
#!perl -w
sub register {
my ($self, $qp, $denial ) = @_;
if ( defined $denial and $denial =~ /^disconnect$/i ) {
$self->{_rhsbl}->{DENY} = DENY_DISCONNECT;
}
else {
$self->{_rhsbl}->{DENY} = DENY;
}
}
sub hook_mail {
my ($self, $transaction, $sender, %param) = @_;
my $res = new Net::DNS::Resolver;
my $sel = IO::Select->new();
my %rhsbl_zones_map = ();
# Perform any RHS lookups in the background. We just send the query packets
# here and pick up any results in the RCPT handler.
# MTAs gets confused when you reject mail during MAIL FROM:
my %rhsbl_zones = map { (split /\s+/, $_, 2)[0,1] } $self->qp->config('rhsbl_zones');
if ($sender->format ne '<>' and %rhsbl_zones) {
push(my @hosts, $sender->host);
#my $helo = $self->qp->connection->hello_host;
#push(@hosts, $helo) if $helo && $helo ne $sender->host;
for my $host (@hosts) {
for my $rhsbl (keys %rhsbl_zones) {
# fix to find TXT records, if the rhsbl_zones line doesn't have second field
if (defined($rhsbl_zones{$rhsbl})) {
$self->log(LOGDEBUG, "Checking $host.$rhsbl for A record in the background");
$sel->add($res->bgsend("$host.$rhsbl"));
} else {
$self->log(LOGDEBUG, "Checking $host.$rhsbl for TXT record in the background");
$sel->add($res->bgsend("$host.$rhsbl", "TXT"));
}
$rhsbl_zones_map{"$host.$rhsbl"} = $rhsbl_zones{$rhsbl};
}
}
%{$self->{_rhsbl_zones_map}} = %rhsbl_zones_map;
$transaction->notes('rhsbl_sockets', $sel);
} else {
$self->log(LOGDEBUG, 'no RHS checks necessary');
}
return DECLINED;
}
sub hook_rcpt {
my ($self, $transaction, $rcpt) = @_;
my $host = $transaction->sender->host;
my $hello = $self->qp->connection->hello_host;
my $result = $self->process_sockets;
if ($result && defined($self->{_rhsbl_zones_map}{$result})) {
if ($result =~ /^$host\./ ) {
return ($self->{_rhsbl}->{DENY}, "Mail from $host rejected because it " . $self->{_rhsbl_zones_map}{$result});
} else {
return ($self->{_rhsbl}->{DENY}, "Mail from HELO $hello rejected because it " . $self->{_rhsbl_zones_map}{$result});
}
}
return ($self->{_rhsbl}->{DENY}, $result) if $result;
return DECLINED;
}
sub process_sockets {
my ($self) = @_;
my $trans = $self->transaction;
my $result = '';
return $trans->notes('rhsbl') if $trans->notes('rhsbl');
my $res = new Net::DNS::Resolver;
my $sel = $trans->notes('rhsbl_sockets') or return '';
$self->log(LOGDEBUG, 'waiting for rhsbl dns');
# don't wait more than 8 seconds here
my @ready = $sel->can_read(8);
$self->log(LOGDEBUG, 'DONE waiting for rhsbl dns, got ' , scalar @ready, ' answers ...') ;
return '' unless @ready;
for my $socket (@ready) {
my $query = $res->bgread($socket);
$sel->remove($socket);
undef $socket;
if ($query) {
foreach my $rr ($query->answer) {
$self->log(LOGDEBUG, 'got an ' . $rr->type . ' record ' . $rr->name);
if ($rr->type eq 'A') {
$result = $rr->name;
$self->log(LOGDEBUG, "A record found for $result with IP " . $rr->address);
last;
} elsif ($rr->type eq 'TXT') {
$result = $rr->txtdata;
$self->log(LOGDEBUG, "TXT record found: " . $rr->txtdata);
last;
}
}
} else {
$self->log(LOGCRIT, "query failed: ", $res->errorstring) unless $res->errorstring eq 'NXDOMAIN';
}
if ($result) {
#kill any other pending I/O
$trans->notes('rhsbl_sockets', undef);
return $trans->notes('rhsbl', $result);
}
}
if ($sel->count) {
# loop around if we have dns results left
return $self->process_sockets();
}
# if there was more to read; then forget it
$trans->notes('rhsbl_sockets', undef);
return $trans->notes('rhsbl', $result);
}
sub hook_disconnect {
my ($self, $transaction) = @_;
$transaction->notes('rhsbl_sockets', undef);
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
|
