bin/exigrey
changeset 74 adf33377005c
parent 73 e2559ee78cb3
equal deleted inserted replaced
73:e2559ee78cb3 74:adf33377005c
     1 #!perl
       
     2 # © 2006,2007,2016 Heiko Schlittermann <hs@schlittermann.de>
       
     3 # Quick and dirty. Absolutly no warranty. Not even for spelling ;-)
       
     4 
       
     5 use strict;
       
     6 use warnings;
       
     7 use Getopt::Long;
       
     8 use File::Basename;
       
     9 use File::Temp qw/tmpfile/;
       
    10 use constant ME => basename $0;
       
    11 use FindBin qw/$Bin/;
       
    12 use POSIX qw/strftime mktime/;
       
    13 use if $ENV{DEBUG} => 'Smart::Comments';
       
    14 use Pod::Usage;
       
    15 
       
    16 use Exim::Grey qw(:all);
       
    17 
       
    18 my $VERSION = '$Id$';
       
    19 
       
    20 my $opt_list;
       
    21 my $opt_stats;
       
    22 my $opt_insert;
       
    23 my $opt_help;
       
    24 my $opt_clean;
       
    25 my $opt_purge;
       
    26 my $opt_dbs;
       
    27 my $opt_remove;
       
    28 
       
    29 sub getDBs(@);
       
    30 sub iterate(\%$);
       
    31 
       
    32 MAIN: {
       
    33 
       
    34     GetOptions(
       
    35         'list!'   => \$opt_list,
       
    36         'insert!' => \$opt_insert,
       
    37         'remove!' => \$opt_remove,
       
    38         'stats!'  => \$opt_stats,
       
    39         'clean!'  => \$opt_clean,
       
    40         'purge!'  => \$opt_purge,
       
    41         'dbs!'    => \$opt_dbs,
       
    42         'help!'   => sub { pod2usage(-verbose => 1, -exit => 0) },
       
    43 	'man!'    => sub { pod2usage(-verbose => 2, -exit => 0,
       
    44 	    noperldoc => system('perldoc -V 2>/dev/null >/dev/null')) },
       
    45     ) or pod2usage;
       
    46 
       
    47     if ($opt_list) {
       
    48         foreach (@ARGV = getDBs(@ARGV)) {
       
    49             my %h;
       
    50             my $db = connectDB(\%h, $_);
       
    51             print "# $db\n";
       
    52             iterate(
       
    53                 %h,
       
    54                 sub {
       
    55                     my ($item, $v0, $v1, $c, $flag) = @_;
       
    56                     printf "$item: $v0 $v1 $c (%s %s)%s\n",
       
    57                       strftime("%FT%T", localtime($v0)),
       
    58                       strftime("%FT%T", localtime($v1)),
       
    59                       $flag ? " $flag" : "";
       
    60                 }
       
    61             );
       
    62             print "\n" if @ARGV;
       
    63         }
       
    64         exit 0;
       
    65     }
       
    66 
       
    67     if ($opt_stats) {
       
    68         foreach (@ARGV = getDBs(@ARGV)) {
       
    69             my %h;
       
    70             my $db = connectDB(\%h, $_);
       
    71 
       
    72             my ($seen, $returned, $oldest_c, $oldest_u, $auto);
       
    73             $seen     = $returned = 0;
       
    74             $oldest_c = $oldest_u = time();
       
    75             iterate(
       
    76                 %h,
       
    77                 sub {
       
    78                     my ($item, $v0, $v1, $c, $flags) = @_;
       
    79                     if ($flags // '' eq 'auto') {
       
    80                         ++$auto;
       
    81                         return;
       
    82                     }
       
    83                     ++$seen;
       
    84                     ++$returned if $v0 != $v1;    # soon it can be $c
       
    85                     $oldest_c = $v0 if $v0 < $oldest_c;
       
    86                     $oldest_u = $v1 if $v1 < $oldest_u;
       
    87                     return;
       
    88                 }
       
    89             );
       
    90 
       
    91             $_ = <<__;
       
    92  	     date: %s
       
    93  	       db: $db (ls: %.1f MB / du: %.1f MB)
       
    94  	    total: $seen (100%%)
       
    95          returned: %*d (%3d%%)
       
    96      not returned: %*d (%3d%%)
       
    97 auto white listed: %*d
       
    98  oldest (created): %.1f days (%s)
       
    99     oldest (used): %.1f days (%s)
       
   100 __
       
   101             printf $_, scalar(localtime), (-s $db) / (1024 * 1024),
       
   102               ((stat $db)[12] * 512) / (1024 * 1024),
       
   103               length($seen), $returned,
       
   104               int(0.5 + 100 * ($returned / $seen)),    # returned
       
   105               length($seen), $seen - $returned,
       
   106               int(0.5 + 100 * ($seen - $returned) / $seen),    # not returned
       
   107               length($seen), $auto,                            # auto white
       
   108               ((time - $oldest_c) / 86400), scalar(localtime $oldest_c),
       
   109               ((time - $oldest_u) / 86400), scalar(localtime $oldest_u);
       
   110             print "\n" if @ARGV;
       
   111 
       
   112         }
       
   113         exit 0;
       
   114     }
       
   115 
       
   116     if ($opt_clean or $opt_purge) {
       
   117 
       
   118         my $cut = time() - (86400 * (@ARGV ? shift : 7));
       
   119         foreach (getDBs(@ARGV)) {
       
   120             my %h;
       
   121             my $tmp = tmpfile();
       
   122             my $db = connectDB(\%h, $_);
       
   123             iterate(
       
   124                 %h,
       
   125                 sub {
       
   126                     my ($item, $v0, $v1, $c) = @_;
       
   127                     my $rv = defined $opt_purge ? \$v0 : \$v1;
       
   128                     print $tmp "$item\0" if $$rv <= $cut;
       
   129                 }
       
   130             );
       
   131 
       
   132             seek($tmp, 0, 0) or die "Can't seek tmpfile";
       
   133 
       
   134             $/ = "\0";
       
   135             delete $h{$_} while <$tmp>;
       
   136             printf "$. items %s from $db\n", $opt_purge ? "purged" : "deleted";
       
   137 
       
   138             close($tmp);
       
   139 
       
   140         }
       
   141         exit 0;
       
   142     }
       
   143 
       
   144     if ($opt_dbs) {
       
   145         print join("\n", getDBs(@ARGV)), "\n";
       
   146         exit 0;
       
   147     }
       
   148 
       
   149     if ($opt_insert) {
       
   150         print unseen(@ARGV);
       
   151         exit 0;
       
   152     }
       
   153 
       
   154     if ($opt_remove) {
       
   155         my %default = getDefault();
       
   156         my $item    = shift;
       
   157         my $db      = shift // $default{db};
       
   158 
       
   159         my $key = "$item\0";
       
   160 
       
   161         connectDB(\my %h, $db);
       
   162         if (not exists $h{$key}) {
       
   163             warn "$0: key `$key' not found\n";
       
   164         }
       
   165         else {
       
   166             $_ = $h{$key};      # delete from tied hashes
       
   167             delete $h{$key};    # doesn't return anything always
       
   168             chop;
       
   169             print "$key: $_\n";
       
   170         }
       
   171         exit 0;
       
   172     }
       
   173 }
       
   174 
       
   175 sub getDBs(@) {
       
   176     grep { !/\.lock$/ } grep { -f -s }
       
   177       map { m(^\.?/) ? glob($_) : glob(getDBDir() . "/$_") } @_ ? @_ : "*";
       
   178 }
       
   179 
       
   180 # Helper to iterate over our hash and call the passed
       
   181 # "callback" function (item, v0, v1, count, flags)
       
   182 sub iterate(\%$) {
       
   183     my ($hash, $sub) = @_;
       
   184     while (my ($k, $v) = each %$hash) {
       
   185         chop($k, $v);
       
   186 ### $k
       
   187 ### $v
       
   188         &$sub($k, (split(' ', $v), 0, 0)[0 .. 3]);    # 0 for filling
       
   189     }
       
   190 }
       
   191 
       
   192 __END__
       
   193 
       
   194 =head1 NAME
       
   195 
       
   196  exigrey - command line interface to exim greylist database
       
   197 
       
   198 =head1 SYNOPSIS
       
   199 
       
   200  exigrey --insert item [delay [db]]
       
   201  exigrey --remove item
       
   202  exigrey --list [db]
       
   203  exigrey --stat [db-glob ...]
       
   204  exigrey {--clean|--purge} [days [db-glob ...]]
       
   205  exigrey {--man|--help}
       
   206 
       
   207 =head1 DESCRIPTION
       
   208 
       
   209 B<exigrey> is the command line interface to the greylist implementation
       
   210 for Exim. It may be used to examine, cleanup and manipulate the
       
   211 greylist database.
       
   212 
       
   213 =head1 OPTIONS
       
   214 
       
   215 =over
       
   216 
       
   217 =item B<--insert> I<item> [I<delay> [I<db>]]
       
   218 
       
   219 Insert a new item into the database.
       
   220 
       
   221 =item B<--remove> I<item> [I<db>]
       
   222 
       
   223 Remove the Item I<item> from the database I<db>.
       
   224 
       
   225 =item B<--list> [I<db>]
       
   226 
       
   227 List the complete content of the database I<db>. This
       
   228 may take a while.
       
   229 
       
   230 =item B<--stat> [I<db-glob>]
       
   231 
       
   232 Print the statistics about the databases matching the I<db-glob>
       
   233 pattern.
       
   234 
       
   235 =item B<--clean>|B<--purge> [I<days> [I<db-glob>]...]
       
   236 
       
   237 Clean (unused) items or purge items unconditionally.
       
   238 
       
   239 =item B<--dbs> [I<db-glob>]
       
   240 
       
   241 List the matching database names.
       
   242 
       
   243 =back
       
   244 
       
   245 If a database name starts with F<./> or F</>, it's considered
       
   246 a file name, otherwise it's looked for in F<spool_directory/grey/>.
       
   247 
       
   248 =head1 AUTHOR
       
   249 
       
   250 Heiko Schlittermann L<<hs@schlittermann.de>>
       
   251 
       
   252 =cut
       
   253 
       
   254 # vim:ft=perl aw sts=4 sw=4: