# HG changeset patch # User heiko # Date 1167841399 0 # Node ID 7d2c9f3186f4aeb38e4d11c56a5fc7fde2e518fc # Parent 0ad61ee598891195160e5e8f674a3c4e433a17a6 wildcard behaviour cleaned diff -r 0ad61ee59889 -r 7d2c9f3186f4 exigrey.pl --- a/exigrey.pl Wed Jan 03 12:06:41 2007 +0000 +++ b/exigrey.pl Wed Jan 03 16:23:19 2007 +0000 @@ -8,14 +8,17 @@ Usage: !ME! --insert item [delay [db]] # insert an item !ME! --list [db] # list all items - !ME! --stat [db ...] # print short statistic - !ME! --clean [days [db ...]] # remove items not used since days - !ME! --purge [days [db ...]] # remove items older than days - !ME! --dbs [glob] # list dbm files in default directory + !ME! --stat [db* ...] # print short statistic + !ME! --clean [days [db* ...]] # remove items not used since days + !ME! --purge [days [db* ...]] # remove items older than days + !ME! --dbs [db* ...] # list data base(s) - Defaults: delay: !$DEFAULT{delay}! - db: !$DEFAULT{db}! - days: !$DEFAULT{days}! + db -- single name of database + db* -- glob pattern of database + + If the data base name doesn't doesn't start with "./" or "/" + it is considered to be realtiv to exim_spool_dir/grey/. + # use strict; @@ -30,9 +33,6 @@ do "@LIBDIR@/exigrey.pl" or do "./exim-exigrey.pl" or die $!; -my %DEFAULT = getDefault(); - $DEFAULT{days} = 7; - my $opt_list; my $opt_stats; my $opt_insert; @@ -41,7 +41,7 @@ my $opt_purge; my $opt_dbs; -sub getDBs($); +sub getDBs(@); sub iterate(\%$); MAIN: { @@ -64,7 +64,7 @@ if ($opt_list) { my %h; - connectDB(\%h, shift || $DEFAULT{db}); + connectDB(\%h, shift); iterate(%h, sub { my ($item, $v0, $v1, $dv) = @_; printf "%-16s:\t$v0 $v1 (%3ds %s %s)\n", @@ -76,9 +76,7 @@ } if ($opt_stats) { - @ARGV = ($DEFAULT{db}) unless @ARGV; - @ARGV = getDBs($ARGV[0]) if $ARGV[0] =~ /[\*\?]/; - foreach (@ARGV) { + foreach (@ARGV = getDBs(@ARGV)) { my %h; my $db = connectDB(\%h, $_); @@ -117,11 +115,7 @@ if ($opt_clean or $opt_purge) { my $cut = time() - (86400 * (@ARGV ? shift : 7)); - - @ARGV = ($DEFAULT{db}) unless @ARGV; - @ARGV = getDBs($ARGV[0]) if $ARGV[0] =~ /[\*\?]/; - - foreach (@ARGV ? @ARGV : $DEFAULT{db}) { + foreach (getDBs(@ARGV)) { my %h; my $tmp = tmpfile(); my $db = connectDB(\%h, $_); @@ -145,7 +139,7 @@ } if ($opt_dbs) { - print join("\n", getDBs(shift || "*")), "\n"; + print join("\n", getDBs(@ARGV)), "\n"; exit 0; } @@ -155,8 +149,8 @@ } } -sub getDBs($) { - glob(getDBDir() . "/$_[0]"); +sub getDBs(@) { + grep { -f } map { m(^\.?/) ? glob($_) : glob(getDBDir() . "/$_") } @_ ? @_ : "*"; } # Helper to iterate over our hash and call the passed diff -r 0ad61ee59889 -r 7d2c9f3186f4 exim-exigrey.pl --- a/exim-exigrey.pl Wed Jan 03 12:06:41 2007 +0000 +++ b/exim-exigrey.pl Wed Jan 03 16:23:19 2007 +0000 @@ -35,6 +35,9 @@ # record structure: key: item\0 # value: timestamp(creation) timestamp(usage)\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, $delay, $db) = @_; $item .= "\0"; @@ -45,7 +48,7 @@ my $rc; my %h; - $db = connectDB(\%h, $db || $DEFAULT{db}); + $db = connectDB(\%h, $db); if (not exists $h{$item}) { $h{$item} = "$now $now\0"; @@ -97,7 +100,7 @@ sub connectDB($$) { my ($h, $db) = @_; - $db = getDBDir() ."/$db" unless $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