--- a/exim-exigrey.pl Tue May 24 17:24:04 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,202 +0,0 @@
-# © 2006,2007,2008 Heiko Schlittermann <hs@schlittermann.de>
-# $Id$
-# $URL$
-
-use strict;
-use warnings;
-use Carp;
-
-# You may choose, but DB_File's footprint is smaller.
-# perl -MDB_File -e 'tie %h, ...': real 0m0.063s
-# perl -MBerkeleyDB -e 'tie %h, ...': real 0m0.112s
-# And DB_File is part of the Perl core distribution (?)
-# use BerkeleyDB;
-# use DB_File;
-# But we need locking! DB_File::Lock isn't part of the corelist.
-use DB_File::Lock;
-
-my %DEFAULT = (
- delay => 600,
- db => "seen",
-);
-
-sub unseen;
-
-# some helper functions
-sub getDBDir();
-sub findExim(;$);
-sub connectDB($$);
-sub getDefault() { %DEFAULT }
-
-# Usage:
-# ${perl{unseen}{KEY}}
-# ${perl{unseen}{KEY}{600}}
-# ${perl{unseen}{KEY}{600}{seen}}
-# ${perl{unseen}{KEY}{600}{$spool_directory/grey/seen}}
-#
-# With KEY being something to identify the second delivery attempt
-# I recommend using <$sender_address>:<$local_part@$domain>
-#
-# If KEY has a /... suffix, this suffix is used for auto-whitelisting.
-# I recommend using $sender_host_address.
-#
-# defer condition = ${perl{unseen}{<$sender_address>:<$local_part@$domain>/$sender_host_address}}
-#
-# record structure: key: item\0
-# value: timestamp(creation) timestamp(usage)[ auto]\0
-# (This way we're compatible with ${lookup{...}dbm{...}})
-#
-# dbm file is relativ to $spool_directory/grey, EXCEPT its name
-# starts with "./" or "/".
-
-sub unseen {
- my $item = shift;
- my $delay = shift // $DEFAULT{delay};
- my $db = shift // $DEFAULT{db};
- my $now = time();
- my ($auto) = $item =~ /.*?\/(.+?)$/;
- my $rc;
-
- connectDB(\my %h, $db);
-
- return 'no' # not unseen, ergo known
- if defined $auto and is_whitelisted($auto, \%h);
-
- my $key = "$item\0";
-
- # we do not know anything about the client -> unknown
- if (not exists $h{$key}) {
- $h{$key} = "$now $now 0\0";
- return 'yes';
- }
-
- my ($created, undef, $count) = split ' ', $h{$key};
-
- # we know the client, but last contact was recently (too fast)
- if ($now - $created < $delay) {
- return 'yes';
- }
-
- # we know the client, was patiently enough
- ++$count;
- $h{$key} = "$created $now $count\0";
- whitelist($auto, \%h) if defined $auto;
- return 'no';
-}
-
-# According to a thought from "David Woodhouse <dwmw2@infradead.org>"
-# on exim-users@exim.org (Thu, 08 May 2008 13:10:21 +0100,
-# Message-Id: <1210248621.25560.1088.camel@pmac.infradead.org>) we
-# should have the ability to "auto whitelist" hosts which are known
-# for retries, because there is no benefit in greylisting them.
-#
-# Most safe approach would be something based on message id.
-# If we see the message id a second time it indicates successful retry.
-# But we do not see the message id the first time we reject the message.
-
-# This function has to be called twice per message delivery attempt
-# <KEY> <$sender_host_address> <$sender_helo_name>
-# (Where <KEY> is something like <$sender_address>+<$local_part@$domain>
-# If we see the same message a second time (same message means here:
-# same greylist criteria
-
-sub whitelist {
- my ($item, $h) = @_;
- my $now = time;
- $h->{"$item\0"} = "$now $now 1 auto\0";
-}
-
-sub is_whitelisted {
- my ($item, $h) = @_;
- my $key = "$item\0";
-
- return 0 if not exists $h->{$key};
-
- my ($t0, undef, $cnt, $flag) = split ' ', $h->{$key};
- $h->{$key} = join(' ' => $t0, time, ++$cnt, $flag ? $flag : ()) . "\0";
-
- return 1;
-}
-
-# Get the directory where we could store the database file(s)
-# If we're running under exim it's easy, otherwise we've to find exim
-# and then ask...
-sub getDBDir() {
- my ($spooldir, $dbdir);
- eval { $spooldir = Exim::expand_string('$spool_directory') };
- if (not defined $spooldir) {
- my $exim = findExim();
- chomp($spooldir = `$exim -be '\$spool_directory'`);
- die "Can't find spooldir" if not defined $spooldir;
- }
- -d ($dbdir = "$spooldir/grey") and return $dbdir;
-
- my ($mode, $owner, $group) = (stat $spooldir)[ 2, 4, 5 ];
- {
- local $) = $group;
- local $> = $owner;
- $mode &= 0777;
- mkdir $dbdir, $mode or die "Can't create $dbdir: $!";
- }
- return $dbdir;
-}
-
-sub findExim(;$) {
- my $path = shift || $ENV{PATH};
- my $exim;
- foreach (split /:/, $ENV{PATH}) {
- -x ($exim = "$_/exim") and return $exim;
- -x ($exim = "$_/exim4") and return $exim;
- }
- die "Can't find exim binary (missing .../sbin dirs in PATH?";
-}
-
-sub connectDB($$) {
- my ($h, $db) = @_;
- $db = getDBDir() . "/$db" unless $db =~ m(^\.?/);
-
- # Creation of DB-File if it doesn't exist
- # to avoid races we change our own uid/gid for creation of
- # this file.
- if (!-f $db) {
- (my $dir = $db) =~ s/^(.*)\/.*?$/$1/;
-
- # copy mode, uid, gid from the directory
- my ($mode, $user, $group) = (stat $dir)[ 2, 4, 5 ]
- or die "Can't stat $dir: $!";
- my $umask = umask(($mode & 0777) ^ 0777);
- local $) = $group;
- local $> = $user;
- open(X, ">>$db") or die "Can't create $db: $!";
- close(X);
- umask $umask;
- }
-
- # now test which of the DB-Modules has been loaded
-
- if (exists &BerkeleyDB::Hash::TIEHASH) {
- no strict;
- my $umask = umask 077;
- tie %$h, "BerkeleyDB::Hash", -Filename => $db
- or die "$0: $db: $!";
- return $db;
- }
-
- if (exists &DB_File::Lock::TIEHASH) {
- tie %$h, 'DB_File::Lock', [ $db ], 'write'
- or die "$0: $db: $!";
- return $db;
- }
-
- if (exists &DB_File::TIEHASH) {
- tie %$h, 'DB_File', $db or die "$0: $db: $!";
- warn "$0: using DB_File, no locking is possible!\n";
- return $db;
- }
-
- die "Can't connect to database driver";
-}
-
-1;
-
-# vim:aw et sw=4 ts=4: