byterazor/qpsmtpd
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Modified the dnsbl plugin to better support both A and TXT records and

Browse Source 
support all of the RBLSMTPD functionality. (Thanks to Mark Powell)


git-svn-id: https://svn.perl.org/qpsmtpd/trunk@210 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
Ask Bjørn Hansen 2004-03-04 04:33:47 +00:00
parent 22523ead2d
commit 964242f7be
2 changed files with 157 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Changes
View File

@ -1,5 +1,8 @@
0.27
Modified the dnsbl plugin to better support both A and TXT records and
support all of the RBLSMTPD functionality. (Thanks to Mark Powell)
reject bare carriage-returns in addition to the bare line-feeds
(based on a patch from Robert James Kaes, thanks!)

162
plugins/dnsbl
View File

@ -1,4 +1,3 @@
sub register {
my ($self, $qp) = @_;
$self->register_hook("connect", "connect_handler");
@ -11,7 +10,23 @@ sub connect_handler {
my $remote_ip = $self->qp->connection->remote_ip;
my %dnsbl_zones = map { (split /\s+/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones');
# perform RBLSMTPD checks to mimic Dan Bernstein's rblsmtpd
if (defined($ENV{'RBLSMTPD'})) {
if ($ENV{'RBLSMTPD'} ne '') {
$self->log(1, "RBLSMTPD=\"$ENV{'RBLSMTPD'}\" for $remote_ip");
return DECLINED;
} else {
$self->log(1, "RBLSMTPD set, but empty for $remote_ip");
return DECLINED;
}
} else {
$self->log(1, "RBLSMTPD not set for $remote_ip");
}
my $allow = grep { s/\.?$/./; $_ eq substr($remote_ip . '.', 0, length $_) } $self->qp->config('dnsbl_allow');
return DECLINED if $allow;
my %dnsbl_zones = map { (split /:/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones');
return DECLINED unless %dnsbl_zones;
my $reversed_ip = join(".", reverse(split(/\./, $remote_ip)));
@ -23,8 +38,14 @@ sub connect_handler {
my $sel = IO::Select->new();
for my $dnsbl (keys %dnsbl_zones) {
$self->log(7, "Checking $reversed_ip.$dnsbl in the background");
$sel->add($res->bgsend("$reversed_ip.$dnsbl", "TXT"));
# fix to find A records, if the dnsbl_zones line has a second field 20/1/04 ++msp
if (defined($dnsbl_zones{$dnsbl})) {
$self->log(7, "Checking $reversed_ip.$dnsbl for A record in the background");
$sel->add($res->bgsend("$reversed_ip.$dnsbl"));
} else {
$self->log(7, "Checking $reversed_ip.$dnsbl for TXT record in the background");
$sel->add($res->bgsend("$reversed_ip.$dnsbl", "TXT"));
}
}
$self->qp->connection->notes('dnsbl_sockets', $sel);
@ -40,15 +61,18 @@ sub process_sockets {
return $conn->notes('dnsbl')
if $conn->notes('dnsbl');
my %dnsbl_zones = map { (split /:/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones');
my $res = new Net::DNS::Resolver;
my $sel = $conn->notes('dnsbl_sockets') or return "";
my $remote_ip = $self->qp->connection->remote_ip;
my $result;
$self->log(8, "waiting for dnsbl dns");
# don't wait more than 4 seconds here
my @ready = $sel->can_read(4);
# don't wait more than 8 seconds here
my @ready = $sel->can_read(8);
$self->log(8, "DONE waiting for dnsbl dns, got " , scalar @ready, " answers ...") ;
return '' unless @ready;
@ -72,7 +96,18 @@ sub process_sockets {
$self->log(10, "got txt record");
$result = $rr->txtdata and last;
}
$a_record and $result = "Blocked by $dnsbl";
#$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(4, "$dnsbl query failed: ", $res->errorstring)
@ -82,6 +117,7 @@ sub process_sockets {
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);
}
}
@ -102,6 +138,15 @@ sub process_sockets {
sub rcpt_handler {
my ($self, $transaction, $rcpt) = @_;
# RBLSMTPD being non-empty means it contains the failure message to return
if (defined ($ENV{'RBLSMTPD'}) && $ENV{'RBLSMTPD'} ne '') {
my $result = $ENV{'RBLSMTPD'};
my $remote_ip = $self->qp->connection->remote_ip;
$result =~ s/%IP%/$remote_ip/g;
return (DENY, join("\n", $self->qp->config('dnsbl_rejectmsg'), $result));
}
my $note = $self->process_sockets;
return (DENY, $note) if $note;
return DECLINED;
@ -115,5 +160,106 @@ sub disconnect_handler {
return DECLINED;
}
1;
=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 Configuration files
This plugin uses the following configuration files. All of these are optional.
However, not specifying dnsbl_zones is like not using the plugin at all.
=over 4
=item 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
=item 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.
=item 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.
=back
=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: http://cvs.perl.org/viewcvs/qpsmtpd/plugins/dnsbl
=cut