Subversion Repositories

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

Rev 40 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
1 magnus 1
package Greylisting;
2
#
3
# $Id: Greylisting.pm,v 1.4 2006/01/11 17:17:28 marcmerlin Exp $
4
#
5
 
6
# General Greylisting Plugin, written by Marc MERLIN <marc_soft@merlins.org>
7
# (Kristopher Austin gets the credit for the original port to an SA 3.0 plugin)
8
#
9
# This was originally written to implement greylisting in SA-Exim, although
10
# I have tried to make it more general and allow for reuse in other MTAs
11
# (although they will need to
12
# 1) be running SA at SMTP time
13
# 2) Provide the list of rcpt to and env from in some headers for SA to read
14
# 3) Provide the IP of the connecting host )
15
#
16
# This rule should get a negative score so that if we've already seen the
17
# greylisting tuplet before, we lower the score, which hopefully brings us from
18
# a tempreject to an accept (at least that's how sa-exim does it)
19
# 
20
# -- Marc 2004/01/19
21
 
22
use strict;
23
use Mail::SpamAssassin::Plugin;
24
our @ISA = qw(Mail::SpamAssassin::Plugin);
25
 
26
sub new
27
{
28
    my ($class, $mailsa) = @_;
29
    $class = ref($class) || $class;
30
    my $self = $class->SUPER::new($mailsa);
31
    bless ($self, $class);
32
    $self->register_eval_rule ("greylisting");
33
    return $self;
34
}
35
 
36
 
37
sub check_end
38
{
39
    my ($self, $permsgstatus) = @_;
40
 
41
    if (not $self->{'rangreylisting'})
42
    {
43
        Mail::SpamAssassin::Plugin::dbg("GREYLISTING: greylisting didn't run since the configuration wasn't setup to call us");
44
    }
45
}
46
 
47
# Greylisting happens depending on the SA score, so we want to run it last,
48
# which is why we give it a high priority
49
sub greylisting
50
{
51
    my ($self, $permsgstatus, $optionhash) = @_;
52
 
53
    my $connectip;
54
    my $envfrom;
55
    my $rcptto;
56
    my @rcptto;
57
    my $iswhitelisted=0;
58
    my $err;
59
    my $mesgid = $permsgstatus->get('Message-Id')."\n";
60
    my $mesgidfn;
61
    my $tuplet;
62
    my $sascore = $permsgstatus->get_score();
63
    my $dontcheckscore;
64
    my %option;
65
 
66
    Mail::SpamAssassin::Plugin::dbg("GREYLISTING: called function");
67
 
68
    $optionhash  =~ s/;/,/g;
69
    # This is safe, right? (users shouldn't be able to set it in their config)
70
    %option=eval $optionhash;
71
    $self->{'rangreylisting'}=1;
72
 
73
    foreach my $reqoption (qw ( method greylistsecs dontgreylistthreshold
74
        connectiphdr envfromhdr rcpttohdr greylistnullfrom greylistfourthbyte ))
75
    {
76
        die "Greylist option $reqoption missing from SA config" unless (defined $option{$reqoption});
77
    }
78
 
79
    $dontcheckscore = $option{'dontgreylistthreshold'};
80
 
81
 
82
    # No newlines, thank you (yes, you need this twice apparently)
83
    chomp ($mesgid);
84
    chomp ($mesgid);
85
    # Newline in the middle mesgids, are you serious? Get rid of them here
86
    $mesgid =~ s/\012/|/g;
87
 
88
    # For stuff that we know is spam, don't greylist the host
89
    # (that might help later spam with a lower score to come in)
90
    if ($sascore >= $dontcheckscore)
91
    {
92
        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");
93
        return 0;
94
    }
95
    else
96
    {
97
        Mail::SpamAssassin::Plugin::dbg("GREYLISTING: running greylisting on $mesgid, since score is too low ($sascore) and you configured greylisting to greylist anything under $dontcheckscore");
98
    }
99
 
100
    if (not $connectip = $permsgstatus->get($option{'connectiphdr'}))
101
    {
102
        warn "Couldn't get Connecting IP header $option{'connectiphdr'} for message $mesgid, skipping greylisting call\n";
103
        return 0;
104
    }
105
    chomp($connectip);
106
    # Clean up input (for security, if you use files/dirs)
107
    $connectip =~ /([\d.:]+)/;
108
    $connectip = ($1 or "");
109
 
110
    # Account for a null envelope from
111
    if (not defined ($envfrom = $permsgstatus->get($option{'envfromhdr'})))
112
    {
113
        warn "Couldn't get Envelope From header $option{'envfromhdr'} for message $mesgid, skipping greylisting call\n";
114
        return 0;
115
    }
116
    chomp($envfrom);
117
    # Clean up input (for security, if you use files/dirs)
118
    $envfrom =~ s#/#-#g;
119
    if (not $envfrom)
120
    {
121
        $envfrom="<>";
122
        return 0 if (not $option{'greylistnullfrom'});
123
    }
124
 
125
    if (not $rcptto = $permsgstatus->get($option{'rcpttohdr'}))
126
    {
127
        warn "Couldn't get Rcpt To header $option{'rcpttohdr'} for message $mesgid, skipping greylisting call\n";
128
        return 0;
129
    }
130
    chomp($rcptto);
131
    # Clean up input (for security, if you use files/dirs)
132
    $rcptto =~ s#/#-#g;
133
    @rcptto = split(/, /, $rcptto);
134
 
135
 
136
    umask 0007;
137
 
138
    foreach $rcptto (@rcptto)
139
    {
140
        # The dir method is easy to fiddle with and expire records in (with
141
        # a find | rm) but it's probably more I/O extensive than a real DB
142
        # and suffers from directory size problems if a specific IP is sending
143
        # generating tens of thousands of tuplets. -- Marc
144
        # That said, I prefer formats I can easily tinker with, and not having
145
        # to worry about buggy locking and so forth
146
 
147
        if ($option{'method'} eq "dir")
148
        {
149
            my $tmpvar;
150
 
151
            # The clean strings are hardcoded because it's hard to do a variable
152
            # substitution within a tr (and using the eval solution is too
153
            # resource expensive)
154
            # envfrom could be cleaned outside of the loop, but the other method 
155
            # options might now want that
156
            $envfrom =~ tr/!#%()*+,-.0123456789:<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_abcdefghijklmnopqrstuvwxyz{|}~/_/c;
157
            # clean variables to run properly under -T
158
            $envfrom =~ /(.+)/;
159
            $tmpvar = ($1 or "");
160
            # work around bug in perl untaint in perl 5.8
161
            $envfrom=undef;
162
            $envfrom=$tmpvar;
41 magnus 163
            $envfrom =~ s/^([a-z0-9._]*)[^@]*/$1/i;
164
 
1 magnus 165
            $rcptto  =~ tr/!#%()*+,-.0123456789:<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_abcdefghijklmnopqrstuvwxyz{|}~/_/c;
166
            $rcptto =~ /(.+)/;
167
            $tmpvar = ($1 or "");
168
            $rcptto=undef;
169
            $rcptto=$tmpvar;
170
 
171
            die "greylist option dir not passed, even though method was set to dir" unless ($option{'dir'});
172
 
173
            # connectip is supposed to be untainted now, but I was still getting
174
            # some insecure dependecy error messages sometimes (perl 5.8 problem apparently)
40 magnus 175
            unless ($connectip =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
176
                warn "Can only handle IPv4 addresses; skipping greylisting call for message $mesgid\n";
177
                return 0;
178
            }
179
 
180
            my $ipdir1 = "$option{'dir'}/$1";
181
            my $ipdir2 = "$ipdir1/$2";
182
            my $ipdir3 = "$ipdir2/$3";
1 magnus 183
            my $ipdir4;
184
            my $tupletdir;
185
 
186
            $ipdir4 = "$ipdir3";
40 magnus 187
            $ipdir4 .= "/$4" if ($option{'greylistfourthbyte'});
1 magnus 188
            $tupletdir = "$ipdir4/$envfrom";
189
 
190
            $tuplet = "$tupletdir/$rcptto";
191
 
192
            # make directory whether it's there or not (faster than test and set)
193
            mkdir $ipdir1;
194
            mkdir $ipdir2;
195
            mkdir $ipdir3;
196
            mkdir $ipdir4;
197
            mkdir $tupletdir;
198
 
199
            if (not -e $tuplet)
200
            {
201
                # If the tuplets aren't there, we create them and continue in
202
                # case there are other ones (one of them might be whitelisted
203
                # already)
204
                $err="creating $tuplet";
205
                open (TUPLET, ">$tuplet") or goto greylisterror;
206
                print TUPLET time."\n";
207
                print TUPLET "Status: Greylisted\n";
208
                print TUPLET "Last Message-Id: $mesgid\n";
209
                print TUPLET "Whitelisted Count: 0\n";
210
                print TUPLET "Query Count: 1\n";
211
                print TUPLET "SA Score: $sascore\n";
212
                $err="closing first-written $tuplet";
213
                close TUPLET or goto greylisterror;
214
            }
215
            else
216
            {
217
                my $time;
218
                my $status;
219
                my $whitelistcount;
220
                my $querycount;
221
 
222
                # Take into account race condition of expiring deletes and us
223
                # running
224
                $err="reading $tuplet";
225
                open (TUPLET, "<$tuplet") or goto greylisterror;
226
                $err="Couldn't read time";
227
                defined ($time=<TUPLET>) or goto greylisterror;
228
                chomp ($time);
229
 
230
                $err="Couldn't read status";
231
                defined ($status=<TUPLET>) or goto greylisterror;
232
                chomp ($status);
233
                $err="Couldn't extract Status from $status";
234
                $status =~ s/^Status: // or goto greylisterror;
235
 
236
                # Skip Mesg-Id
237
                $err="Couldn't skip Mesg-Id";
238
                defined ($_=<TUPLET>) or goto greylisterror;
239
 
240
                $err="Couldn't read whitelistcount";
241
                defined ($whitelistcount=<TUPLET>) or goto greylisterror;
242
                chomp ($whitelistcount);
243
                $err="Couldn't extract Whitelisted Count from $whitelistcount";
244
                $whitelistcount =~ s/^Whitelisted Count: // or goto greylisterror;
245
 
246
                $err="Couldn't read querycount";
247
                defined ($querycount=<TUPLET>) or goto greylisterror;
248
                chomp ($querycount);
249
                $err="Couldn't extract Query Count from $querycount";
250
                $querycount =~ s/^Query Count: // or goto greylisterror;
251
                close (TUPLET);
252
 
253
                $querycount++;
254
                if ((time - $time) > $option{'greylistsecs'})
255
                {
256
                    $status="Whitelisted";
257
                    $whitelistcount++;
258
                }
259
 
260
                $err="re-writing $tuplet";
261
                open (TUPLET, ">$tuplet") or goto greylisterror;
262
                print TUPLET "$time\n";
263
                print TUPLET "Status: $status\n";
264
                print TUPLET "Last Message-Id: $mesgid\n";
265
                print TUPLET "Whitelisted Count: $whitelistcount\n";
266
                print TUPLET "Query Count: $querycount\n";
267
                print TUPLET "SA Score: $sascore\n";
268
                $err="closing re-written $tuplet";
269
                close TUPLET or goto greylisterror;
270
 
271
                # We continue processing the other recipients, to setup or
272
                # update their counters
273
                if ($status eq "Whitelisted")
274
                {
275
                    $iswhitelisted=1;
276
                }
277
            }
278
        }
279
        elsif ($option{'method'} eq "file")
280
        {
281
            warn "codeme (file greylisting)\n";
282
        }
283
        elsif ($option{'method'} eq "db")
284
        {
285
            warn "codeme (db greylisting)\n";
286
        }
287
    }
288
 
289
    Mail::SpamAssassin::Plugin::dbg("GREYLISTING: computed greylisting on tuplet, saved info in $tuplet and whitelist status is $iswhitelisted");
290
    return $iswhitelisted;
291
 
292
    greylisterror:
293
    warn "Reached greylisterror: $err / $!";
294
    # delete tuplet since it apparently had issues but don't check for errors
295
    # in case it was a permission denied on write
296
    unlink ($tuplet);
297
    return $iswhitelisted;
298
}
299
 
300
 
301
1;