File: SA-greylisting-2.6.diff

package info (click to toggle)
sa-exim 4.2-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 356 kB
  • ctags: 154
  • sloc: ansic: 1,296; perl: 200; makefile: 108; sh: 77
file content (304 lines) | stat: -rw-r--r-- 9,996 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
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 receipients, 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) = @_;