Subversion Repositories

diff -urN SpamAssassin.orig/Conf.pm SpamAssassin/Conf.pm
--- SpamAssassin.orig/Conf.pm   Mon Dec 15 22:41:57 2003
+++ SpamAssassin/Conf.pm        Sun Feb 29 17:42:58 2004
@@ -107,6 +107,10 @@
 use constant TYPE_URI_EVALS     => 0x0011;
 use constant TYPE_META_TESTS    => 0x0012;
 use constant TYPE_RBL_EVALS     => 0x0013;
+# Need to reserve a number with the SA folks (needs to be odd as it is an
+# eval test)
+use constant TYPE_RES_EVALS    => 0x0021;
+
 
 $VERSION = 'bogus';     # avoid CPAN.pm picking up version strings later
 
@@ -2000,12 +2004,15 @@
 
 =cut
 
-    if (/^header\s+(\S+)\s+(?:rbl)?eval:(.*)$/) {
+    if (/^header\s+(\S+)\s+(?:rbl|res)?eval:(.*)$/) {
       my ($name, $fn) = ($1, $2);
 
       if ($fn =~ /^check_rbl/) {
        $self->add_test ($name, $fn, TYPE_RBL_EVALS);
       }
+      elsif (/^header\s+(\S+)\s+reseval:(.*)$/) {
+       $self->add_test ($name, $fn, TYPE_RES_EVALS);
+      }
       else {
        $self->add_test ($name, $fn, TYPE_HEAD_EVALS);
       }
@@ -2603,6 +2610,9 @@
        }
        elsif ($type == TYPE_RBL_EVALS) {
          $self->{rbl_evals}->{$name} = \@args;
+       }
+       elsif ($type == TYPE_RES_EVALS) {
+         $self->{res_evals}->{$name} = \@args;
        }
        elsif ($type == TYPE_RAWBODY_EVALS) {
          $self->{rawbody_evals}->{$name} = \@args;
diff -urN SpamAssassin.orig/EvalTests.pm SpamAssassin/EvalTests.pm
--- SpamAssassin.orig/EvalTests.pm      Sat Jan 17 15:56:08 2004
+++ SpamAssassin/EvalTests.pm   Sun Aug 15 15:47:22 2004
@@ -1941,6 +1941,234 @@
   return $self->{habeas_swe};
 }
 
+
+# This was originally written to implement greylisting in SA-Exim, although
+# I have tried to make it more general and allow for reuse in other MTAs
+# (although they will need to
+# 1) be running SA at SMTP time
+# 2) Provide the list of rcpt to and env from in some headers for SA to read
+# 3) Provide the IP of the connecting host )
+#
+# This rule should get a negative score so that if we've already seen the
+# greylisting tuplet before, we lower the score, which hopefully brings us from
+# a tempreject to an accept (at least that's how sa-exim does it)
+# -- Marc <marc_soft@merlins.org> 2004/01/19
+
+sub greylisting {
+  my ($self, $optionhash) = @_;
+
+  $optionhash  =~ s/;/,/g;
+  # This is safe, right? (users shouldn't be able to set it in their config)
+  my %option=eval $optionhash;
+  my $connectip;
+  my $envfrom;
+  my $rcptto;
+  my @rcptto;
+  my $iswhitelisted=0;
+  my $err;
+  my $mesgid = $self->get ('Message-Id')."\n";
+  my $mesgidfn;
+  my $tuplet;
+
+  foreach my $reqoption (qw ( method greylistsecs dontgreylistthreshold
+       connectiphdr envfromhdr rcpttohdr greylistnullfrom greylistfourthbyte ))
+  {
+    die "Greylist option $reqoption missing from SA config" unless (defined $option{$reqoption});
+    #warn "found $reqoption -> $option{$reqoption}\n";
+  }
+  
+  # No newlines, thank you (yes, you need this twice apparently)
+  chomp ($mesgid);
+  chomp ($mesgid);
+  # Newline in the middle mesgids, are you serious? Get rid of them here
+  $mesgid =~ s/\012/|/g;
+
+  # For stuff that we know is spam, don't greylist the host
+  # (that might help later spam with a lower score to come in)
+  if ($self->{hits} >= $option{'dontgreylistthreshold'})
+  {
+    #warn "debug: skipping greylisting on $mesgid, since score is already ".$self->{hits}." and you configured greylisting to not bother with anything above $dontcheckscore\n";
+    return 0;
+  }
+
+
+  if (not $connectip = $self->get($option{'connectiphdr'}))
+  {
+    warn "Couldn't get Connecting IP header $option{'connectiphdr'} for message $mesgid, skipping greylisting call\n";
+    return 0;
+  }
+  chomp($connectip);
+  # Clean up input (for security, if you use files/dirs)
+  $connectip =~ s#/#-#g;
+
+  # Account for a null envelope from
+  if (not defined ($envfrom = $self->get($option{'envfromhdr'})))
+  {
+    warn "Couldn't get Envelope From header $option{'envfromhdr'} for message $mesgid, skipping greylisting call\n";
+    return 0;
+  }
+  chomp($envfrom);
+  # Clean up input (for security, if you use files/dirs)
+  $envfrom =~ s#/#-#g;
+  if (not $envfrom)
+  {
+      $envfrom="<>";
+      return 0 if (not $option{'greylistnullfrom'});
+  }
+
+  if (not $rcptto = $self->get($option{'rcpttohdr'}))
+  {
+    warn "Couldn't get Rcpt To header $option{'rcpttohdr'} for message $mesgid, skipping greylisting call\n";
+    return 0;
+  }
+  chomp($rcptto);
+  # Clean up input (for security, if you use files/dirs)
+  $rcptto =~ s#/#-#g;
+  @rcptto = split(/, /, $rcptto);
+
+
+  umask 0007;
+
+  foreach $rcptto (@rcptto)
+  {
+    # The dir method is easy to fiddle with and expire records in (with
+    # a find | rm) but it's probably more I/O extensive than a real DB
+    # and suffers from directory size problems if a specific IP is sending
+    # generating tens of thousands of tuplets. -- Marc
+    # That said, I prefer formats I can easily tinker with, and not having to
+    # worry about buggy locking and so forth
+
+    if ($option{'method'} eq "dir")
+    {
+      # The clean strings are hardcoded because it's hard to do a variable
+      # substitution within a tr (and using the eval solution is too resource
+      # expensive)
+      $envfrom =~ tr/!#%( )*+,-.0123456789:<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_abcdefghijklmnopqrstuvwxyz{|}~/_/c;
+      # clean variables to run properly under -T
+      $envfrom =~ /(.+)/;
+      $envfrom = $1;
+      $rcptto  =~ tr/!#%( )*+,-.0123456789:<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_abcdefghijklmnopqrstuvwxyz{|}~/_/c;
+      $rcptto =~ /(.+)/;
+      $rcptto = $1;
+
+      die "greylist option dir not passed, even though method was set to dir" unless ($option{'dir'});
+      my ($ipbyte1, $ipbyte2, $ipbyte3, $ipbyte4) = split(/\./, $connectip);
+      my $ipdir1 = "$option{'dir'}/$ipbyte1";
+      my $ipdir2 = "$ipdir1/$ipbyte2";
+      my $ipdir3 = "$ipdir2/$ipbyte3";
+      my $ipdir4;
+      my $tupletdir;
+
+      $ipdir4 = "$ipdir3";
+      $ipdir4 .= "/$ipbyte4" if ($option{'greylistfourthbyte'});
+      $tupletdir = "$ipdir4/$envfrom";
+
+      $tuplet = "$tupletdir/$rcptto";
+  
+      # make directory whether it's there or not (faster than test and set)
+      mkdir $ipdir1;
+      mkdir $ipdir2;
+      mkdir $ipdir3;
+      mkdir $ipdir4;
+      mkdir $tupletdir;
+
+      if (not -e $tuplet)
+      {
+        # If the tuplets aren't there, we create them and continue in
+        # case there are other ones (one of them might be whitelisted already)
+       $err="creating $tuplet";
+       open (TUPLET, ">$tuplet") or goto greylisterror;
+       print TUPLET time."\n";
+       print TUPLET "Status: Greylisted\n";
+       print TUPLET "Last Message-Id: $mesgid\n";
+       print TUPLET "Whitelisted Count: 0\n";
+       print TUPLET "Query Count: 1\n";
+       $err="closing first-written $tuplet";
+       close TUPLET or goto greylisterror;
+      }
+      else
+      {
+       my $time;
+       my $status;
+       my $whitelistcount;
+       my $querycount;
+
+       # Take into account race condition of expiring deletes and us running
+       $err="reading $tuplet";
+       open (TUPLET, "<$tuplet") or goto greylisterror;
+       $err="Couldn't read time";
+       defined ($time=<TUPLET>) or goto greylisterror;
+       chomp ($time);
+
+       $err="Couldn't read status";
+       defined ($status=<TUPLET>) or goto greylisterror;
+       chomp ($status);
+       $err="Couldn't extract Status from $status";
+       $status =~ s/^Status: // or goto greylisterror;
+
+       # Skip Mesg-Id
+       $err="Couldn't skip Mesg-Id";
+       defined ($_=<TUPLET>) or goto greylisterror;
+
+       $err="Couldn't read whitelistcount";
+       defined ($whitelistcount=<TUPLET>) or goto greylisterror;
+       chomp ($whitelistcount);
+       $err="Couldn't extract Whitelisted Count from $whitelistcount";
+       $whitelistcount =~ s/^Whitelisted Count: // or goto greylisterror;
+
+       $err="Couldn't read querycount";
+       defined ($querycount=<TUPLET>) or goto greylisterror;
+       chomp ($querycount);
+       $err="Couldn't extract Query Count from $querycount";
+       $querycount =~ s/^Query Count: // or goto greylisterror;
+       close (TUPLET);
+
+       $querycount++;
+       if ((time - $time) > $option{'greylistsecs'})
+       {
+         $status="Whitelisted";
+         $whitelistcount++;
+       }
+
+       $err="re-writing $tuplet";
+       open (TUPLET, ">$tuplet") or goto greylisterror;
+       print TUPLET "$time\n";
+       print TUPLET "Status: $status\n";
+       print TUPLET "Last Message-Id: $mesgid\n";
+       print TUPLET "Whitelisted Count: $whitelistcount\n";
+       print TUPLET "Query Count: $querycount\n";
+       $err="closing re-written $tuplet";
+       close TUPLET or goto greylisterror;
+
+        # We continue processing the other recipients, to setup or
+       # update their counters
+       if ($status eq "Whitelisted")
+       {
+         $iswhitelisted=1;
+       }
+      }
+    }
+    elsif ($option{'method'} eq "file")
+    {
+      warn "codeme\n";
+    }
+    elsif ($option{'method'} eq "db")
+    {
+      warn "codeme\n";
+    }
+  }
+  
+  return $iswhitelisted;
+  
+  greylisterror:
+  warn "Reached greylisterror: $err / $!";
+  # delete tuplet since it apparently had issues but don't check for errors
+  # in case it was a permission denied on write
+  unlink ($tuplet);
+  return $iswhitelisted;
+}
+
+
 ###########################################################################
 # BODY TESTS:
 ###########################################################################
diff -urN SpamAssassin.orig/PerMsgStatus.pm SpamAssassin/PerMsgStatus.pm
--- SpamAssassin.orig/PerMsgStatus.pm   Tue Jan 20 13:40:04 2004
+++ SpamAssassin/PerMsgStatus.pm        Sun Feb 29 19:01:19 2004
@@ -184,6 +184,9 @@
 
     # add points from Bayes, before adjusting the AWL
     $self->{hits} += $self->{learned_hits};
+    
+    # Now, we can run rules that have to run last
+    $self->do_res_eval_tests();
 
     # Do AWL tests last, since these need the score to have already been
     # calculated
@@ -2010,6 +2013,11 @@
 }
 
 ###########################################################################
+
+sub do_res_eval_tests {
+  my ($self) = @_;
+  $self->run_eval_tests ($self->{conf}->{res_evals}, '');
+}
 
 sub do_head_eval_tests {
   my ($self) = @_;