/usr/share/qpsmtpd/plugins/rhsbl is in qpsmtpd 0.94-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | #!perl -w
=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
use strict;
use warnings;
use Qpsmtpd::Constants;
sub register {
my ($self, $qp) = (shift, shift);
if (@_ == 1) {
$self->legacy_positional_args(@_);
}
else {
$self->{_args} = {@_};
}
$self->{_args}{reject} = 1 if !defined $self->{_args}{reject};
$self->{_args}{reject_type} ||= 'perm';
}
sub legacy_positional_args {
my ($self, $denial) = @_;
if (defined $denial && $denial =~ /^disconnect$/i) {
$self->{_args}{reject_type} = 'disconnect';
}
else {
$self->{_args}{reject_type} = 'perm';
}
}
sub hook_mail {
my ($self, $transaction, $sender, %param) = @_;
return DECLINED if $self->is_immune();
if ($sender->format eq '<>') {
$self->log(LOGINFO, 'pass, null sender');
return DECLINED;
}
my %rhsbl_zones = $self->populate_zones() or return DECLINED;
my $res = $self->init_resolver();
my @hosts = $sender->host;
for my $host (@hosts) {
for my $rhsbl (keys %rhsbl_zones) {
my $query;
# 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");
$query = $res->query("$host.$rhsbl");
}
else {
$self->log(LOGDEBUG, "Checking $host.$rhsbl for TXT record");
$query = $res->query("$host.$rhsbl", 'TXT');
}
if (!$query) {
if ($res->errorstring ne 'NXDOMAIN') {
$self->log(LOGCRIT, "query failed: ", $res->errorstring);
}
next;
}
my $result;
foreach my $rr ($query->answer) {
$self->log(LOGDEBUG,
'got an ' . $rr->type . ' record ' . $rr->name);
if ($rr->type eq 'A') {
$self->log(LOGDEBUG,
"A record found for $result with IP " . $rr->address);
$result = $rr->name;
}
elsif ($rr->type eq 'TXT') {
$result = $rr->txtdata;
$self->log(LOGDEBUG, "TXT record found: " . $rr->txtdata);
}
next if !$result;
$self->log(LOGINFO, "fail, $result");
if ($transaction->sender) {
my $host = $transaction->sender->host;
if ($result =~ /^$host\./) {
return $self->get_reject(
"Mail from $host rejected because it $result");
}
}
my $hello = $self->qp->connection->hello_host;
return $self->get_reject(
"Mail from HELO $hello rejected because it $result");
}
}
}
$self->log(LOGINFO, "pass");
return DECLINED;
}
sub populate_zones {
my $self = shift;
my %rhsbl_zones =
map { (split /\s+/, $_, 2)[0, 1] } $self->qp->config('rhsbl_zones');
if (!keys %rhsbl_zones) {
$self->log(LOGINFO, 'pass, no zones');
return;
}
return %rhsbl_zones;
}
|