# HG changeset patch
# User Heiko Schlittermann <hs@schlittermann.de>
# Date 1465074329 -7200
# Node ID f095f28db247c15976232d80e806aefa135fe679
# Parent  46ba051d29bdf95bdbbfd90a779db04ca39fb00b
Implement auto-history

diff -r 46ba051d29bd -r f095f28db247 lib/Exim/Grey.pm
--- a/lib/Exim/Grey.pm	Sat Jun 04 22:08:13 2016 +0200
+++ b/lib/Exim/Grey.pm	Sat Jun 04 23:05:29 2016 +0200
@@ -52,11 +52,13 @@
 
     # we do not know anything about the client -> unknown
     if (not exists $h{$key}) {
-        $h{$key} = "$now $now 0\0";
+        $h{$key} = "$now $now 0"
+            . (defined $auto ? " auto=$auto" : '')
+            . "\0";
         return 'yes';
     }
 
-    my ($created, undef, $count) = split /[ \0]/, $h{$key};
+    my ($created, undef, $count, $flags) = split /[ \0]/, $h{$key};
 
     # we know the client, but last contact was recently (too fast)
     if ($now - $created < $delay) {
@@ -66,7 +68,7 @@
     # we know the client, was patiently enough
     ++$count;
     $h{$key} = "$created $now $count\0";
-    whitelist($auto, \%h) if defined $auto;
+    whitelist(\%h, $auto, $flags =~ /auto=(\S+)/) if defined $auto;
     return 'no';
 }
 
@@ -91,9 +93,15 @@
 # same greylist criteria
 
 sub whitelist {
-    my ($item, $h) = @_;
+    my ($h, @items) = @_;
     my $now = time;
-    $h->{"$item\0"} = "$now $now 1 auto\0";
+    $h->{"$_\0"} = "$now $now 1 auto\0"
+        foreach uniq(@items);
+}
+
+sub uniq {
+    my %h = map { $_, undef } @_;
+    return keys %h;
 }
 
 sub is_whitelisted {
diff -r 46ba051d29bd -r f095f28db247 t/00-basic.t
--- a/t/00-basic.t	Sat Jun 04 22:08:13 2016 +0200
+++ b/t/00-basic.t	Sat Jun 04 23:05:29 2016 +0200
@@ -6,19 +6,33 @@
 
 use_ok 'Exim::Grey' => qw(unseen seen) or BAIL_OUT;
 
-my $db = File::Temp->new();
+subtest 'simple' => sub {
+    my $db = File::Temp->new();
+    is seen('a->x', 0, "$db"), 'no' => 'not seen a->x';
+    is unseen('a->b', 0,   "$db"), 'yes' => 'unseen a->b';
+    is unseen('a->b', 600, "$db"), 'yes' => 'unseen a->b with 600s delay';
+    is unseen('a->b', 0,   "$db"), 'no'  => 'not unseen a->b';
+    is seen('a->b', 600, "$db"), 'no' => 'not seen a->b with 600s delay';
+};
 
-is seen('a->x', 1, "$db"), 'no' => 'not seen a->x';
-is unseen('a->b', 1, "$db"), 'yes' => 'unseen a->b';
-is unseen('a->b', 1, "$db"), 'yes' => 'unseen a->b';
+subtest 'whitelist' => sub {
+    my $db = File::Temp->new();
+    is unseen('x->y/1.1.1.1', 1, "$db"), 'yes' => 'unseen x->y/1.1.1.1';
+    is unseen('x->y/1.1.1.1', 1, "$db"), 'yes' => 'unseen x->y/1.1.1.1';
 
-is unseen('x->y/1.1.1.1', 1, "$db"), 'yes' => 'unseen x->y/1.1.1.1';
-is unseen('x->y/1.1.1.1', 1, "$db"), 'yes' => 'unseen x->y/1.1.1.1';
+    is unseen('x->y/1.1.1.1', 0, "$db"), 'no' => 'not unseen x->y/1.1.1.1';
+    is unseen('x->z/1.1.1.1', 0, "$db"), 'no' => 'not unseen x->z/1.1.1.1';
+    is seen('x->z/1.1.1.1', 0, "$db"), 'yes' => 'seen x->z/1.1.1.1';
+
+};
 
-is unseen('a->b',         0, "$db"), 'no' => 'not unseen a->b';
-is unseen('x->y/1.1.1.1', 0, "$db"), 'no' => 'not unseen x->y/1.1.1.1';
-is unseen('x->z/1.1.1.1', 0, "$db"), 'no' => 'not unseen x->z/1.1.1.1';
-is seen('x->z/1.1.1.1', 0, "$db"), 'yes' => 'seen x->z/1.1.1.1';
+subtest 'whitelist multiple subkeys' => sub {
+    my $db = File::Temp->new();
 
-is unseen('a->b', 600, "$db"), 'yes' => 'unseen a->b with 600s delay';
-is seen('a->b', 600, "$db"), 'no' => 'not seen a->b with 600s delay';
+    is unseen('x->y/1.1.1.1', 0, "$db"), 'yes' => 'unseen x->y/1.1.1.1';
+    is unseen('x->y/2.2.2.2', 0, "$db"), 'no' => 'not unseen x->y/2.2.2.2';
+
+    is unseen('a->b/1.1.1.1', 0, "$db"), 'no' => 'not unseen (whitelisted source)';
+    is unseen('a->c/2.2.2.2', 0, "$db"), 'no' => 'not unseen (whitelisted source)';
+    is unseen('x->y/3.3.3.3', 0, "$db"), 'no' => 'not unseen x->y/3.3.3.3 (known key)';
+};