bin/exigrey
changeset 74 adf33377005c
parent 73 e2559ee78cb3
--- a/bin/exigrey	Wed Jun 21 00:26:46 2017 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,254 +0,0 @@
-#!perl
-# © 2006,2007,2016 Heiko Schlittermann <hs@schlittermann.de>
-# Quick and dirty. Absolutly no warranty. Not even for spelling ;-)
-
-use strict;
-use warnings;
-use Getopt::Long;
-use File::Basename;
-use File::Temp qw/tmpfile/;
-use constant ME => basename $0;
-use FindBin qw/$Bin/;
-use POSIX qw/strftime mktime/;
-use if $ENV{DEBUG} => 'Smart::Comments';
-use Pod::Usage;
-
-use Exim::Grey qw(:all);
-
-my $VERSION = '$Id$';
-
-my $opt_list;
-my $opt_stats;
-my $opt_insert;
-my $opt_help;
-my $opt_clean;
-my $opt_purge;
-my $opt_dbs;
-my $opt_remove;
-
-sub getDBs(@);
-sub iterate(\%$);
-
-MAIN: {
-
-    GetOptions(
-        'list!'   => \$opt_list,
-        'insert!' => \$opt_insert,
-        'remove!' => \$opt_remove,
-        'stats!'  => \$opt_stats,
-        'clean!'  => \$opt_clean,
-        'purge!'  => \$opt_purge,
-        'dbs!'    => \$opt_dbs,
-        'help!'   => sub { pod2usage(-verbose => 1, -exit => 0) },
-	'man!'    => sub { pod2usage(-verbose => 2, -exit => 0,
-	    noperldoc => system('perldoc -V 2>/dev/null >/dev/null')) },
-    ) or pod2usage;
-
-    if ($opt_list) {
-        foreach (@ARGV = getDBs(@ARGV)) {
-            my %h;
-            my $db = connectDB(\%h, $_);
-            print "# $db\n";
-            iterate(
-                %h,
-                sub {
-                    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)),
-                      $flag ? " $flag" : "";
-                }
-            );
-            print "\n" if @ARGV;
-        }
-        exit 0;
-    }
-
-    if ($opt_stats) {
-        foreach (@ARGV = getDBs(@ARGV)) {
-            my %h;
-            my $db = connectDB(\%h, $_);
-
-            my ($seen, $returned, $oldest_c, $oldest_u, $auto);
-            $seen     = $returned = 0;
-            $oldest_c = $oldest_u = time();
-            iterate(
-                %h,
-                sub {
-                    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%%)
-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)),    # 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;
-
-        }
-        exit 0;
-    }
-
-    if ($opt_clean or $opt_purge) {
-
-        my $cut = time() - (86400 * (@ARGV ? shift : 7));
-        foreach (getDBs(@ARGV)) {
-            my %h;
-            my $tmp = tmpfile();
-            my $db = connectDB(\%h, $_);
-            iterate(
-                %h,
-                sub {
-                    my ($item, $v0, $v1, $c) = @_;
-                    my $rv = defined $opt_purge ? \$v0 : \$v1;
-                    print $tmp "$item\0" if $$rv <= $cut;
-                }
-            );
-
-            seek($tmp, 0, 0) or die "Can't seek tmpfile";
-
-            $/ = "\0";
-            delete $h{$_} while <$tmp>;
-            printf "$. items %s from $db\n", $opt_purge ? "purged" : "deleted";
-
-            close($tmp);
-
-        }
-        exit 0;
-    }
-
-    if ($opt_dbs) {
-        print join("\n", getDBs(@ARGV)), "\n";
-        exit 0;
-    }
-
-    if ($opt_insert) {
-        print unseen(@ARGV);
-        exit 0;
-    }
-
-    if ($opt_remove) {
-        my %default = getDefault();
-        my $item    = shift;
-        my $db      = shift // $default{db};
-
-        my $key = "$item\0";
-
-        connectDB(\my %h, $db);
-        if (not exists $h{$key}) {
-            warn "$0: key `$key' not found\n";
-        }
-        else {
-            $_ = $h{$key};      # delete from tied hashes
-            delete $h{$key};    # doesn't return anything always
-            chop;
-            print "$key: $_\n";
-        }
-        exit 0;
-    }
-}
-
-sub getDBs(@) {
-    grep { !/\.lock$/ } grep { -f -s }
-      map { m(^\.?/) ? glob($_) : glob(getDBDir() . "/$_") } @_ ? @_ : "*";
-}
-
-# Helper to iterate over our hash and call the passed
-# "callback" function (item, v0, v1, count, flags)
-sub iterate(\%$) {
-    my ($hash, $sub) = @_;
-    while (my ($k, $v) = each %$hash) {
-        chop($k, $v);
-### $k
-### $v
-        &$sub($k, (split(' ', $v), 0, 0)[0 .. 3]);    # 0 for filling
-    }
-}
-
-__END__
-
-=head1 NAME
-
- exigrey - command line interface to exim greylist database
-
-=head1 SYNOPSIS
-
- exigrey --insert item [delay [db]]
- exigrey --remove item
- exigrey --list [db]
- exigrey --stat [db-glob ...]
- exigrey {--clean|--purge} [days [db-glob ...]]
- exigrey {--man|--help}
-
-=head1 DESCRIPTION
-
-B<exigrey> is the command line interface to the greylist implementation
-for Exim. It may be used to examine, cleanup and manipulate the
-greylist database.
-
-=head1 OPTIONS
-
-=over
-
-=item B<--insert> I<item> [I<delay> [I<db>]]
-
-Insert a new item into the database.
-
-=item B<--remove> I<item> [I<db>]
-
-Remove the Item I<item> from the database I<db>.
-
-=item B<--list> [I<db>]
-
-List the complete content of the database I<db>. This
-may take a while.
-
-=item B<--stat> [I<db-glob>]
-
-Print the statistics about the databases matching the I<db-glob>
-pattern.
-
-=item B<--clean>|B<--purge> [I<days> [I<db-glob>]...]
-
-Clean (unused) items or purge items unconditionally.
-
-=item B<--dbs> [I<db-glob>]
-
-List the matching database names.
-
-=back
-
-If a database name starts with F<./> or F</>, it's considered
-a file name, otherwise it's looked for in F<spool_directory/grey/>.
-
-=head1 AUTHOR
-
-Heiko Schlittermann L<<hs@schlittermann.de>>
-
-=cut
-
-# vim:ft=perl aw sts=4 sw=4: