lib/Exim/Grey.pm
author Heiko Schlittermann <hs@schlittermann.de>
Sat, 04 Jun 2016 22:07:56 +0200
changeset 70 bb6af74ba8b2
parent 69 0f66e8a1364a
child 72 f095f28db247
permissions -rw-r--r--
Documentation
58
27440e1334b7 Use lib/ and ExtUtils::MakeMaker
heiko
parents: 57
diff changeset
     1
package Exim::Grey;
67
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
     2
# for usage please see at the end
9
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
     3
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
     4
use strict;
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
     5
use warnings;
58
27440e1334b7 Use lib/ and ExtUtils::MakeMaker
heiko
parents: 57
diff changeset
     6
use base 'Exporter';
12
de787ecf7c3c DB_File
heiko
parents: 9
diff changeset
     7
use Carp;
de787ecf7c3c DB_File
heiko
parents: 9
diff changeset
     8
69
0f66e8a1364a Export seen()
Heiko Schlittermann <hs@schlittermann.de>
parents: 68
diff changeset
     9
our @EXPORT_OK   = qw(unseen seen getDBDir connectDB getDefault);
63
8525154c1389 [perltidy]
Heiko Schlittermann <hs@schlittermann.de>
parents: 61
diff changeset
    10
our %EXPORT_TAGS = (all => \@EXPORT_OK,);
8525154c1389 [perltidy]
Heiko Schlittermann <hs@schlittermann.de>
parents: 61
diff changeset
    11
our $VERSION     = '2.0';
58
27440e1334b7 Use lib/ and ExtUtils::MakeMaker
heiko
parents: 57
diff changeset
    12
12
de787ecf7c3c DB_File
heiko
parents: 9
diff changeset
    13
# You may choose, but DB_File's footprint is smaller.
de787ecf7c3c DB_File
heiko
parents: 9
diff changeset
    14
# perl -MDB_File -e 'tie %h, ...':	real    0m0.063s
de787ecf7c3c DB_File
heiko
parents: 9
diff changeset
    15
# perl -MBerkeleyDB -e 'tie %h, ...':	real	0m0.112s
de787ecf7c3c DB_File
heiko
parents: 9
diff changeset
    16
# And DB_File is part of the Perl core distribution (?)
de787ecf7c3c DB_File
heiko
parents: 9
diff changeset
    17
# use BerkeleyDB;
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    18
# use DB_File;
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    19
# But we need locking! DB_File::Lock isn't part of the corelist.
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    20
use DB_File::Lock;
9
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
    21
48
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
    22
my %DEFAULT = (
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
    23
    delay => 600,
67
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
    24
    db    => 'seen',
9
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
    25
);
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
    26
12
de787ecf7c3c DB_File
heiko
parents: 9
diff changeset
    27
# some helper functions
9
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
    28
sub getDBDir();
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
    29
sub findExim(;$);
12
de787ecf7c3c DB_File
heiko
parents: 9
diff changeset
    30
sub connectDB($$);
47
1c2ae71d226b - viel verändert
heiko
parents: 44
diff changeset
    31
sub getDefault() { %DEFAULT }
9
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
    32
67
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
    33
31
7d2c9f3186f4 wildcard behaviour cleaned
heiko
parents: 23
diff changeset
    34
# dbm file is relativ to $spool_directory/grey, EXCEPT its name
7d2c9f3186f4 wildcard behaviour cleaned
heiko
parents: 23
diff changeset
    35
# starts with "./" or "/".
47
1c2ae71d226b - viel verändert
heiko
parents: 44
diff changeset
    36
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    37
sub unseen {
61
68eb79f3f500 [perltidy]
Heiko Schlittermann <hs@schlittermann.de>
parents: 59
diff changeset
    38
    my $item   = shift;
68eb79f3f500 [perltidy]
Heiko Schlittermann <hs@schlittermann.de>
parents: 59
diff changeset
    39
    my $delay  = shift // $DEFAULT{delay};
68eb79f3f500 [perltidy]
Heiko Schlittermann <hs@schlittermann.de>
parents: 59
diff changeset
    40
    my $db     = shift // $DEFAULT{db};
68eb79f3f500 [perltidy]
Heiko Schlittermann <hs@schlittermann.de>
parents: 59
diff changeset
    41
    my $now    = time();
66
16b4815a6a15 Do not include the "autokey" in the "greykey"
heiko
parents: 63
diff changeset
    42
    my ($auto) = $item =~ /.*?\/(.+?)$/ # remove the /<autokey> from the item
16b4815a6a15 Do not include the "autokey" in the "greykey"
heiko
parents: 63
diff changeset
    43
        and $item =~ s/\/.*?$//;
48
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
    44
    my $rc;
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
    45
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    46
    connectDB(\my %h, $db);
48
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
    47
61
68eb79f3f500 [perltidy]
Heiko Schlittermann <hs@schlittermann.de>
parents: 59
diff changeset
    48
    return 'no'    # not unseen, ergo known
68eb79f3f500 [perltidy]
Heiko Schlittermann <hs@schlittermann.de>
parents: 59
diff changeset
    49
      if defined $auto and is_whitelisted($auto, \%h);
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    50
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    51
    my $key = "$item\0";
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    52
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    53
    # we do not know anything about the client -> unknown
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    54
    if (not exists $h{$key}) {
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    55
        $h{$key} = "$now $now 0\0";
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    56
        return 'yes';
48
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
    57
    }
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    58
59
8088c95fac5d Fix small bugs
heiko
parents: 58
diff changeset
    59
    my ($created, undef, $count) = split /[ \0]/, $h{$key};
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    60
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    61
    # we know the client, but last contact was recently (too fast)
61
68eb79f3f500 [perltidy]
Heiko Schlittermann <hs@schlittermann.de>
parents: 59
diff changeset
    62
    if ($now - $created < $delay) {
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    63
        return 'yes';
48
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
    64
    }
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    65
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    66
    # we know the client, was patiently enough
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    67
    ++$count;
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    68
    $h{$key} = "$created $now $count\0";
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    69
    whitelist($auto, \%h) if defined $auto;
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    70
    return 'no';
9
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
    71
}
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
    72
69
0f66e8a1364a Export seen()
Heiko Schlittermann <hs@schlittermann.de>
parents: 68
diff changeset
    73
sub seen {
0f66e8a1364a Export seen()
Heiko Schlittermann <hs@schlittermann.de>
parents: 68
diff changeset
    74
    return(unseen(@_) eq 'yes' ? 'no' : 'yes');
0f66e8a1364a Export seen()
Heiko Schlittermann <hs@schlittermann.de>
parents: 68
diff changeset
    75
}
0f66e8a1364a Export seen()
Heiko Schlittermann <hs@schlittermann.de>
parents: 68
diff changeset
    76
52
23160db926d4 added some comments
heiko
parents: 50
diff changeset
    77
# According to a thought from "David Woodhouse <dwmw2@infradead.org>"
61
68eb79f3f500 [perltidy]
Heiko Schlittermann <hs@schlittermann.de>
parents: 59
diff changeset
    78
# on exim-users@exim.org (Thu, 08 May 2008 13:10:21 +0100,
52
23160db926d4 added some comments
heiko
parents: 50
diff changeset
    79
# Message-Id: <1210248621.25560.1088.camel@pmac.infradead.org>) we
23160db926d4 added some comments
heiko
parents: 50
diff changeset
    80
# should have the ability to "auto whitelist" hosts which are known
23160db926d4 added some comments
heiko
parents: 50
diff changeset
    81
# for retries, because there is no benefit in greylisting them.
23160db926d4 added some comments
heiko
parents: 50
diff changeset
    82
#
23160db926d4 added some comments
heiko
parents: 50
diff changeset
    83
# Most safe approach would be something based on message id.
23160db926d4 added some comments
heiko
parents: 50
diff changeset
    84
# If we see the message id a second time it indicates successful retry.
23160db926d4 added some comments
heiko
parents: 50
diff changeset
    85
# But we do not see the message id the first time we reject the message.
23160db926d4 added some comments
heiko
parents: 50
diff changeset
    86
23160db926d4 added some comments
heiko
parents: 50
diff changeset
    87
# This function has to be called twice per message delivery attempt
23160db926d4 added some comments
heiko
parents: 50
diff changeset
    88
# <KEY> <$sender_host_address> <$sender_helo_name>
23160db926d4 added some comments
heiko
parents: 50
diff changeset
    89
# (Where <KEY> is something like <$sender_address>+<$local_part@$domain>
23160db926d4 added some comments
heiko
parents: 50
diff changeset
    90
# If we see the same message a second time (same message means here:
23160db926d4 added some comments
heiko
parents: 50
diff changeset
    91
# same greylist criteria
23160db926d4 added some comments
heiko
parents: 50
diff changeset
    92
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    93
sub whitelist {
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    94
    my ($item, $h) = @_;
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    95
    my $now = time;
57
9db6f9fdba12 Tag the auto-whitelist keys
heiko
parents: 55
diff changeset
    96
    $h->{"$item\0"} = "$now $now 1 auto\0";
52
23160db926d4 added some comments
heiko
parents: 50
diff changeset
    97
}
23160db926d4 added some comments
heiko
parents: 50
diff changeset
    98
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
    99
sub is_whitelisted {
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   100
    my ($item, $h) = @_;
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   101
    my $key = "$item\0";
52
23160db926d4 added some comments
heiko
parents: 50
diff changeset
   102
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   103
    return 0 if not exists $h->{$key};
61
68eb79f3f500 [perltidy]
Heiko Schlittermann <hs@schlittermann.de>
parents: 59
diff changeset
   104
59
8088c95fac5d Fix small bugs
heiko
parents: 58
diff changeset
   105
    my ($t0, undef, $cnt, $flag) = split /[ \0]/, $h->{$key};
57
9db6f9fdba12 Tag the auto-whitelist keys
heiko
parents: 55
diff changeset
   106
    $h->{$key} = join(' ' => $t0, time, ++$cnt, $flag ? $flag : ()) . "\0";
52
23160db926d4 added some comments
heiko
parents: 50
diff changeset
   107
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   108
    return 1;
38
329e69e5c6dd - started some auto whitelist implementation
heiko
parents: 36
diff changeset
   109
}
329e69e5c6dd - started some auto whitelist implementation
heiko
parents: 36
diff changeset
   110
9
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
   111
# Get the directory where we could store the database file(s)
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
   112
# If we're running under exim it's easy, otherwise we've to find exim
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
   113
# and then ask...
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
   114
sub getDBDir() {
48
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   115
    my ($spooldir, $dbdir);
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   116
    eval { $spooldir = Exim::expand_string('$spool_directory') };
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   117
    if (not defined $spooldir) {
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   118
        my $exim = findExim();
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   119
        chomp($spooldir = `$exim -be '\$spool_directory'`);
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   120
        die "Can't find spooldir" if not defined $spooldir;
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   121
    }
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   122
    -d ($dbdir = "$spooldir/grey") and return $dbdir;
16
b47059897e9b DB-Autocreation
heiko
parents: 12
diff changeset
   123
61
68eb79f3f500 [perltidy]
Heiko Schlittermann <hs@schlittermann.de>
parents: 59
diff changeset
   124
    my ($mode, $owner, $group) = (stat $spooldir)[2, 4, 5];
48
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   125
    {
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   126
        local $) = $group;
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   127
        local $> = $owner;
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   128
        $mode &= 0777;
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   129
        mkdir $dbdir, $mode or die "Can't create $dbdir: $!";
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   130
    }
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   131
    return $dbdir;
9
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
   132
}
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
   133
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
   134
sub findExim(;$) {
48
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   135
    my $path = shift || $ENV{PATH};
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   136
    my $exim;
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   137
    foreach (split /:/, $ENV{PATH}) {
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   138
        -x ($exim = "$_/exim")  and return $exim;
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   139
        -x ($exim = "$_/exim4") and return $exim;
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   140
    }
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   141
    die "Can't find exim binary (missing .../sbin dirs in PATH?";
9
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
   142
}
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
   143
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   144
sub connectDB($$) {
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   145
    my ($h, $db) = @_;
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   146
    $db = getDBDir() . "/$db" unless $db =~ m(^\.?/);
47
1c2ae71d226b - viel verändert
heiko
parents: 44
diff changeset
   147
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   148
    # Creation of DB-File if it doesn't exist
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   149
    # to avoid races we change our own uid/gid for creation of
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   150
    # this file.
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   151
    if (!-f $db) {
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   152
        (my $dir = $db) =~ s/^(.*)\/.*?$/$1/;
47
1c2ae71d226b - viel verändert
heiko
parents: 44
diff changeset
   153
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   154
        # copy mode, uid, gid from the directory
61
68eb79f3f500 [perltidy]
Heiko Schlittermann <hs@schlittermann.de>
parents: 59
diff changeset
   155
        my ($mode, $user, $group) = (stat $dir)[2, 4, 5]
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   156
          or die "Can't stat $dir: $!";
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   157
        my $umask = umask(($mode & 0777) ^ 0777);
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   158
        local $) = $group;
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   159
        local $> = $user;
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   160
        open(X, ">>$db") or die "Can't create $db: $!";
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   161
        close(X);
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   162
        umask $umask;
48
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   163
    }
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   164
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   165
    # now test which of the DB-Modules has been loaded
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   166
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   167
    if (exists &BerkeleyDB::Hash::TIEHASH) {
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   168
        no strict;
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   169
        my $umask = umask 077;
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   170
        tie %$h, "BerkeleyDB::Hash", -Filename => $db
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   171
          or die "$0: $db: $!";
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   172
        return $db;
48
61a2dc11f50b - perltidy
heiko
parents: 47
diff changeset
   173
    }
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   174
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   175
    if (exists &DB_File::Lock::TIEHASH) {
61
68eb79f3f500 [perltidy]
Heiko Schlittermann <hs@schlittermann.de>
parents: 59
diff changeset
   176
        tie %$h, 'DB_File::Lock', [$db], 'write'
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   177
          or die "$0: $db: $!";
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   178
        return $db;
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   179
    }
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   180
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   181
    if (exists &DB_File::TIEHASH) {
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   182
        tie %$h, 'DB_File', $db or die "$0: $db: $!";
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   183
        warn "$0: using DB_File, no locking is possible!\n";
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   184
        return $db;
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   185
    }
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   186
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   187
    die "Can't connect to database driver";
47
1c2ae71d226b - viel verändert
heiko
parents: 44
diff changeset
   188
}
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   189
50
79b972eb8990 - exim-exigrey.pl: end with 1 (true)
heiko
parents: 48
diff changeset
   190
1;
9
417562509dbe Installation to .../share and ../sbin
heiko
parents:
diff changeset
   191
67
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   192
__END__
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   193
=head1 NAME
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   194
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   195
 Exim::Grey
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   196
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   197
=head1 SYNOPSIS
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   198
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   199
 perl_startup use Exim::Grey qw(unseen);
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   200
 ...
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   201
 acl rcpt
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   202
    defer condition = ${perl{unseen}{<$sender_address>:<$local_part@$domain>}}
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   203
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   204
=head1 DESCRIPTION
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   205
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   206
This is a module to be loade by Exim, the MTA. On request it exports
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   207
a single function C<unseen()>. This function may be used in the ACL section
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   208
to support greylisting.
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   209
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   210
=head1 FUNCTIONS
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   211
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   212
=over
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   213
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   214
=item scalar B<unseen>(I<key>, I<delay>, I<db>)
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   215
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   216
This function returns I<true> if the key is already known in the I<db> database
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   217
for the minimum I<delay> time. (Note: The database may be cleaned regularly by
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   218
the compangion L<exigrey> tool.)
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   219
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   220
The I<key> is mandotory, the default I<delay> is 600 seconds and the default I<db>
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   221
is called F<seen>.
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   222
70
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   223
I<Key> may contain a suffix, separated by "/". This suffix is used for
67
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   224
automatic whitelisting.
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   225
70
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   226
=item scalar B<seen>(I<key>, I<delay>, I<db>)
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   227
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   228
The same as C<unseen()>, but with reversed result.
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   229
67
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   230
=back
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   231
70
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   232
=head1 EXAMPLES
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   233
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   234
=head2 Greylisting
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   235
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   236
First you have to include B<Exim::Grey> into your Exim. If Exim is built with Perl
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   237
support, the configuration syntax allows for C<perl_startup>:
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   238
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   239
    perl_startup = use Exim::Grey qw(unseen);
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   240
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   241
In the ACL section of the configuration can check if a given key (sender, or combination
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   242
of sender and recipient, or whatever) is new (unseen):
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   243
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   244
    defer condition = ${perl{unseen}{<$sender_address>:$<local_part@$domain>}}
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   245
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   246
If the same condition is checked more then I<delay> later, the C<unseen> function returns
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   247
false.
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   248
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   249
=head2 Greylisting + automatic whitelisting
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   250
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   251
Greylisting gets annoying if you do it for senders that are already known to retry. Thus it might be
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   252
good to maintain a whitelist. You may use a suffix to your key, separated by "/". Once the greylist
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   253
filter is passed, the used suffixes are registered with the whitelist.
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   254
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   255
  t
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   256
  |
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   257
  0  a->b/x  # a->b never seen, suffix never seen: greylist
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   258
  1  a->b/y  # a->b again: accept AND put x and y to the whitelist,
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   259
  |          # as they are known to retry
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   260
  2  c->b/x  # c->b unknown, but x is already whitelisted: accept
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   261
  3  d->b/y  # d->b unknown, but y is already whitelisted: accept
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   262
  |
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   263
  v
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   264
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   265
This can be implemented in your ACL as:
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   266
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   267
    defer condition = ${perl{unseen}{<$sender_address>:$<local_part@$domain>/$sender_host_address}}
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   268
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   269
But, if I<a> and I<b> are the sender and the recipient address, and the
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   270
subkey is the sender host address, a spammer might send a forged message
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   271
after t0, to get whitelisted.
bb6af74ba8b2 Documentation
Heiko Schlittermann <hs@schlittermann.de>
parents: 69
diff changeset
   272
67
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   273
=head1 INTERNALS
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   274
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   275
=head2 Format of the database
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   276
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   277
The record structure is
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   278
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   279
 key:   item\0
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   280
 value: timestamp(creation) timestamp(usage) counter[ flags]\0
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   281
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   282
This way we are compatible with ${lookup{...}dbm{...}}
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   283
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   284
=head1 FILES
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   285
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   286
The database files are placed in C<$spool_directory/grey/>.
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   287
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   288
=head1 SEE ALSO
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   289
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   290
The companion tool L<exigrey> should be used for inspection and manipulation
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   291
of the database.
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   292
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   293
=cut
da29842506b4 Add POD documentation to the Exim::Grey.pm
Heiko Schlittermann <hs@schlittermann.de>
parents: 66
diff changeset
   294
55
ab282b335eb5 Allow autowhitelists
heiko
parents: 52
diff changeset
   295
# vim:aw et sw=4 ts=4: