--- a/exigrey.pl Tue May 24 16:33:08 2016 +0200
+++ b/exigrey.pl Tue May 24 17:24:04 2016 +0200
@@ -76,10 +76,11 @@
iterate(
%h,
sub {
- my ($item, $v0, $v1, $c) = @_;
- printf "$item: $v0 $v1 $c (%s %s)\n",
+ my ($item, $v0, $v1, $c, $flag) = @_;
+ printf "$item: $v0 $v1 $c (%s %s)%s\n",
strftime("%FT%T", localtime($v0)),
- strftime("%FT%T", localtime($v1));
+ strftime("%FT%T", localtime($v1)),
+ $flag ? " $flag" : "";
}
);
print "\n" if @ARGV;
@@ -92,33 +93,40 @@
my %h;
my $db = connectDB(\%h, $_);
- my ($seen, $returned, $oldest_c, $oldest_u);
+ my ($seen, $returned, $oldest_c, $oldest_u, $auto);
$seen = $returned = 0;
$oldest_c = $oldest_u = time();
iterate(
%h,
sub {
- my ($item, $v0, $v1, $c) = @_;
- ++$seen;
- ++$returned if $v0 != $v1; # soon it can be $c
- $oldest_c = $v0 if $v0 < $oldest_c;
- $oldest_u = $v1 if $v1 < $oldest_u;
+ my ($item, $v0, $v1, $c, $flags) = @_;
+ if ($flags//'' eq 'auto') {
+ ++$auto;
+ return;
+ }
+ ++$seen;
+ ++$returned if $v0 != $v1; # soon it can be $c
+ $oldest_c = $v0 if $v0 < $oldest_c;
+ $oldest_u = $v1 if $v1 < $oldest_u;
+ return;
}
);
$_ = <<__;
- date: %s
- db: $db (ls: %.1f MB / du: %.1f MB)
- total: $seen (100%%)
- returned: %*d (%3d%%)
- not returned: %*d (%3d%%)
-oldest (created): %.1f days (%s)
- oldest (used): %.1f days (%s)
+ date: %s
+ db: $db (ls: %.1f MB / du: %.1f MB)
+ total: $seen (100%%)
+ returned: %*d (%3d%%)
+ not returned: %*d (%3d%%)
+auto white listed: %*d
+ oldest (created): %.1f days (%s)
+ oldest (used): %.1f days (%s)
__
printf $_, scalar(localtime), (-s $db) / (1024 * 1024),
- ((stat $db)[12] * 512) / (1024 * 1024), length($seen), $returned,
- int(0.5 + 100 * ($returned / $seen)), length($seen),
- $seen - $returned, int(0.5 + 100 * ($seen - $returned) / $seen),
+ ((stat $db)[12] * 512) / (1024 * 1024),
+ length($seen), $returned, int(0.5 + 100 * ($returned / $seen)), # returned
+ length($seen), $seen - $returned, int(0.5 + 100 * ($seen - $returned) / $seen), # not returned
+ length($seen), $auto, # auto white
((time - $oldest_c) / 86400), scalar(localtime $oldest_c),
((time - $oldest_u) / 86400), scalar(localtime $oldest_u);
print "\n" if @ARGV;
@@ -177,8 +185,9 @@
warn "$0: not found\n";
}
else {
- $_ = delete $h{$key};
+ $_ = $h{$key};
s/\0$/\n/;
+ delete $h{$key};
print;
}
exit 0;
@@ -191,12 +200,12 @@
}
# Helper to iterate over our hash and call the passed
-# "callback" function (item, v0, v1, count)
+# "callback" function (item, v0, v1, count, flags)
sub iterate(\%$) {
my ($hash, $sub) = @_;
while (my ($k, $v) = each %$hash) {
chop($k, $v);
- &$sub($k, (split(" ", $v), 0)[ 0 .. 2 ]); # 0 for filling
+ &$sub($k, (split(' ', $v), 0, 0)[ 0 .. 3 ]); # 0 for filling
}
}
--- a/exim-exigrey.pl Tue May 24 16:33:08 2016 +0200
+++ b/exim-exigrey.pl Tue May 24 17:24:04 2016 +0200
@@ -43,7 +43,7 @@
# defer condition = ${perl{unseen}{<$sender_address>:<$local_part@$domain>/$sender_host_address}}
#
# record structure: key: item\0
-# value: timestamp(creation) timestamp(usage)\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
@@ -103,7 +103,7 @@
sub whitelist {
my ($item, $h) = @_;
my $now = time;
- $h->{"$item\0"} = "$now $now 1\0";
+ $h->{"$item\0"} = "$now $now 1 auto\0";
}
sub is_whitelisted {
@@ -112,8 +112,8 @@
return 0 if not exists $h->{$key};
- my ($t0, undef, $cnt) = split ' ', $h->{$key};
- $h->{$key} = join(' ' => $t0, time, ++$cnt) . "\0";
+ my ($t0, undef, $cnt, $flag) = split ' ', $h->{$key};
+ $h->{$key} = join(' ' => $t0, time, ++$cnt, $flag ? $flag : ()) . "\0";
return 1;
}