--- qpsmtpd/plugins/rhsbl	2002-09-08 10:15:21.000000000 -0400
+++ qpsmtpd.work/plugins/rhsbl	2003-09-05 15:16:28.000000000 -0400
@@ -1,43 +1,137 @@
+# -*- cperl -*-
+#
+# Copyright (c) 2003  Robert James Kaes <rjkaes@flarenet.com>
+#   All rights reserved.
+#
+# This plugin is released under the same license as Qpsmtpd itself.
+#
+# Whomever originally wrote this plugin did not include their copyright
+# (or name) on the file, so I don't know who to credit for the initial
+# work.
+#
+# Most of the background DNS look ideas (and some code) can be found in
+# the dnsbl plugin.
+#
 
 sub register {
-  my ($self, $qp) = @_;
+  my ($self, $qp, @args) = @_;
   $self->register_hook("mail", "mail_handler");
   $self->register_hook("rcpt", "rcpt_handler");
+  $self->register_hook('disconnect', 'disconnect_handler');
+
+  # Default is a hard rejection
+  $self->{_rhsbl_return} = DENY;
+
+  if (@args > 0) {
+    my $method = $args[0];
+    $self->log(1, "WARNING: Invalid argument.  Must be 'hard' or 'soft.")
+      unless $method =~ m/^(?:hard|soft)$/i;
+    $self->log(1, "WARNING: Ignoring additional arguments.")
+      if (@args > 1);
+
+    $self->{_rhsbl_return} = ('soft' eq lc $method) ? DENYSOFT : DENY;
+  }
 }
 
 sub mail_handler {
   my ($self, $transaction, $sender) = @_;
+
+  my %rhsbl_zones = map { split(/\s+/, $_, 2) } $self->qp->config('rhsbl_zones');
+  return DECLINED unless %rhsbl_zones;
+  return DECLINED unless $sender->format and $sender->format ne '<>';
+  $self->qp->connection->notes('rhsbl_zones', \%rhsbl_zones);
+
   # lookup the address here; but always just return DECLINED
   # we will store the state for rejection when rcpt is being run, some
   # MTAs gets confused when you reject mail during MAIL FROM:
-  #
-  # If we were really clever we would do the lookup in the background
-  # but that must wait for another day.  (patches welcome! :-) )
-  if ($sender->format ne "<>" and $self->qp->config('rhsbl_zones')) {
-    my %rhsbl_zones = map { (split /\s+/, $_, 2)[0,1] } $self->qp->config('rhsbl_zones');
-    my $host = $sender->host;
-    for my $rhsbl (keys %rhsbl_zones) {
-      $transaction->notes('rhsbl', "Mail from $host rejected because it $rhsbl_zones{$rhsbl}")
-	if check_rhsbl($self, $rhsbl, $host);
-    }
+
+  # Do the DNS queries in the background.  We'll get the results in the
+  # RCPT handler.
+  my $res = new Net::DNS::Resolver;
+  my $sel = new IO::Select;
+
+  my $host = $sender->host;
+  for my $rhsbl (keys %rhsbl_zones) {
+      $self->log(7, "Checking $host.$rhsbl in the background");
+      $sel->add($res->bgsend("$host.$rhsbl"));
   }
+
+  $self->qp->connection->notes('rhsbl_sockets', $sel);
+
   return DECLINED;
 }
 
 sub rcpt_handler {
   my ($self, $transaction, $rcpt) = @_;
-  my $note = $transaction->notes('rhsbl');
-  return (DENY, $note) if $note;
+  my $note = $self->process_sockets;
+  return ($self->{_rhsbl_return}, $note) if $note;
   return DECLINED;
 }
 
-sub check_rhsbl {
-  my ($self, $rhsbl, $host) = @_;
-  return 0 unless $host;
-  $self->log(2, "checking $host in $rhsbl");
-  return 1 if ((gethostbyname("$host.$rhsbl"))[4]);
-  return 0;
+#
+# This is needed to close the sockets when we close the transaction
+#
+sub disconnect_handler {
+  my ($self, $transaction) = @_;
+  $self->qp->connection->notes('rhsbl_zones', undef);
+  $self->qp->connection->notes('rhsbl_sockets', undef);
+  return DECLINED;
 }
 
+#
+# Go through all the DNS queries and look for a match.
+#
+sub process_sockets {
+  my $self = shift;
+  my $conn = $self->qp->connection;
+  return $conn->notes('rhsbl') if $conn->notes('rhsbl');
+
+  my $res = new Net::DNS::Resolver;
+  my $sel = $conn->notes('rhsbl_sockets') or return '';
+
+  my $result;
+  $self->log(8, "waiting for rhsbl dns");
+
+  # don't wait more than 4 seconds here
+  my @ready = $sel->can_read(4);
+  $self->log(8, "DONE waiting for rhsbl dns, got ", scalar @ready, " answers ...");
+  return undef unless @ready;
+
+  for my $socket (@ready) {
+    my $query = $res->bgread($socket);
+    $sel->remove($socket);
+    undef $socket;
+
+    # If the query failed for whatever reason, go on to the next socket
+    unless ($query and $query->answer) {
+      $self->log(4, "query failed: ", $res->errorstring)
+	unless $res->errorstring eq "NXDOMAIN";
+      next;
+    }
+
+    # Loop through the results
+    foreach my $rr ($query->answer) {
+      next unless $rr->type eq 'A' or $rr->type eq 'TXT';
+
+      # Found a valid response!  Report it.
+      my $name = $rr->name;
+      my %rhsbl_zones = %{$conn->notes('rhsbl_zones')};
+      foreach (my ($rhsbl, $comment) = each %rhsbl_zones) {
+	next unless $name =~ m/^([-a-z0-9.]+)\.$rhsbl$/i;
+	return $conn->notes('rhsbl', "Mail from $1 rejected because it $comment");
+      }
+    }
+
+    # We should never get to this point!  This means we got a response to
+    # our query, but could not find an A record or a TXT record.
+  }
+
+  # If we got here, it means we either couldn't find a valid response, or
+  # all the queries timed out.
+  return undef;
+}
 
+__END__
 
+# Emacs settings
+# cperl-set-style: CPerl
