From a6cfb68392039e840bc7548c33747369fd6a39d4 Mon Sep 17 00:00:00 2001
From: Matt Simerson <matt@tnpi.net>
Date: Sat, 23 Jun 2012 03:10:48 -0400
Subject: [PATCH] dnsbl,rhsbl: process DNS immediately

and use naughty for deferred rejection
---
 plugins/dnsbl | 170 ++++++++++++------------------------------
 plugins/rhsbl | 203 +++++++++++++++++++++-----------------------------
 2 files changed, 130 insertions(+), 243 deletions(-)

diff --git a/plugins/dnsbl b/plugins/dnsbl
index 977424f..b417bd4 100644
--- a/plugins/dnsbl
+++ b/plugins/dnsbl
@@ -176,44 +176,61 @@ sub hook_connect {
     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) {
+    for my $dnsbl (keys %dnsbl_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"));
+        my $query;
+        if ( defined $dnsbl_zones{$dnsbl} ) {
+            $self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for A record");
+            $query = $res->query("$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->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for TXT record");
+            $query = $res->query("$reversed_ip.$dnsbl", "TXT");
+        }
+
+        if ( ! $query) {
+            if ( $res->errorstring ne "NXDOMAIN" ) {
+                $self->log(LOGERROR, "$dnsbl query failed: ", $res->errorstring);
+            };
+            next;
+        };
+
+        my $a_record = 0;
+        my $result;
+        foreach my $rr ($query->answer) {
+            if ( $rr->type eq 'A' ) {
+                $result = $rr->name;
+                $self->log(LOGDEBUG, "found A for $result with IP " . $rr->address);
+            }
+            elsif ($rr->type eq 'TXT') {
+                $self->log(LOGDEBUG, "found TXT, " . $rr->txtdata);
+                $result = $rr->txtdata;
+            };
+
+            next if ! $result;
+
+            if ( ! $dnsbl ) { ($dnsbl) = ($result =~ m/(?:\d+\.){4}(.*)/); };
+            if ( ! $dnsbl ) {  $dnsbl = $result; };
+
+            if ($a_record) {
+                if (defined $dnsbl_zones{$dnsbl}) {
+                    my $smtp_msg = $dnsbl_zones{$dnsbl};
+                    $smtp_msg =~ s/%IP%/$remote_ip/g;
+                    return $self->get_reject( $smtp_msg, $dnsbl );
+                }
+                return $self->get_reject( "Blocked by $dnsbl" );
+            }
+
+            return $self->get_reject( $result, $dnsbl );
         }
     }
 
-    $self->connection->notes('dnsbl_sockets', $sel);
-    $self->connection->notes('dnsbl_domains', $dom);
+    $self->log(LOGINFO, 'pass');
+    return DECLINED;
 };
 
 sub is_set_rblsmtpd {
@@ -236,7 +253,7 @@ sub is_set_rblsmtpd {
 };
 
 sub ip_whitelisted {
-    my $self = shift;
+    my ($self) = @_;
 
     my $remote_ip = $self->qp->connection->remote_ip;
 
@@ -256,93 +273,6 @@ sub return_env_message {
     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) = @_;
 
@@ -356,11 +286,3 @@ sub hook_rcpt {
     return DECLINED;
 }
 
-sub hook_disconnect {
-  my ($self, $transaction) = @_;
-
-  $self->connection->notes('dnsbl_sockets', undef);
-
-  return DECLINED;
-}
-
diff --git a/plugins/rhsbl b/plugins/rhsbl
index 5706f0c..3f08aac 100644
--- a/plugins/rhsbl
+++ b/plugins/rhsbl
@@ -31,146 +31,111 @@ use warnings;
 use Qpsmtpd::Constants;
 
 sub register {
-  my ($self, $qp, $denial ) = @_;
-  if ( defined $denial and $denial =~ /^disconnect$/i ) {
-    $self->{_rhsbl}->{DENY} = DENY_DISCONNECT;
-  }
-  else {
-    $self->{_rhsbl}->{DENY} = DENY;
-  }
+    my ($self, $qp ) = (shift, shift);
+
+    my $denial;
+    if ( @_ == 1 ) {
+        $denial = shift;
+        if ( defined $denial && $denial =~ /^disconnect$/i ) {
+            $self->{_args}{reject_type} = 'disconnect';
+        }
+        else {
+            $self->{_args}{reject_type} = 'perm';
+        }
+    }
+    else {
+        $self->{_args} = { @_ };
+    };
 }
 
 sub hook_mail {
-  my ($self, $transaction, $sender, %param) = @_;
+    my ($self, $transaction, $sender, %param) = @_;
 
     return DECLINED if $self->is_immune();
 
     if ($sender->format eq '<>') {
-        $self->log(LOGINFO, 'skip, null sender');
+        $self->log(LOGINFO, 'pass, null sender');
         return DECLINED;
     };
 
-    my %rhsbl_zones = map { (split /\s+/, $_, 2)[0,1] } $self->qp->config('rhsbl_zones');
+    my %rhsbl_zones = $self->populate_zones() or return DECLINED;
 
-    if ( ! %rhsbl_zones ) {
-        $self->log(LOGINFO, 'skip, no zones');
-        return DECLINED;
-    };
+    my $res = $self->init_resolver();
 
-  my $res = new Net::DNS::Resolver;
-  my $sel = IO::Select->new();
-  my %rhsbl_zones_map = ();
-
-  # Perform any RHS lookups in the background. We just send the query packets
-  # here and pick up any results in the RCPT handler.
-  # MTAs gets confused when you reject mail during MAIL FROM:
-
-    push(my @hosts, $sender->host);
-    #my $helo = $self->qp->connection->hello_host;
-    #push(@hosts, $helo) if $helo && $helo ne $sender->host;
+    my @hosts = $sender->host;
     for my $host (@hosts) {
-    for my $rhsbl (keys %rhsbl_zones) {
-      # 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 in the background");
-        $sel->add($res->bgsend("$host.$rhsbl"));
-      } else {
-        $self->log(LOGDEBUG, "Checking $host.$rhsbl for TXT record in the background");
-        $sel->add($res->bgsend("$host.$rhsbl", "TXT"));
-      }
-        $rhsbl_zones_map{"$host.$rhsbl"} = $rhsbl_zones{$rhsbl};
+        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);
+                };
+
+                if ( $result ) {
+                    $self->log(LOGINFO, "fail, $result");
+
+                    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->{_rhsbl_zones_map}} = %rhsbl_zones_map;
-    $transaction->notes('rhsbl_sockets', $sel);
-
-  return DECLINED;
-}
-
-sub hook_rcpt {
-  my ($self, $transaction, $rcpt) = @_;
-
-  my $result = $self->process_sockets or do {
     $self->log(LOGINFO, "pass");
     return DECLINED;
-  };
-
-
-  if ( defined($self->{_rhsbl_zones_map}{$result}) ) {
-    my $host = $transaction->sender->host;
-    if ($result =~ /^$host\./ ) {
-      return ($self->{_rhsbl}->{DENY}, "Mail from $host rejected because it " . $self->{_rhsbl_zones_map}{$result});
-    } else {
-      my $hello = $self->qp->connection->hello_host;
-      return ($self->{_rhsbl}->{DENY}, "Mail from HELO $hello rejected because it " . $self->{_rhsbl_zones_map}{$result});
-    }
-  }
-  return ($self->{_rhsbl}->{DENY}, $result);
 }
 
-sub process_sockets {
-  my ($self) = @_;
-  my $trans = $self->transaction;
-  my $result = '';
+sub populate_zones {
+    my $self = shift;
 
-  return $trans->notes('rhsbl') if $trans->notes('rhsbl');
+    my %rhsbl_zones
+        = map { (split /\s+/, $_, 2)[0,1] }
+            $self->qp->config('rhsbl_zones');
 
-  my $res = new Net::DNS::Resolver;
-  my $sel = $trans->notes('rhsbl_sockets') or return '';
+    if ( ! keys %rhsbl_zones ) {
+        $self->log(LOGINFO, 'pass, no zones');
+        return;
+    };
 
-  $self->log(LOGDEBUG, 'waiting for rhsbl dns');
+    return %rhsbl_zones;
+};
 
-  # don't wait more than 8 seconds here
-  my @ready = $sel->can_read(8);
-
-  $self->log(LOGDEBUG, 'DONE waiting for rhsbl dns, got ' , scalar @ready, ' answers ...') ;
-  return '' unless @ready;
-
-  for my $socket (@ready) {
-    my $query = $res->bgread($socket);
-    $sel->remove($socket);
-    undef $socket;
-
-    if ($query) {
-      foreach my $rr ($query->answer) {
-        $self->log(LOGDEBUG, 'got an ' . $rr->type . ' record ' . $rr->name);
-        if ($rr->type eq 'A') {
-          $result = $rr->name;
-          $self->log(LOGDEBUG, "A record found for $result with IP " . $rr->address);
-          last;
-        } elsif ($rr->type eq 'TXT') {
-          $result = $rr->txtdata;
-          $self->log(LOGDEBUG, "TXT record found: " . $rr->txtdata);
-          last;
-        }
-      }
-    } else {
-      $self->log(LOGCRIT, "query failed: ", $res->errorstring) unless $res->errorstring eq 'NXDOMAIN';
-    }
-
-    if ($result) {
-      #kill any other pending I/O
-      $trans->notes('rhsbl_sockets', undef);
-      return $trans->notes('rhsbl', $result);
-    }
-  }
-
-  if ($sel->count) {
-    # loop around if we have dns results left
-    return $self->process_sockets();
-  }
-
-  # if there was more to read; then forget it
-  $trans->notes('rhsbl_sockets', undef);
-
-  return $trans->notes('rhsbl', $result);
-}
-
-sub hook_disconnect {
-  my ($self, $transaction) = @_;
-
-  $transaction->notes('rhsbl_sockets', undef);
-  return DECLINED;
-}
+sub init_resolver {
+    my $self = shift;
+    return $self->{_resolver} if $self->{_resolver};
+    $self->log( LOGDEBUG, "initializing Net::DNS::Resolver");
+    $self->{_resolver} = Net::DNS::Resolver->new(dnsrch => 0);
+    my $timeout = $self->{_args}{timeout} || 8;
+    $self->{_resolver}->tcp_timeout($timeout);
+    $self->{_resolver}->udp_timeout($timeout);
+    return $self->{_resolver};
+};