# HG changeset patch
# User heiko
# Date 1167596206 0
# Node ID 6603c56acc924396fc91a7ec1347090706e53ac8
# Parent  4e7411db8f9e17eb97c749c4aabbc413d39b8baf
first attempt

diff -r 4e7411db8f9e -r 6603c56acc92 exigrey
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/exigrey	Sun Dec 31 20:16:46 2006 +0000
@@ -0,0 +1,107 @@
+#! /usr/bin/perl
+# © 2006,2007 Heiko Schlittermann <hs@schlittermann.de>
+# Quick and dirty. Absolutly no warranty. Not even for spelling ;-)
+# $Id$
+# $URL$
+
+use constant USAGE => <<'#';
+
+Usage: !ME! item [delay [db]]
+       !ME! --list [db]
+       !ME! --stat [db]
+       !ME! --clean [days [db]]
+
+       Defaults: delay: !$DEFAULT{delay}!
+		 db:    !$DEFAULT{db}!
+		 days:	!$DEFAULT{days}!
+#
+
+use strict;
+use warnings;
+use Getopt::Long;
+use File::Basename;
+use constant ME => basename $0;
+use FindBin qw/$Bin/;
+use POSIX qw/strftime mktime/;
+
+do "$Bin/greylist.pl" or die;
+my %DEFAULT = getDefault();
+   $DEFAULT{days} = 7;
+
+my $opt_list;
+my $opt_stats;
+my $opt_help;
+
+sub iterate(\%$);
+
+MAIN: {
+
+    GetOptions(
+	"list!" => \$opt_list,
+	"stats!" => \$opt_stats,
+	"help!" => \$opt_help
+    ) or die ME.": Bad usage, try ".ME." --help.\n";
+
+    if ($opt_help) {
+	($_ = USAGE) =~ s/!(.*?)!/eval $1/eg;
+	print; exit 0;
+    };
+
+    my $db = shift || $DEFAULT{db};
+    $db = getDBDir() ."/$db" unless $db =~ /^\//;
+
+    my %h; tie %h, "BerkeleyDB::Hash", -Filename => $db or die;
+
+    if ($opt_list) {
+	iterate(%h, sub {
+	    my ($item, $v0, $v1, $dv) = @_;
+	    printf "%-16s:\t$v0 $v1 (%3ds %s %s)\n", 
+		    $item, $dv, 
+		    strftime("%F %T", localtime($v0)), 
+		    strftime("%F %T", localtime($v1));
+	});
+	exit 0;
+    }
+
+    if ($opt_stats) {
+	my ($seen, $returned, $oldest);
+	$oldest = time();
+	iterate(%h, sub {
+	    my ($item, $v0, $v1, $dv) = @_;
+	    ++$seen;
+	    ++$returned if $dv;
+	    $oldest = $v0 if $v0 < $oldest;
+	});
+
+	$_ = <<__;
+        date: %s
+          db: $db
+       total: $seen
+not returned: %d (%d%%)
+      oldest: %.1f days (%s)
+__
+	printf $_, 
+		scalar(localtime), 
+		$seen - $returned, 
+		int(100 * ($seen-$returned)/$seen), 
+		((time - $oldest) / 86400), scalar(localtime $oldest);
+
+	exit 0;
+    }
+
+    print unseen(@ARGV, 10) . "\n";
+}
+
+# Helper to iterate over our hash and call the passed
+# "callback" function (item, v0, v1, delta)
+sub iterate(\%$) {
+    my ($hash, $sub) = @_;
+    while (my ($k, $v) = each %$hash) {
+	chop($k, $v);
+	my ($v0, $v1) = split " ", $v;
+	my $dv = $v1 - $v0;
+	&$sub($k, $v0, $v1, $dv);
+    }
+}
+
+# vim:ft=perl aw sts=4 sw=4:
diff -r 4e7411db8f9e -r 6603c56acc92 greylist.pl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/greylist.pl	Sun Dec 31 20:16:46 2006 +0000
@@ -0,0 +1,90 @@
+# © 2006,2007 Heiko Schlittermann <hs@schlittermann.de>
+# $Id$
+# $URL$
+
+use strict;
+use warnings;
+use BerkeleyDB;
+
+my %DEFAULT = (
+	delay => 600,
+	db => "seen.db",
+);
+
+sub unseen($;$$);
+
+sub getDBDir();
+sub findExim();
+sub getDefault() { %DEFAULT };
+
+# Usage:
+# 	${perl{unseen}{$sender_host_address}}
+# 	${perl{unseen}{$sender_host_address}{600}}
+# 	${perl{unseen}{$sender_host_address}{600}{seen.db}}
+# 	${perl{unseen}{$sender_host_address}{600}{/some/dir/seen.db}}
+#
+# record structure: item\0 timestamp(creation)\0 timestamp(usage)\0
+# (This way we're compatible with ${lookup{...}dbm{...}}
+sub unseen($;$$) {
+	my ($item, $delay, $db) = @_;
+		$item .= "\0";
+		$delay = $DEFAULT{delay} unless defined $delay;
+		$db = $DEFAULT{db} unless defined $db;
+
+	my $now = time();
+	my $umask;
+	my $rc;
+
+	$db = getDBDir() . "/$db" unless $db =~ /^\//;
+
+	$umask = umask 0077 if !-f $db;
+
+	my %h; tie %h, "BerkeleyDB::Hash", 
+		-Filename => $db,
+		-Flags => DB_CREATE
+	or die;
+
+	umask $umask if defined $umask;
+
+	if (not exists $h{$item}) {
+		$h{$item} = "$now $now\0";
+		$rc = "yes";
+	} else {
+		my $created = (split " ", $h{$item})[0];
+		if ($now - $created < $delay) { $rc = "yes" }
+		else { 
+			$rc = "no";
+			$h{$item} = "$created $now\0";
+		}
+	}
+	untie %h;
+	return $rc;
+}
+
+# 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;
+	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;
+	}
+	return "$spooldir/db";
+}
+
+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;
+	}
+	return undef;
+}
+
+1;
+
+# vim:aw: