[svn:qpsmtpd] rev 522 - in branches/0.31: config.sample plugins

[email protected] 28 Jul 2005 20:25:55 -0000
Newsgroups perl.cvs.qpsmtpd
Message-ID <[email protected]>
Author: jpeacock
Date: Thu Jul 28 13:25:54 2005
New Revision: 522

Added:
   branches/0.31/config.sample/invalid_resolvable_fromhost
Modified:
   branches/0.31/plugins/require_resolvable_fromhost
Log:
Extend require_resolvable_fromhost to include a configurable list of
"impossible" addresses to combat spammer forging.  (Hanno Hecker)

Added: branches/0.31/config.sample/invalid_resolvable_fromhost
==============================================================================
--- (empty file)
+++ branches/0.31/config.sample/invalid_resolvable_fromhost	Thu Jul 28 13:25:54 2005
@@ -0,0 +1,6 @@
+# include full network block including mask
+127.0.0.0/8 
+0.0.0.0/8 
+224.0.0.0/4
+169.254.0.0/16 
+10.0.0.0/8 

Modified: branches/0.31/plugins/require_resolvable_fromhost
==============================================================================
--- branches/0.31/plugins/require_resolvable_fromhost	(original)
+++ branches/0.31/plugins/require_resolvable_fromhost	Thu Jul 28 13:25:54 2005
@@ -1,4 +1,7 @@
 use Net::DNS qw(mx);
+use Socket;
+
+my %invalid = ();
 
 sub hook_mail {
   my ($self, $transaction, $sender) = @_;
@@ -6,6 +9,14 @@ sub hook_mail {
   return DECLINED
         if ($self->qp->connection->notes('whitelistclient'));
 
+  foreach my $i ($self->qp->config("invalid_resolvable_fromhost")) {
+    $i =~ s/^\s*//;
+    $i =~ s/\s*$//;
+    if ($i =~ m#^((\d{1,3}\.){3}\d{1,3})/(\d\d?)#) {
+      $invalid{$1} = $3;
+    }
+  }
+
   $sender->format ne "<>"
     and $self->qp->config("require_resolvable_fromhost")
     and !$self->check_dns($sender->host)
@@ -18,7 +29,6 @@ sub hook_mail {
 
 }
 
-
 sub check_dns {
   my ($self, $host) = @_;
 
@@ -30,11 +40,52 @@ sub check_dns {
   my $res = new Net::DNS::Resolver;
   $res->tcp_timeout(30);
   $res->udp_timeout(30);
-  return 1 if mx($res, $host);
+  my @mx = mx($res, $host);
+  foreach my $mx (@mx) {
+    return mx_valid($self, $mx->exchange, $host);
+  }
   my $query = $res->search($host);
   if ($query) {
     foreach my $rr ($query->answer) {
-      return 1 if $rr->type eq "A" or $rr->type eq "MX";
+      if ($rr->type eq "A") {
+        return is_valid($rr->address);
+      }
+      elsif ($rr->type eq "MX") {
+        return mx_valid($self, $rr->exchange, $host);
+      }
+    }
+  } 
+  else {
+    $self->log(LOGWARN, "$$ query for $host failed: ", $res->errorstring)
+      unless $res->errorstring eq "NXDOMAIN";
+  }
+  return 0;
+}
+
+sub is_valid {
+  my $ip = shift;
+  my ($net,$mask);
+  ### while (($net,$mask) = each %invalid) {
+  ###         ... does NOT reset to beginning, will start on
+  ###         2nd invocation after where it denied the first time..., so
+  ###         2nd time the same "MAIL FROM" would be accepted!
+  foreach $net (keys %invalid) {
+    $mask = $invalid{$net};
+    $mask = pack "B32", "1"x($mask)."0"x(32-$mask);
+    return 0 
+      if join(".", unpack("C4", inet_aton($ip) & $mask)) eq $net;
+  }
+  return 1; 
+}
+
+sub mx_valid {
+  my ($self, $name, $host) = @_;
+  my $res   = new Net::DNS::Resolver;
+  my $query = $res->search($name);
+  if ($query) {
+    foreach my $rr ($query->answer) {
+      next unless $rr->type eq "A";
+      return is_valid($rr->address);
     }
   }
   else {
@@ -44,3 +95,4 @@ sub check_dns {
   return 0;
 }
 
+# vim: ts=2 sw=2 expandtab syn=perl