b245d30e9e
rather than deferring until RCPT. This greatly improves efficiency, since most connections will get marked naughty much sooner, having run fewer tests.
367 lines
10 KiB
Perl
367 lines
10 KiB
Perl
#!perl -w
|
|
|
|
=head1 NAME
|
|
|
|
dnsbl - handle DNS BlackList lookups
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Plugin that checks the IP address of the incoming connection against
|
|
a configurable set of RBL services.
|
|
|
|
=head1 USAGE
|
|
|
|
Add the following line to the config/plugins file:
|
|
|
|
dnsbl
|
|
|
|
The following options are also availble:
|
|
|
|
=head2 reject [ 0 | 1 | naughty ]
|
|
|
|
dnsbl reject 0 <- do not reject
|
|
|
|
dnsbl reject 1 <- reject
|
|
|
|
dnsbl reject naughty <- See perldoc plugins/naughty
|
|
|
|
Also, when I<reject naughty> is set, DNS queries are processed during connect.
|
|
|
|
=head2 reject_type [ temp | perm | disconnect ]
|
|
|
|
Default: perm
|
|
|
|
To immediately drop the connection (since some blacklisted servers attempt
|
|
multiple sends per session), set I<reject_type disconnect>. In most cases,
|
|
an IP address that is listed should not be given the opportunity to begin a
|
|
new transaction, since even the most volatile blacklists will return the same
|
|
answer for a short period of time (the minimum DNS cache period).
|
|
|
|
=head2 loglevel
|
|
|
|
dnsbl [loglevel -1]
|
|
|
|
Adjust the quantity of logging for this plugin. See docs/logging.pod
|
|
|
|
=head1 CONFIG FILES
|
|
|
|
This plugin uses the following configuration files. All are optional. Not
|
|
specifying dnsbl_zones is like not using the plugin at all.
|
|
|
|
=head2 dnsbl_zones
|
|
|
|
Normal ip based dns blocking lists ("RBLs") which contain TXT records are
|
|
specified simply as:
|
|
|
|
relays.ordb.org
|
|
spamsources.fabel.dk
|
|
|
|
To configure RBL services which do not contain TXT records in the DNS,
|
|
but only A records (e.g. the RBL+ at http://www.mail-abuse.org), specify your
|
|
own error message to return in the SMTP conversation after a colon e.g.
|
|
|
|
rbl-plus.mail-abuse.org:You are listed at - http://http://www.mail-abuse.org/cgi-bin/lookup?%IP%
|
|
|
|
The string %IP% will be replaced with the IP address of incoming connection.
|
|
Thus a fully specified file could be:
|
|
|
|
sbl-xbl.spamhaus.org
|
|
list.dsbl.org
|
|
rbl-plus.mail-abuse.ja.net:Listed by rbl-plus.mail-abuse.ja.net - see <URL:http://www.mail-abuse.org/cgi-bin/lookup?%IP%>
|
|
relays.ordb.org
|
|
|
|
=head2 dnsbl_allow
|
|
|
|
List of allowed ip addresses that bypass RBL checking. Format is one entry per line,
|
|
with either a full IP address or a truncated IP address with a period at the end.
|
|
For example:
|
|
|
|
192.168.1.1
|
|
172.16.33.
|
|
|
|
NB the environment variable RBLSMTPD is considered before this file is
|
|
referenced. See below.
|
|
|
|
=head2 dnsbl_rejectmsg
|
|
|
|
A textual message that is sent to the sender on an RBL failure. The TXT record
|
|
from the RBL list is also sent, but this file can be used to indicate what
|
|
action the sender should take.
|
|
|
|
For example:
|
|
|
|
If you think you have been blocked in error, then please forward
|
|
this entire error message to your ISP so that they can fix their problems.
|
|
The next line often contains a URL that can be visited for more information.
|
|
|
|
=head1 Environment Variables
|
|
|
|
=head2 RBLSMTPD
|
|
|
|
The environment variable RBLSMTPD is supported and mimics the behaviour of
|
|
Dan Bernstein's rblsmtpd. The exception to this is the '-' char at the
|
|
start of RBLSMTPD which is used to force a hard error in Dan's rblsmtpd.
|
|
NB I don't really see the benefit
|
|
of using a soft error for a site in an RBL list. This just complicates
|
|
things as it takes 7 days (or whatever default period) before a user
|
|
gets an error email back. In the meantime they are complaining that their
|
|
emails are being "lost" :(
|
|
|
|
=over 4
|
|
|
|
=item RBLSMTPD is set and non-empty
|
|
|
|
The contents are used as the SMTP conversation error.
|
|
Use this for forcibly blocking sites you don't like
|
|
|
|
=item RBLSMTPD is set, but empty
|
|
|
|
In this case no RBL checks are made.
|
|
This can be used for local addresses.
|
|
|
|
=item RBLSMTPD is not set
|
|
|
|
All RBL checks will be made.
|
|
This is the setting for remote sites that you want to check against RBL.
|
|
|
|
=back
|
|
|
|
=head1 Revisions
|
|
|
|
See: https://github.com/smtpd/qpsmtpd/commits/master/plugins/dnsbl
|
|
|
|
=cut
|
|
|
|
sub register {
|
|
my ($self, $qp) = (shift, shift);
|
|
|
|
if ( @_ % 2 ) {
|
|
$self->{_args}{reject_type} = shift; # backwards compatibility
|
|
}
|
|
else {
|
|
$self->{_args} = { @_ };
|
|
};
|
|
|
|
# explicitly state legacy reject behavior
|
|
if ( ! defined $self->{_args}{reject_type} ) {
|
|
$self->{_args}{reject_type} = 'perm';
|
|
};
|
|
if ( ! defined $self->{_args}{reject} ) {
|
|
$self->{_args}{reject} = 1;
|
|
};
|
|
}
|
|
|
|
sub hook_connect {
|
|
my ($self, $transaction) = @_;
|
|
|
|
my $reject = $self->{_args}{reject};
|
|
|
|
# RBLSMTPD being non-empty means it contains the failure message to return
|
|
if ( defined $ENV{'RBLSMTPD'} && $ENV{'RBLSMTPD'} ne '' ) {
|
|
return $self->return_env_message() if $reject && $reject eq 'connect';
|
|
};
|
|
|
|
return DECLINED if $self->is_immune();
|
|
|
|
# perform RBLSMTPD checks to mimic Dan Bernstein's rblsmtpd
|
|
return DECLINED if $self->is_set_rblsmtpd();
|
|
return DECLINED if $self->ip_whitelisted();
|
|
|
|
my %dnsbl_zones = map { (split /:/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones');
|
|
if ( ! %dnsbl_zones ) {
|
|
$self->log( LOGDEBUG, "skip, no zones");
|
|
return DECLINED;
|
|
};
|
|
|
|
my $remote_ip = $self->qp->connection->remote_ip;
|
|
my $reversed_ip = join('.', reverse(split(/\./, $remote_ip)));
|
|
|
|
$self->initiate_lookups( \%dnsbl_zones, $reversed_ip );
|
|
|
|
my $message = $self->process_sockets or do {
|
|
$self->log(LOGINFO, 'pass');
|
|
return DECLINED;
|
|
};
|
|
|
|
return $self->get_reject( $message );
|
|
};
|
|
|
|
sub initiate_lookups {
|
|
my ($self, $zones, $reversed_ip) = @_;
|
|
|
|
# we queue these lookups in the background and fetch the
|
|
# results in the first rcpt handler
|
|
|
|
my $res = new Net::DNS::Resolver;
|
|
$res->tcp_timeout(30);
|
|
$res->udp_timeout(30);
|
|
|
|
my $sel = IO::Select->new();
|
|
|
|
my $dom;
|
|
for my $dnsbl (keys %$zones) {
|
|
# fix to find A records, if the dnsbl_zones line has a second field 20/1/04 ++msp
|
|
$dom->{"$reversed_ip.$dnsbl"} = 1;
|
|
if (defined($zones->{$dnsbl})) {
|
|
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for A record in the background");
|
|
$sel->add($res->bgsend("$reversed_ip.$dnsbl"));
|
|
}
|
|
else {
|
|
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for TXT record in the background");
|
|
$sel->add($res->bgsend("$reversed_ip.$dnsbl", "TXT"));
|
|
}
|
|
}
|
|
|
|
$self->connection->notes('dnsbl_sockets', $sel);
|
|
$self->connection->notes('dnsbl_domains', $dom);
|
|
};
|
|
|
|
sub is_set_rblsmtpd {
|
|
my $self = shift;
|
|
|
|
my $remote_ip = $self->qp->connection->remote_ip;
|
|
|
|
if ( ! defined $ENV{'RBLSMTPD'} ) {
|
|
$self->log(LOGDEBUG, "RBLSMTPD not set for $remote_ip");
|
|
return;
|
|
};
|
|
|
|
if ($ENV{'RBLSMTPD'} ne '') {
|
|
$self->log(LOGINFO, "RBLSMTPD=\"$ENV{'RBLSMTPD'}\" for $remote_ip");
|
|
return $ENV{'RBLSMTPD'};
|
|
}
|
|
|
|
$self->log(LOGINFO, "RBLSMTPD set, but empty for $remote_ip");
|
|
return 1; # don't return empty string, it evaluates to false
|
|
};
|
|
|
|
sub ip_whitelisted {
|
|
my $self = shift;
|
|
|
|
my $remote_ip = $self->qp->connection->remote_ip;
|
|
|
|
return grep { s/\.?$/./;
|
|
$_ eq substr($remote_ip . '.', 0, length $_)
|
|
}
|
|
$self->qp->config('dnsbl_allow');
|
|
};
|
|
|
|
sub return_env_message {
|
|
my $self = shift;
|
|
my $result = $ENV{'RBLSMTPD'};
|
|
my $remote_ip = $self->qp->connection->remote_ip;
|
|
$result =~ s/%IP%/$remote_ip/g;
|
|
my $msg = $self->qp->config('dnsbl_rejectmsg');
|
|
$self->log(LOGINFO, "fail, $msg");
|
|
return ( $self->get_reject_type(), join(' ', $msg, $result));
|
|
}
|
|
|
|
sub process_sockets {
|
|
my ($self) = @_;
|
|
|
|
my $conn = $self->qp->connection;
|
|
|
|
return $conn->notes('dnsbl') if $conn->notes('dnsbl');
|
|
|
|
my $sel = $conn->notes('dnsbl_sockets') or return '';
|
|
my $dom = $conn->notes('dnsbl_domains');
|
|
my $remote_ip = $self->qp->connection->remote_ip;
|
|
|
|
my %dnsbl_zones = map { (split /:/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones');
|
|
|
|
my $result;
|
|
my $res = new Net::DNS::Resolver;
|
|
$res->tcp_timeout(30);
|
|
$res->udp_timeout(30);
|
|
|
|
$self->log(LOGDEBUG, "waiting for dnsbl dns");
|
|
|
|
# don't wait more than 8 seconds here
|
|
my @ready = $sel->can_read(8);
|
|
|
|
$self->log(LOGDEBUG, "done waiting for dnsbl dns, got ", scalar @ready, " answers ...");
|
|
return '' unless @ready;
|
|
|
|
for my $socket (@ready) {
|
|
my $query = $res->bgread($socket);
|
|
$sel->remove($socket);
|
|
undef $socket;
|
|
|
|
my $dnsbl;
|
|
|
|
if ($query) {
|
|
my $a_record = 0;
|
|
foreach my $rr ($query->answer) {
|
|
my $name = $rr->name;
|
|
$self->log(LOGDEBUG, "name $name");
|
|
next unless $dom->{$name};
|
|
$self->log(LOGDEBUG, "name $name was queried");
|
|
$a_record = 1 if $rr->type eq "A";
|
|
($dnsbl) = ($name =~ m/(?:\d+\.){4}(.*)/) unless $dnsbl;
|
|
$dnsbl = $name unless $dnsbl;
|
|
next unless $rr->type eq "TXT";
|
|
$self->log(LOGDEBUG, "got txt record");
|
|
$result = $rr->txtdata and last;
|
|
}
|
|
#$a_record and $result = "Blocked by $dnsbl";
|
|
|
|
if ($a_record) {
|
|
if (defined $dnsbl_zones{$dnsbl}) {
|
|
$result = $dnsbl_zones{$dnsbl};
|
|
#$result =~ s/%IP%/$ENV{'TCPREMOTEIP'}/g;
|
|
$result =~ s/%IP%/$remote_ip/g;
|
|
}
|
|
else {
|
|
# shouldn't get here?
|
|
$result = "Blocked by $dnsbl";
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$self->log(LOGERROR, "$dnsbl query failed: ", $res->errorstring)
|
|
unless $res->errorstring eq "NXDOMAIN";
|
|
}
|
|
|
|
if ($result) {
|
|
#kill any other pending I/O
|
|
$conn->notes('dnsbl_sockets', undef);
|
|
$result = join("\n", $self->qp->config('dnsbl_rejectmsg'), $result);
|
|
return $conn->notes('dnsbl', $result);
|
|
}
|
|
}
|
|
|
|
if ($sel->count) {
|
|
# loop around if we have dns blacklists left to see results from
|
|
return $self->process_sockets();
|
|
}
|
|
|
|
# er, the following code doesn't make much sense anymore...
|
|
|
|
# if there was more to read; then forget it
|
|
$conn->notes('dnsbl_sockets', undef);
|
|
|
|
return $conn->notes('dnsbl', $result);
|
|
}
|
|
|
|
sub hook_rcpt {
|
|
my ($self, $transaction, $rcpt, %param) = @_;
|
|
|
|
if ( $rcpt->user =~ /^(?:postmaster|abuse|mailer-daemon|root)$/i ) {
|
|
$self->log(LOGWARN, "skip, don't blacklist special account: ".$rcpt->user);
|
|
|
|
# clear the naughty connection note here, if desired.
|
|
#$self->connection->notes('naughty', 0 );
|
|
}
|
|
|
|
return DECLINED;
|
|
}
|
|
|
|
sub hook_disconnect {
|
|
my ($self, $transaction) = @_;
|
|
|
|
$self->connection->notes('dnsbl_sockets', undef);
|
|
|
|
return DECLINED;
|
|
}
|
|
|