--- a/exim-exigrey.pl Wed Jun 13 06:57:49 2007 +0000
+++ b/exim-exigrey.pl Fri Jan 18 21:59:55 2008 +0000
@@ -14,9 +14,10 @@
# use BerkeleyDB;
use DB_File;
-my %DEFAULT = (delay => 600,
- db => "seen",
- white => "white",
+my %DEFAULT = (
+ delay => 600,
+ db => "seen",
+ white => "white",
);
sub unseen($;$$);
@@ -42,125 +43,125 @@
# starts with "./" or "/".
#
sub unseen($;$$) {
- my ($item, $delay, $db) = @_;
- $item .= "\0";
- $delay = $DEFAULT{delay} unless defined $delay;
- $db = $DEFAULT{db} unless defined $db;
+ my ($item, $delay, $db) = @_;
+ $item .= "\0";
+ $delay = $DEFAULT{delay} unless defined $delay;
+ $db = $DEFAULT{db} unless defined $db;
- my $now = time();
- my $rc;
+ my $now = time();
+ my $rc;
- my %h;
- $db = connectDB(\%h, $db);
+ my %h;
+ $db = connectDB(\%h, $db);
- if (not exists $h{$item}) {
- $h{$item} = "$now $now 0\0";
- $rc = "yes";
- }
- else {
- ($_ = $h{$item}) =~ s/\0*$//; # we're \0 terminated
- my ($created, $used, $count) = split;
- if ($now - $created < $delay) { $rc = "yes" }
- else {
- $rc = "no";
- ++$count;
- $h{$item} = "$created $now $count\0";
- }
- }
- untie %h;
- disconnectDB();
- return $rc;
+ if (not exists $h{$item}) {
+ $h{$item} = "$now $now 0\0";
+ $rc = "yes";
+ }
+ else {
+ ($_ = $h{$item}) =~ s/\0*$//; # we're \0 terminated
+ my ($created, $used, $count) = split;
+ if ($now - $created < $delay) { $rc = "yes" }
+ else {
+ $rc = "no";
+ ++$count;
+ $h{$item} = "$created $now $count\0";
+ }
+ }
+ untie %h;
+ disconnectDB();
+ return $rc;
}
sub white($;$) {
- unseen($_[0], 0, defined $_[1] ? $_[1] : $DEFAULT{white});
- return "yes";
+ unseen($_[0], 0, defined $_[1] ? $_[1] : $DEFAULT{white});
+ return "yes";
}
# 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 ($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;
+ 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?";
+ 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?";
}
{
- my $fh;
+ my $fh;
- sub connectDB($$) {
- my ($h, $db) = @_;
- $db = getDBDir() . "/$db" unless $db =~ m(^\.?/);
+ 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/;
+ # 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;
- }
+ # 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;
+ }
- # We try to open and lock the database file to avoid
- # a race.
- open($fh, $db) or die "Can't open $db: $!";
- flock($fh, LOCK_EX) or die "Can't lock $db: $!";
+ # We try to open and lock the database file to avoid
+ # a race.
+ open($fh, $db) or die "Can't open $db: $!";
+ flock($fh, LOCK_EX) or die "Can't lock $db: $!";
- # now test which of the DB-Modules has been loaded
+ # 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 &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::TIEHASH) {
- tie %$h, "DB_File", $db
- or die "$0: $db: $!";
- return $db;
- }
+ if (exists &DB_File::TIEHASH) {
+ tie %$h, "DB_File", $db
+ or die "$0: $db: $!";
+ return $db;
+ }
- die "Can't connect to database driver";
- }
+ die "Can't connect to database driver";
+ }
- sub disconnectDB() {
- close($fh);
- }
+ sub disconnectDB() {
+ close($fh);
+ }
}
0;