/usr/share/perl5/Mail/SpamAssassin/Plugin/Greylisting.pm is in sa-exim 4.2.1-16.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 305 306 307 308 309 | package Greylisting;
#
# $Id: Greylisting.pm,v 1.4 2006/01/11 17:17:28 marcmerlin Exp $
#
# General Greylisting Plugin, written by Marc MERLIN <marc_soft@merlins.org>
# (Kristopher Austin gets the credit for the original port to an SA 3.0 plugin)
#
# 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 2004/01/19
use strict;
use Mail::SpamAssassin::Plugin;
use NetAddr::IP;
use File::Path qw(mkpath);
our @ISA = qw(Mail::SpamAssassin::Plugin);
sub new
{
my ($class, $mailsa) = @_;
$class = ref($class) || $class;
my $self = $class->SUPER::new($mailsa);
bless ($self, $class);
$self->register_eval_rule ("greylisting");
return $self;
}
sub check_end
{
my ($self, $permsgstatus) = @_;
if (not $self->{'rangreylisting'})
{
Mail::SpamAssassin::Plugin::dbg("GREYLISTING: greylisting didn't run since the configuration wasn't setup to call us");
}
}
# Greylisting happens depending on the SA score, so we want to run it last,
# which is why we give it a high priority
sub greylisting
{
my ($self, $permsgstatus, $optionhash) = @_;
my $connectip;
my $envfrom;
my $rcptto;
my @rcptto;
my $iswhitelisted=0;
my $err;
my $mesgid = $permsgstatus->get('Message-Id')."\n";
my $mesgidfn;
my $tuplet;
my $sascore = $permsgstatus->get_score();
my $dontcheckscore;
my %option;
if ($self->{main}->{lint_rules}) {
Mail::SpamAssassin::Plugin::dbg("GREYLISTING: disabled while linting");
return 0;
}
Mail::SpamAssassin::Plugin::dbg("GREYLISTING: called function");
$optionhash =~ s/;/,/g;
# This is safe, right? (users shouldn't be able to set it in their config)
%option=eval $optionhash;
$self->{'rangreylisting'}=1;
foreach my $reqoption (qw ( method greylistsecs dontgreylistthreshold
connectiphdr envfromhdr rcpttohdr greylistnullfrom greylistfourthbyte ))
{
die "Greylist option $reqoption missing from SA config" unless (defined $option{$reqoption});
}
$dontcheckscore = $option{'dontgreylistthreshold'};
# 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 ($sascore >= $dontcheckscore)
{
Mail::SpamAssassin::Plugin::dbg("GREYLISTING: skipping greylisting on $mesgid, since score is already $sascore and you configured greylisting not to bother with anything above $dontcheckscore");
return 0;
}
else
{
Mail::SpamAssassin::Plugin::dbg("GREYLISTING: running greylisting on $mesgid, since score is too low ($sascore) and you configured greylisting to greylist anything under $dontcheckscore");
}
if (not $connectip = $permsgstatus->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 = NetAddr::IP->new($connectip);
if (not defined $connectip) {
warn "Can only handle IPv4 and IPv6 addresses; skipping greylisting call for message $mesgid\n";
return 0;
}
# Account for a null envelope from
if (not defined ($envfrom = $permsgstatus->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 = $permsgstatus->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")
{
my $tmpvar;
# 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 could be cleaned outside of the loop, but the other method
# options might now want that
$envfrom =~ tr/!#%()*+,-.0123456789:<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_abcdefghijklmnopqrstuvwxyz{|}~/_/c;
# clean variables to run properly under -T
$envfrom =~ /(.+)/;
$tmpvar = ($1 or "");
# work around bug in perl untaint in perl 5.8
$envfrom=undef;
$envfrom=$tmpvar;
$envfrom =~ s/^([a-z0-9._]*)[^@]*/$1/i;
$rcptto =~ tr/!#%()*+,-.0123456789:<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_abcdefghijklmnopqrstuvwxyz{|}~/_/c;
$rcptto =~ /(.+)/;
$tmpvar = ($1 or "");
$rcptto=undef;
$rcptto=$tmpvar;
die "greylist option dir not passed, even though method was set to dir" unless ($option{'dir'});
# connectip is supposed to be untainted now, but I was still getting
# some insecure dependecy error messages sometimes (perl 5.8 problem apparently)
my $ipdir;
if ($connectip->version == 6) {
my @components = split ':', $connectip->full, 5;
if ($option{'greylistfourthbyte'}) {
$ipdir = join '/', @components;
} else {
$ipdir = join '/', @components[0..3];
}
} else {
my @components = split '\.', $connectip->addr;
if ($option{'greylistfourthbyte'}) {
$ipdir = join '/', @components;
} else {
$ipdir = join '/', @components[0..2];
}
}
my $tupletdir = "$option{'dir'}/$ipdir/$envfrom";
$tuplet = "$tupletdir/$rcptto";
# make directory whether it's there or not (faster than test and set)
mkpath $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";
print TUPLET "SA Score: $sascore\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";
print TUPLET "SA Score: $sascore\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 (file greylisting)\n";
}
elsif ($option{'method'} eq "db")
{
warn "codeme (db greylisting)\n";
}
}
Mail::SpamAssassin::Plugin::dbg("GREYLISTING: computed greylisting on tuplet, saved info in $tuplet and whitelist status is $iswhitelisted");
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;
}
1;
|