Subversion Repositories

?revision_form?Rev ?revision_input??revision_submit??revision_endform?

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
1 magnus 1
Note, this patch is unmaintained. It is not supposed to be functional or
2
safe anymore, but I'm leaving it behind if you'd like to backport the 2.6
3
patch to SA 2.4 (much easier than with 2.6)
4
 
5
-- Marc
6
 
7
 
8
diff -urN SpamAssassin.orig/Conf.pm SpamAssassin/Conf.pm
9
--- SpamAssassin.orig/Conf.pm   Mon Jul 14 11:57:40 2003
10
+++ SpamAssassin/Conf.pm        Sun Feb 22 17:17:03 2004
11
@@ -66,6 +66,9 @@
12
 use constant TYPE_RBL_EVALS     => 0x0013;
13
 # UNUSED => 0x0014
14
 use constant TYPE_RBL_RES_EVALS => 0x0015;
15
+# Need to reserve a number with the SA folks (needs to be odd as it is an
16
+# eval test)
17
+use constant TYPE_RES_EVALS    => 0x0021;
18
 
19
 $VERSION = 'bogus';     # avoid CPAN.pm picking up version strings later
20
 
21
@@ -1507,6 +1510,9 @@
22
     if (/^header\s+(\S+)\s+rblreseval:(.*)$/) {
23
       $self->add_test ($1, $2, TYPE_RBL_RES_EVALS); next;
24
     }
25
+    if (/^header\s+(\S+)\s+reseval:(.*)$/) {
26
+      $self->add_test ($1, $2, TYPE_RES_EVALS); next;
27
+    }
28
     if (/^header\s+(\S+)\s+eval:(.*)$/) {
29
       my ($name,$rule) = ($1, $2);
30
       # Backward compatibility with old rule names -- Marc
31
@@ -2096,6 +2102,9 @@
32
        }
33
        elsif ($type == TYPE_RBL_RES_EVALS) {
34
          $self->{rbl_res_evals}->{$name} = \@args;
35
+       }
36
+       elsif ($type == TYPE_RES_EVALS) {
37
+         $self->{res_evals}->{$name} = \@args;
38
        }
39
        elsif ($type == TYPE_RAWBODY_EVALS) {
40
          $self->{rawbody_evals}->{$name} = \@args;
41
diff -urN SpamAssassin.orig/EvalTests.pm SpamAssassin/EvalTests.pm
42
--- SpamAssassin.orig/EvalTests.pm      Mon Feb 23 23:28:37 2004
43
+++ SpamAssassin/EvalTests.pm   Tue Feb 24 21:34:36 2004
44
@@ -1863,6 +1863,195 @@
45
   return 0;
46
 }
47
 
48
+
49
+# This was originally written to implement greylisting in SA-Exim, although
50
+# I have tried to make it more general and allow for reuse in other MTAs
51
+# (although they will need to
52
+# 1) be running SA at SMTP time
53
+# 2) Provide the list of rcpt to and env from in some headers for SA to read
54
+# 3) Provide the IP of the connecting host )
55
+#
56
+# This rule should get a negative score so that if we've already seen the
57
+# greylisting tuplet before, we lower the score, which hopefully brings us from
58
+# a tempreject to an accept (at least that's how sa-exim does it)
59
+# -- Marc <marc_soft@merlins.org> 2004/01/19
60
+
61
+sub greylisting {
62
+  # db/file/dir / pointer type / how many secs to greylist after 1st connection
63
+  # SA score after which we don't bother running / SMTP time data header names 
64
+  my ($self, $dirorfileordb, $method, $greylisttime, $dontcheckscore,
65
+         $connectiphdr, $envfromhdr, $rcpttohdr) = @_;
66
+  my $dirorfile = shift @_;
67
+
68
+  my $connectip; 
69
+  my $envfrom;
70
+  my $rcptto;
71
+  my @rcptto;
72
+  my $iswhitelisted=0;
73
+  my $err;
74
+  my $mesgid = $self->get ('Message-Id')."\n"; 
75
+  my $tuplet;
76
+  
77
+  # No newlines, thank you (yes, you need this twice apparently)
78
+  chomp ($mesgid);
79
+  chomp ($mesgid);
80
+  $mesgid =~ s/\012/|/g;
81
+
82
+  # For stuff that we know is spam, don't greylist the host
83
+  # (that might help later spam with a lower score to come in)
84
+  if ($self->{hits} >= $dontcheckscore)
85
+  {
86
+    #warn "debug: skipping greylisting on $mesgid, since score is already ".$self->{hits}." and you configured greylisting to not bother with anything above $dontcheckscore\n";
87
+    return 0;
88
+  }
89
+
90
+
91
+  if (not $connectip = $self->get($connectiphdr))
92
+  {
93
+    warn "Couldn't get Connecting IP header $connectiphdr for message $mesgid, skipping greylisting call\n";
94
+    return 0;
95
+  }
96
+  chomp($connectip);
97
+  # Clean up input (for security, if you use files/dirs)
98
+  $connectip =~ s#/#-#g;
99
+
100
+  if (not $envfrom = $self->get($envfromhdr))
101
+  {
102
+    warn "Couldn't get Envelope From header $envfromhdr for message $mesgid, skipping greylisting call\n";
103
+    return 0;
104
+  }
105
+  chomp($envfrom);
106
+  # Clean up input (for security, if you use files/dirs)
107
+  $envfrom =~ s#/#-#g;
108
+
109
+  if (not $rcptto = $self->get($rcpttohdr))
110
+  {
111
+    warn "Couldn't get Rcpt To header $rcpttohdr for message $mesgid, skipping greylisting call\n";
112
+    return 0;
113
+  }
114
+  chomp($rcptto);
115
+  # Clean up input (for security, if you use files/dirs)
116
+  $rcptto =~ s#/#-#g;
117
+  @rcptto = split(/, /, $rcptto);
118
+
119
+  umask 0007;
120
+
121
+  foreach $rcptto (@rcptto)
122
+  {
123
+    my $ipdir = "$dirorfileordb/$connectip";
124
+    my $tupletdir = "$ipdir/$envfrom";
125
+
126
+    $tuplet = "$tupletdir/$rcptto";
127
+  
128
+    # The dir method is easy to fiddle with and expire records in (with
129
+    # a find | rm) but it's probably more I/O extensive than a real DB
130
+    # and suffers from directory size problems if a specific IP is sending
131
+    # generating tens of thousands of tuplets. -- Marc
132
+    # That said, I prefer formats I can easily tinker with, and not having to
133
+    # worry about buggy locking and so forth 
134
+    if ($method eq "dir")
135
+    {
136
+      # make directory whether it's there or not (faster than test and set)
137
+      mkdir $ipdir;
138
+      mkdir $tupletdir;
139
+
140
+      if (not -e $tuplet) 
141
+      {
142
+        # If the tuplets aren't there, we create them and continue in
143
+        # case there are other ones (one of them might be whitelisted already)
144
+       $err="creating $tuplet";
145
+       open (TUPLET, ">$tuplet") or goto greylisterror;
146
+       print TUPLET time."\n";
147
+       print TUPLET "Status: Greylisted\n";
148
+       print TUPLET "Last Message-Id: $mesgid\n";
149
+       print TUPLET "Whitelisted Count: 0\n";
150
+       print TUPLET "Query Count: 1\n";
151
+       $err="closing first-written $tuplet";
152
+       close TUPLET or goto greylisterror;
153
+      }
154
+      else
155
+      {
156
+       my $time;
157
+       my $status;
158
+       my $whitelistcount;
159
+       my $querycount;
160
+
161
+       # Take into account race condition of expiring deletes and us running
162
+       $err="reading $tuplet";
163
+       open (TUPLET, "<$tuplet") or goto greylisterror;
164
+       $err="Couldn't read time";
165
+       $time=<TUPLET> or goto greylisterror;
166
+       chomp ($time);
167
+
168
+       $err="Couldn't read status";
169
+       $status=<TUPLET> or goto greylisterror;
170
+       chomp ($status);
171
+       $err="Couldn't extract Status from $status";
172
+       $status =~ s/^Status: // or goto greylisterror;
173
+
174
+       # Skip Mesg-Id
175
+       $err="Couldn't skip Mesg-Id";
176
+       $_=<TUPLET> or goto greylisterror;
177
+
178
+       $err="Couldn't read whitelistcount";
179
+       $whitelistcount=<TUPLET> or goto greylisterror;
180
+       chomp ($whitelistcount);
181
+       $err="Couldn't extract Whitelisted Count from $whitelistcount";
182
+       $whitelistcount =~ s/^Whitelisted Count: // or goto greylisterror;
183
+
184
+       $err="Couldn't read querycount";
185
+       $querycount=<TUPLET> or goto greylisterror;
186
+       chomp ($querycount);
187
+       $err="Couldn't extract Query Count from $querycount";
188
+       $querycount =~ s/^Query Count: // or goto greylisterror;
189
+       close (TUPLET);
190
+
191
+       $querycount++;
192
+       if ((time - $time) > $greylisttime)
193
+       {
194
+         $status="Whitelisted";
195
+         $whitelistcount++;
196
+       }
197
+
198
+       $err="re-writing $tuplet";
199
+       open (TUPLET, ">$tuplet") or goto greylisterror;
200
+       print TUPLET "$time\n";
201
+       print TUPLET "Status: $status\n";
202
+       print TUPLET "Last Message-Id: $mesgid\n";
203
+       print TUPLET "Whitelisted Count: $whitelistcount\n";
204
+       print TUPLET "Query Count: $querycount\n";
205
+       $err="closing re-written $tuplet";
206
+       close TUPLET or goto greylisterror;
207
+
208
+        # We continue processing the other recipients, to setup or
209
+       # update their counters
210
+       if ($status="Whitelisted")
211
+       {
212
+         $iswhitelisted=1;
213
+       }
214
+      }
215
+    }
216
+    elsif ($method eq "file")
217
+    {
218
+      warn "codeme\n";
219
+    }
220
+    elsif ($method eq "db")
221
+    {
222
+      warn "codeme\n";
223
+    }
224
+  }
225
+  
226
+  return $iswhitelisted;
227
+  
228
+  greylisterror:
229
+  warn "Reached greylisterror: $err / $!";
230
+  # delete tuplet since it apparently had issues but don't check for errors
231
+  # in case it was a permission denied on write
232
+  unlink ($tuplet);
233
+  return $iswhitelisted;
234
+}
235
+
236
+
237
 ###########################################################################
238
 # BODY TESTS:
239
 ###########################################################################
240
diff -urN SpamAssassin.orig/PerMsgStatus.pm SpamAssassin/PerMsgStatus.pm
241
--- SpamAssassin.orig/PerMsgStatus.pm   Mon May 12 12:15:33 2003
242
+++ SpamAssassin/PerMsgStatus.pm        Sun Feb 22 17:47:11 2004
243
@@ -189,6 +189,9 @@
244
 
245
     # add points from Bayes, before adjusting the AWL
246
     $self->{hits} += $self->{learned_hits};
247
+    
248
+    # Now, we can run rules that have to run last
249
+    $self->do_res_eval_tests();
250
 
251
     # Do AWL tests last, since these need the score to have already been
252
     # calculated
253
@@ -1866,6 +1869,11 @@
254
   my ($self) = @_;
255
   # run_rbl_eval_tests doesn't process check returns unless you set needresult
256
   $self->run_rbl_eval_tests ($self->{conf}->{rbl_res_evals}, 1);
257
+}
258
+
259
+sub do_res_eval_tests {
260
+  my ($self) = @_;
261
+  $self->run_eval_tests ($self->{conf}->{res_evals}, '');
262
 }
263
 
264
 sub do_head_eval_tests {