Re: dnsbl - anti-listing

[John Peacock]

Timo T. Rajala wrote:
does the plugin dnsbl support the whitelisting option "-a", as rblsmtpd?
No, but I wrote a version of the whitelist_soft plugin which does (see 
attached).  NOTE: that you have to apply something like the following in order 
to actually use it:

--- dnsbl       10 Jun 2003 10:03:57 -0000      1.8
+++ dnsbl       7 Jan 2004 21:45:47 -0000
@@ -103,7 +103,15 @@
 sub rcpt_handler {
   my ($self, $transaction, $rcpt) = @_;
   my $note = $self->process_sockets;
-  return (DENY, $note) if $note;
+  my $whitelist = $self->qp->connection->notes('whitelist');
+  if ( $note ) {
+    if ( $whitelist ) {
+      $self->log(2, "Whitelist overrode blacklist: $whitelist");
+    }
+    else {
+      return (DENY, $note);
+    }
+  }
   return DECLINED;
 }
HTH
John
=head1 NAME
dns_whitelist_soft - dns-based whitelist override for other qpsmtpd plugins

=head1 DESCRIPTION

The dns_whitelist_soft plugin allows selected host to be whitelisted as
exceptions to later plugin processing.  It is strongly based on the original
dnsbl plugin as well as Gavin Carr's original whitelist_soft plugin.  It is
most suitable for multisite installations, so that the whitelist is stored
in one location and available from all.

=head1 CONFIGURATION

To enable the plugin, add it to the ~qpsmtpd/config/plugins file as usual.
It should precede any plugins whose rejections you wish to override.  You may
have to alter those plugins to check the appropriate notes field.

Several configuration files are supported, corresponding to different
parts of the SMTP conversation:

=over 4

=item whitelisthosts

Any IP address listed in the whitelisthosts dns source is exempted from
any further validation during 'connect', and can be selectively exempted
at other stages by plugins testing for a 'whitelisthost' connection note.

=head1 AUTHOR

Based on the 'whitelist_soft' plugin by Gavin Carr <[EMAIL PROTECTED]>,
based on the 'whitelist' plugin by Devin Carraway <[EMAIL PROTECTED]>.
John Peacock <[EMAIL PROTECTED]>

=cut

sub register {
  my ($self, $qp) = @_;

  $self->register_hook("connect", "connect_handler");
  $self->register_hook("rcpt", "rcpt_handler");
}

sub connect_handler {
  my ($self, $transaction) = @_;

  my $remote_ip = $self->qp->connection->remote_ip;

  my %whitelist_zones = map { (split /\s+/, $_, 2)[0,1] }
                                $self->qp->config('whitelist_zones');

  return DECLINED unless %whitelist_zones;

  my $reversed_ip = join(".", reverse(split(/\./, $remote_ip)));

  # we should queue these lookups in the background and just fetch the
  # results in the first rcpt handler ... oh well.

  my $res = new Net::DNS::Resolver;
  my $sel = IO::Select->new();

  for my $dnsbl (keys %whitelist_zones) {
    $self->log(7, "Checking $reversed_ip.$dnsbl in the background");
    $sel->add($res->bgsend("$reversed_ip.$dnsbl", "TXT"));
  }

  $self->qp->connection->notes('whitelist_sockets', $sel);

  return DECLINED;
}

sub process_sockets {
  my ($self) = @_;

  my $conn = $self->qp->connection;

  return $conn->notes('whitelist') 
    if $conn->notes('whitelist');

  my $res = new Net::DNS::Resolver;
  my $sel = $conn->notes('whitelist_sockets') or return "";

  my $result; 

  $self->log(8, "waiting for whitelist dns");

  # don't wait more than 4 seconds here
  my @ready = $sel->can_read(4);

  $self->log(8, "DONE waiting for whitelist dns, got ",
        scalar @ready, " answers ...") ;
  return '' unless @ready;

  for my $socket (@ready) {
    my $query = $res->bgread($socket);
    $sel->remove($socket);
    undef $socket;

    my $whitelist;

    if ($query) {
      my $a_record = 0;
      foreach my $rr ($query->answer) {
        $a_record = 1 if $rr->type eq "A";
        my $name = $rr->name;
        ($whitelist) = ($name =~ m/(?:\d+\.){4}(.*)/) unless $whitelist;
        $whitelist = $name unless $whitelist;
        $self->log(9, "name ", $rr->name);
        next unless $rr->type eq "TXT";
        $self->log(10, "got txt record");
        $result = $rr->txtdata and last;
      }
      $a_record and $result = "Blocked by $whitelist";
    }
    else {
      $self->log(4, "$whitelist query failed: ", $res->errorstring)
        unless $res->errorstring eq "NXDOMAIN";
    }

    if ($result) {
      #kill any other pending I/O
      $conn->notes('whitelist_sockets', undef);
      return $conn->notes('whitelist', $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('whitelist_sockets', undef);

  return $conn->notes('whitelist', $result);

}

sub rcpt_handler {
  my ($self, $transaction, $rcpt) = @_;
  my $ip = $self->qp->connection->remote_ip || return (DECLINED);
  my $note = $self->process_sockets;
  if ( $note ) {
    $self->log(2,"Host $ip is whitelisted: $note");
  }
  return DECLINED;
}

sub disconnect_handler {
  my ($self, $transaction) = @_;

  $self->qp->connection->notes('whitelist_sockets', undef);

  return DECLINED;
}


1;