# HG changeset patch # User heiko # Date 1200693595 0 # Node ID 61a2dc11f50b1ec0dc763a95656d6fb4faab1fa6 # Parent 1c2ae71d226b799b251ccc69d3823942f1b1adbc - perltidy - locking diff -r 1c2ae71d226b -r 61a2dc11f50b .perltidyrc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.perltidyrc Fri Jan 18 21:59:55 2008 +0000 @@ -0,0 +1,1 @@ +/home/is/heiko/.perltidyrc \ No newline at end of file diff -r 1c2ae71d226b -r 61a2dc11f50b debian/changelog --- a/debian/changelog Wed Jun 13 06:57:49 2007 +0000 +++ b/debian/changelog Fri Jan 18 21:59:55 2008 +0000 @@ -2,8 +2,9 @@ * new upstream - Locking + * perltidy - -- Heiko Schlittermann Thu, 25 Jan 2007 15:20:59 +0100 + -- Heiko Schlittermann Fri, 18 Jan 2008 22:59:36 +0100 exigrey (0.18-1) stable; urgency=low diff -r 1c2ae71d226b -r 61a2dc11f50b exigrey.pl --- a/exigrey.pl Wed Jun 13 06:57:49 2007 +0000 +++ b/exigrey.pl Fri Jan 18 21:59:55 2008 +0000 @@ -30,8 +30,9 @@ use FindBin qw/$Bin/; use POSIX qw/strftime mktime/; -do "@LIBDIR@/exim-exigrey.pl" - or do "./exim-exigrey.pl" or die $!; +do "@LIBDIR@/exim-exigrey.pl" + or do "./exim-exigrey.pl" + or die $!; my $VERSION = '$Id$'; @@ -49,53 +50,60 @@ MAIN: { GetOptions( - "list!" => \$opt_list, - "insert!" => \$opt_insert, - "stats!" => \$opt_stats, - "clean!" => \$opt_clean, - "purge!" => \$opt_purge, - "dbs!" => \$opt_dbs, - "help!" => \$opt_help, - ) or die ME.": Bad usage, try ".ME." --help.\n"; + "list!" => \$opt_list, + "insert!" => \$opt_insert, + "stats!" => \$opt_stats, + "clean!" => \$opt_clean, + "purge!" => \$opt_purge, + "dbs!" => \$opt_dbs, + "help!" => \$opt_help, + ) or die ME . ": Bad usage, try " . ME . " --help.\n"; if ($opt_help) { - ($_ = USAGE) =~ s/!(.*?)!/eval $1/eg; - print; exit 0; - }; + ($_ = USAGE) =~ s/!(.*?)!/eval $1/eg; + print; + exit 0; + } if ($opt_list) { - foreach (@ARGV = getDBs(@ARGV)) { - my %h; - my $db = connectDB(\%h, $_); - print "# $db\n"; - iterate(%h, sub { - my ($item, $v0, $v1, $c) = @_; - printf "$item: $v0 $v1 $c (%s %s)\n", - strftime("%FT%T", localtime($v0)), - strftime("%FT%T", localtime($v1)); - }); - print "\n" if @ARGV; - } - exit 0; + foreach (@ARGV = getDBs(@ARGV)) { + my %h; + my $db = connectDB(\%h, $_); + print "# $db\n"; + iterate( + %h, + sub { + my ($item, $v0, $v1, $c) = @_; + printf "$item: $v0 $v1 $c (%s %s)\n", + strftime("%FT%T", localtime($v0)), + strftime("%FT%T", localtime($v1)); + } + ); + print "\n" if @ARGV; + } + exit 0; } if ($opt_stats) { - foreach (@ARGV = getDBs(@ARGV)) { - my %h; - my $db = connectDB(\%h, $_); + foreach (@ARGV = getDBs(@ARGV)) { + my %h; + my $db = connectDB(\%h, $_); - my ($seen, $returned, $oldest_c, $oldest_u); - $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 ($seen, $returned, $oldest_c, $oldest_u); + $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; + } + ); - $_ = <<__; + $_ = <<__; date: %s db: $db (ls: %.1f MB / du: %.1f MB) total: $seen (100%%) @@ -104,59 +112,60 @@ 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), - ((time - $oldest_c) / 86400), scalar(localtime $oldest_c), - ((time - $oldest_u) / 86400), scalar(localtime $oldest_u); - print "\n" if @ARGV; + 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), + ((time - $oldest_c) / 86400), scalar(localtime $oldest_c), + ((time - $oldest_u) / 86400), scalar(localtime $oldest_u); + print "\n" if @ARGV; - } - exit 0; + } + 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; - }); + 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"; + 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"; + $/ = "\0"; + delete $h{$_} while <$tmp>; + printf "$. items %s from $db\n", $opt_purge ? "purged" : "deleted"; - close($tmp); + close($tmp); - } - exit 0; + } + exit 0; } if ($opt_dbs) { - print join("\n", getDBs(@ARGV)), "\n"; - exit 0; + print join("\n", getDBs(@ARGV)), "\n"; + exit 0; } if ($opt_insert) { - print unseen(@ARGV); - exit 0; + print unseen(@ARGV); + exit 0; } } sub getDBs(@) { - grep { -f } map { m(^\.?/) ? glob($_) : glob(getDBDir() . "/$_") } @_ ? @_ : "*"; + grep { -f } + map { m(^\.?/) ? glob($_) : glob(getDBDir() . "/$_") } @_ ? @_ : "*"; } # Helper to iterate over our hash and call the passed @@ -164,10 +173,9 @@ sub iterate(\%$) { my ($hash, $sub) = @_; while (my ($k, $v) = each %$hash) { - chop($k, $v); - &$sub($k, (split(" ", $v), 0)[0..2]); # 0 for filling + chop($k, $v); + &$sub($k, (split(" ", $v), 0)[ 0 .. 2 ]); # 0 for filling } } - # vim:ft=perl aw sts=4 sw=4: diff -r 1c2ae71d226b -r 61a2dc11f50b exim-exigrey.pl --- 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;