cvs commit: qpsmtpd/plugins dnsbl
[email protected] (Ask "Bj?rn" Hansen)
| Newsgroups | perl.cvs.qpsmtpd |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 04/03/03 20:33:47
Modified: . Changes
plugins dnsbl
Log:
Modified the dnsbl plugin to better support both A and TXT records and
support all of the RBLSMTPD functionality. (Thanks to Mark Powell)
Revision Changes Path
1.60 +3 -0 qpsmtpd/Changes
Index: Changes
===================================================================
RCS file: /cvs/public/qpsmtpd/Changes,v
retrieving revision 1.59
retrieving revision 1.60
diff -u -w -r1.59 -r1.60
--- Changes 4 Mar 2004 04:30:02 -0000 1.59
+++ Changes 4 Mar 2004 04:33:47 -0000 1.60
@@ -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!)
1.9 +154 -8 qpsmtpd/plugins/dnsbl
Index: dnsbl
===================================================================
RCS file: /cvs/public/qpsmtpd/plugins/dnsbl,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- dnsbl 10 Jun 2003 10:03:57 -0000 1.8
+++ dnsbl 4 Mar 2004 04:33:47 -0000 1.9
@@ -1,4 +1,3 @@
-
sub register {
my ($self, $qp) = @_;
$self->register_hook("connect", "connect_handler");
@@ -11,7 +10,23 @@
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,9 +38,15 @@
my $sel = IO::Select->new();
for my $dnsbl (keys %dnsbl_zones) {
- $self->log(7, "Checking $reversed_ip.$dnsbl in the background");
+ # 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 @@
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 @@
$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 @@
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 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 @@
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