File: SA-greylisting-2.4x.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 (264 lines) | stat: -rw-r--r-- 8,541 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
Note, this patch is unmaintained. It is not supposed to be functional or
safe anymore, but I'm leaving it behind if you'd like to backport the 2.6
patch to SA 2.4 (much easier than with 2.6)

-- Marc


diff -urN SpamAssassin.orig/Conf.pm SpamAssassin/Conf.pm
--- SpamAssassin.orig/Conf.pm	Mon Jul 14 11:57:40 2003
+++ SpamAssassin/Conf.pm	Sun Feb 22 17:17:03 2004
@@ -66,6 +66,9 @@
 use constant TYPE_RBL_EVALS     => 0x0013;
 # UNUSED => 0x0014
 use constant TYPE_RBL_RES_EVALS => 0x0015;
+# 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
 
@@ -1507,6 +1510,9 @@
     if (/^header\s+(\S+)\s+rblreseval:(.*)$/) {
       $self->add_test ($1, $2, TYPE_RBL_RES_EVALS); next;
     }
+    if (/^header\s+(\S+)\s+reseval:(.*)$/) {
+      $self->add_test ($1, $2, TYPE_RES_EVALS); next;
+    }
     if (/^header\s+(\S+)\s+eval:(.*)$/) {
       my ($name,$rule) = ($1, $2);
       # Backward compatibility with old rule names -- Marc
@@ -2096,6 +2102,9 @@
 	}
 	elsif ($type == TYPE_RBL_RES_EVALS) {
 	  $self->{rbl_res_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	Mon Feb 23 23:28:37 2004
+++ SpamAssassin/EvalTests.pm	Tue Feb 24 21:34:36 2004
@@ -1863,6 +1863,195 @@
   return 0;
 }
 
+
+# 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 {
+  # db/file/dir / pointer type / how many secs to greylist after 1st connection
+  # SA score after which we don't bother running / SMTP time data header names 
+  my ($self, $dirorfileordb, $method, $greylisttime, $dontcheckscore,
+	  $connectiphdr, $envfromhdr, $rcpttohdr) = @_;
+  my $dirorfile = shift @_;
+
+  my $connectip; 
+  my $envfrom;
+  my $rcptto;
+  my @rcptto;
+  my $iswhitelisted=0;
+  my $err;
+  my $mesgid = $self->get ('Message-Id')."\n"; 
+  my $tuplet;
+  
+  # No newlines, thank you (yes, you need this twice apparently)
+  chomp ($mesgid);
+  chomp ($mesgid);
+  $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} >= $dontcheckscore)
+  {
+    #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($connectiphdr))
+  {
+    warn "Couldn't get Connecting IP header $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;
+
+  if (not $envfrom = $self->get($envfromhdr))
+  {
+    warn "Couldn't get Envelope From header $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 $rcptto = $self->get($rcpttohdr))
+  {
+    warn "Couldn't get Rcpt To header $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)
+  {
+    my $ipdir = "$dirorfileordb/$connectip";
+    my $tupletdir = "$ipdir/$envfrom";
+
+    $tuplet = "$tupletdir/$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 ($method eq "dir")
+    {
+      # make directory whether it's there or not (faster than test and set)
+      mkdir $ipdir;
+      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";
+	$time=<TUPLET> or goto greylisterror;
+	chomp ($time);
+
+	$err="Couldn't read status";
+	$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";
+	$_=<TUPLET> or goto greylisterror;
+
+	$err="Couldn't read whitelistcount";
+	$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";
+	$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) > $greylisttime)
+	{
+	  $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="Whitelisted")
+	{
+	  $iswhitelisted=1;
+	}
+      }
+    }
+    elsif ($method eq "file")
+    {
+      warn "codeme\n";
+    }
+    elsif ($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	Mon May 12 12:15:33 2003
+++ SpamAssassin/PerMsgStatus.pm	Sun Feb 22 17:47:11 2004
@@ -189,6 +189,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
@@ -1866,6 +1869,11 @@
   my ($self) = @_;
   # run_rbl_eval_tests doesn't process check returns unless you set needresult
   $self->run_rbl_eval_tests ($self->{conf}->{rbl_res_evals}, 1);
+}
+
+sub do_res_eval_tests {
+  my ($self) = @_;
+  $self->run_eval_tests ($self->{conf}->{res_evals}, '');
 }
 
 sub do_head_eval_tests {