dnsbl plugin

a few new hooks

fix config/IP to be a good default again


git-svn-id: https://svn.perl.org/qpsmtpd/branches/v010@36 958fd67b-6ff1-0310-b445-bb7760255be9

README.plugins

@@ -34,8 +34,8 @@ Action denied; return a temporary rejection code (say 450 instead of 550).
 
 =item DECLINED
 
-Plugin declined work; proceed as usual.  This return code is always
-allowed unless noted otherwise.
+Plugin declined work; proceed as usual.  This return code is _always_
+_allowed_ unless noted otherwise.
 
 =item DONE
 
@@ -74,6 +74,13 @@ Allowed return codes
   DENYSOFT - Return a soft failure code
   DONE     - skip further processing
 
+=head2 connect
+
+Allowed return codes:
+
+  OK       - Stop processing plugins, give the default response
+  DECLINED - Process the next plugin
+  DONE     - Stop processing plugins and don't give the default response
 
 =head2 quit
 
@@ -83,7 +90,7 @@ Allowed return codes:
 
   DONE 
 
-All other codes will qpsmtpd do the default response.
+Works like the "connect" hook.
 
 
 =head2 disconnect

config.sample/IP

@@ -1,4 +1,4 @@
-64.81.84.165
+0
 # the first line of this file is being used as the IP 
 # address tcpserver will bind to.  Use 0 to bind to all
 # interfaces.

config.sample/plugins

@@ -1,7 +1,7 @@
 quit_fortune
 require_resolvable_fromhost
 rhsbl
-# dnsbl
+dnsbl
 
 # this plugin needs to run after all other "rcpt" plugins
 check_relay

lib/Qpsmtpd.pm

@@ -99,7 +99,13 @@ sub fault {
 
 sub start_conversation {
     my $self = shift;
-    $self->respond(220, $self->config('me') ." ESMTP qpsmtpd ". $self->version ." ready; send us your mail, but not your spam.");
+    # this should maybe be called something else than "connect", see
+    # lib/Qpsmtpd/TcpServer.pm for more confusion.
+    my ($rc, $msg) = $self->run_hooks("connect");
+    if ($rc != DONE) {
+      $self->respond(220, $self->config('me') ." ESMTP qpsmtpd "
+		     . $self->version ." ready; send us your mail, but not your spam.");
+    }
 }
 
 sub transaction {
@@ -448,8 +454,6 @@ sub load_plugins {
 
     my $package = "Qpsmtpd::Plugin::$plugin_name";
 
-    warn "PLUGIN PACKAGE: $package";
-
     my $line = "\n#line 1 $dir/$plugin\n";
 
     my $eval = join(
@@ -464,13 +468,12 @@ sub load_plugins {
 		    "\n", # last line comment without newline?
 		   );
 
-    warn "eval: $eval";
+    #warn "eval: $eval";
 
     $eval =~ m/(.*)/s;
     $eval = $1;
 
     eval $eval;
-    warn "EVAL: $@";
     die "eval $@" if $@;
 
     my $plug = $package->new(qpsmtpd => $self);

plugins/dnsbl

@@ -0,0 +1,62 @@
+
+sub register {
+  my ($self, $qp) = @_;
+  $self->register_hook("connect", "connect_handler");
+  $self->register_hook("rcpt", "rcpt_handler");
+  #$self->register_hook("disconnect", "disconnect_handler");
+}
+
+sub connect_handler {
+  my ($self, $transaction) = @_;
+  my $remote_ip = $self->qp->connection->remote_ip;
+
+  my %dnsbl_zones = map { (split /\s+/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones');
+  return unless %dnsbl_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 $result = "";
+
+  my $res = new Net::DNS::Resolver;
+  for my $dnsbl (keys %dnsbl_zones) {
+    $self->log(3, "Checking $reversed_ip.$dnsbl");
+    my $query = $res->query("$reversed_ip.$dnsbl", "TXT");
+    if ($query) {
+      my $a_record = 0;
+      foreach my $rr ($query->answer) {
+	$a_record = 1 if $rr->type eq "A";
+	next unless $rr->type eq "TXT";
+	$self->log(10, "got txt record");
+	$result = $rr->txtdata and last;
+      }
+      $a_record and $result = "Blocked by $dnsbl";
+    }
+    else {
+      warn "$$ query for $reversed_ip.$dnsbl failed: ", $res->errorstring, "\n"
+	unless $res->errorstring eq "NXDOMAIN";
+    }
+  }
+
+  $transaction->notes('dnsbl', $result);
+
+  return DECLINED;
+}
+
+sub rcpt_handler {
+  my ($self, $transaction, $rcpt) = @_;
+  my $note = $transaction->notes('rhsbl');
+  return (DENY, $note) if $note;
+  return DECLINED;
+}
+
+sub disconnect_handler {
+  # if we queued stuff in the background we should make sure it got
+  # cleaned up here.
+  return DECLINED;
+}
+
+
+1;

plugins/rhsbl

@@ -8,6 +8,11 @@ sub register {
 sub mail_handler {
   my ($self, $transaction, $sender) = @_;
   # 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;