--- /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
--- 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 <hs@schlittermann.de> Thu, 25 Jan 2007 15:20:59 +0100
+ -- Heiko Schlittermann <heiko@schlittermann.de> Fri, 18 Jan 2008 22:59:36 +0100
exigrey (0.18-1) stable; urgency=low
--- 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:
--- 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;