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 { |