Add acls duplicate report

Add an acls duplicate report to wallet-report and Wallet::Report,
returning sets of ACLs that have exactly the same entries.

5 files changed, 138 insertions, 17 deletions

diff --git a/NEWS b/NEWS
index 79a24d1..738459b 100644
--- a/NEWS
+++ b/NEWS
@@ -6,6 +6,9 @@ wallet 0.12 (unreleased)
     returning all objects that have never been downloaded (in other words,
     have never been the target of a get command).
 
+    Add an acls duplicate report to wallet-report and Wallet::Report,
+    returning sets of ACLs that have exactly the same entries.
+
 wallet 0.11 (2010-03-08)
 
     When deleting an ACL on the server, verify that the ACL is not
diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm
index 64418ee..5a8dc52 100644
--- a/perl/Wallet/Report.pm
+++ b/perl/Wallet/Report.pm
@@ -15,6 +15,7 @@ require 5.006;
 use strict;
 use vars qw($VERSION);
 
+use Wallet::ACL;
 use Wallet::Database;
 
 # This version should be increased on any code change to this module.  Always
@@ -234,6 +235,52 @@ sub acls_unused {
     return ($sql);
 }
 
+# Obtain a textual representation of the membership of an ACL, returning undef
+# on error and setting the internal error.
+sub acl_membership {
+    my ($self, $id) = @_;
+    my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) };
+    if ($@) {
+        $self->error ($@);
+        return;
+    }
+    my @members = map { "$_->[0] $_->[1]" } $acl->list;
+    if (!@members && $acl->error) {
+        $self->error ($acl->error);
+        return;
+    }
+    return join ("\n", @members);
+}
+
+# Duplicate ACL detection unfortunately needs to do something more complex
+# than just return a SQL statement, so it's handled differently than other
+# reports.  All the work is done here and the results returned as a list of
+# sets of duplicates.
+sub acls_duplicate {
+    my ($self) = @_;
+    my @acls = sort map { $_->[1] } $self->acls;
+    return if (!@acls && $self->{error});
+    return if @acls < 2;
+    my %result;
+    for my $i (0 .. ($#acls - 1)) {
+        my $members = $self->acl_membership ($acls[$i]);
+        return unless defined $members;
+        for my $j (($i + 1) .. $#acls) {
+            my $check = $self->acl_membership ($acls[$j]);
+            return unless defined $check;
+            if ($check eq $members) {
+                $result{$acls[$i]} ||= [];
+                push (@{ $result{$acls[$i]} }, $acls[$j]);
+            }
+        }
+    }
+    my @result;
+    for my $acl (sort keys %result) {
+        push (@result, [ $acl, sort @{ $result{$acl} } ]);
+    }
+    return @result;
+}
+
 # Returns a list of all ACLs stored in the wallet database as a list of pairs
 # of ACL IDs and ACL names, possibly limited by some criteria.  On error and
 # for an empty database, the empty list will be returned.  To distinguish
@@ -249,7 +296,9 @@ sub acls {
     if (!defined $type || $type eq '') {
         ($sql) = $self->acls_all;
     } else {
-        if ($type eq 'entry') {
+        if ($type eq 'duplicate') {
+            return $self->acls_duplicate;
+        } elsif ($type eq 'entry') {
             if (@args == 0) {
                 $self->error ('ACL searches require an argument to search');
                 return;
@@ -427,20 +476,28 @@ between an empty report and an error.
 
 Returns a list of all ACLs matching a search type and string in the
 database, or all ACLs if no search information is given.  There are
-currently three search types.  C<empty> takes no arguments and will return
-only those ACLs that have no entries within them.  C<entry> takes two
-arguments, an entry scheme and a (possibly partial) entry identifier, and
-will return any ACLs containing an entry with that scheme and with an
-identifier containing that value.  C<unused> returns all ACLs that are not
-referenced by any object.
-
-The return value is a list of references to pairs of ACL ID and name.  For
-example, if there are two ACLs in the database, one with name C<ADMIN> and
-ID 1 and one with name C<group/admins> and ID 3, acls() with no arguments
-would return:
+currently four search types.  C<duplicate> returns sets of duplicate ACLs
+(ones with exactly the same entries).  C<empty> takes no arguments and
+will return only those ACLs that have no entries within them.  C<entry>
+takes two arguments, an entry scheme and a (possibly partial) entry
+identifier, and will return any ACLs containing an entry with that scheme
+and with an identifier containing that value.  C<unused> returns all ACLs
+that are not referenced by any object.
+
+The return value for everything except C<duplicate> is a list of
+references to pairs of ACL ID and name.  For example, if there are two
+ACLs in the database, one with name C<ADMIN> and ID 1 and one with name
+C<group/admins> and ID 3, acls() with no arguments would return:
 
     ([ 1, 'ADMIN' ], [ 3, 'group/admins' ])
 
+The return value for the C<duplicate> search is sets of ACL names that are
+duplicates (have the same entries).  For example, if C<d1>, C<d2>, and
+C<d3> are all duplicates, and C<o1> and C<o2> are also duplicates, the
+result would be:
+
+    ([ 'd1', 'd2', 'd3' ], [ 'o1', 'o2' ])
+
 Returns the empty list on failure.  An error can be distinguished from
 empty search results by calling error().  error() is guaranteed to return
 the error message if there was an error and undef if there was no error.
diff --git a/perl/t/report.t b/perl/t/report.t
index 00636db..363db20 100755
--- a/perl/t/report.t
+++ b/perl/t/report.t
@@ -7,7 +7,7 @@
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 179;
+use Test::More tests => 197;
 
 use Wallet::Admin;
 use Wallet::Report;
@@ -287,6 +287,40 @@ is ($objects[1][1], 'service/foo', ' and the right name');
 is ($objects[2][0], 'base', ' and the third has the right type');
 is ($objects[2][1], 'service/null', ' and the right name');
 
+# The third and fourth ACLs are both empty and should show up as duplicate.
+@acls = $report->acls ('duplicate');
+is (scalar (@acls), 1, 'There is one set of duplicate ACLs');
+is (scalar (@{ $acls[0] }), 2, ' with two members');
+is ($acls[0][0], 'fourth', ' and the first member is correct');
+is ($acls[0][1], 'third', ' and the second member is correct');
+
+# Add the same line to both ACLs.  They should still show up as duplicate.
+is ($server->acl_add ('fourth', 'base', 'bar'), 1,
+    'Adding a line to the fourth ACL works');
+is ($server->acl_add ('third', 'base', 'bar'), 1,
+    ' and adding a line to the third ACL works');
+@acls = $report->acls ('duplicate');
+is (scalar (@acls), 1, 'There is one set of duplicate ACLs');
+is (scalar (@{ $acls[0] }), 2, ' with two members');
+is ($acls[0][0], 'fourth', ' and the first member is correct');
+is ($acls[0][1], 'third', ' and the second member is correct');
+
+# Add another line to the third ACL.  Now we match second.
+is ($server->acl_add ('third', 'base', 'foo'), 1,
+    'Adding another line to the third ACL works');
+@acls = $report->acls ('duplicate');
+is (scalar (@acls), 1, 'There is one set of duplicate ACLs');
+is (scalar (@{ $acls[0] }), 2, ' with two members');
+is ($acls[0][0], 'second', ' and the first member is correct');
+is ($acls[0][1], 'third', ' and the second member is correct');
+
+# Add yet another line to the third ACL.  Now all ACLs are distinct.
+is ($server->acl_add ('third', 'base', 'baz'), 1,
+    'Adding another line to the third ACL works');
+@acls = $report->acls ('duplicate');
+is (scalar (@acls), 0, 'There are no duplicate ACLs');
+is ($report->error, undef, ' and no error');
+
 # Clean up.
 $admin->destroy;
 unlink 'wallet-db';
diff --git a/server/wallet-report b/server/wallet-report
index 28d5b9a..466fe46 100755
--- a/server/wallet-report
+++ b/server/wallet-report
@@ -32,8 +32,14 @@ sub command {
         if (!@acls and $report->error) {
             die $report->error, "\n";
         }
-        for my $acl (sort { $$a[1] cmp $$b[1] } @acls) {
-            print "$$acl[1] (ACL ID: $$acl[0])\n";
+        if (@args && $args[0] eq 'duplicate') {
+            for my $group (@acls) {
+                print join (' ', @$group), "\n";
+            }
+        } else {
+            for my $acl (sort { $$a[1] cmp $$b[1] } @acls) {
+                print "$$acl[1] (ACL ID: $$acl[0])\n";
+            }
         }
     } elsif ($command eq 'audit') {
         die "too many arguments to audit\n" if @args > 2;
@@ -110,13 +116,16 @@ B<wallet-report> takes no traditional options.
 
 =item acls
 
+=item acls duplicate
+
 =item acls empty
 
 =item acls entry <scheme> <identifier>
 
 =item acls unused
 
-Returns a list of ACLs in the database.  ACLs will be listed in the form:
+Returns a list of ACLs in the database.  Except for the C<duplicate>
+report, ACLs will be listed in the form:
 
     <name> (ACL ID: <id>)
 
@@ -124,6 +133,10 @@ where <name> is the human-readable name and <id> is the numeric ID.  The
 numeric ID is what's used internally by the wallet system.  There will be
 one line per ACL.
 
+For the C<duplicate> report, the output will instead be one duplicate set
+per line.  This will be a set of ACLs that all have the same entries.
+Only the names will be given, separated by spaces.
+
 If no search type is given, all the ACLs in the database will be returned.
 If a search type (and possible search arguments) are given, then the ACLs
 will be limited to those that match the search.
@@ -132,6 +145,12 @@ The currently supported ACL search types are:
 
 =over 4
 
+=item acls duplicate
+
+Returns all sets of ACLs that are duplicates, meaning that they contain
+exactly the same entries.  Each line will be the names of the ACLs in a
+set of duplicates, separated by spaces.
+
 =item acls empty
 
 Returns all ACLs which have no entries, generally so that abandoned ACLs
diff --git a/tests/server/report-t b/tests/server/report-t
index 394a869..0771946 100755
--- a/tests/server/report-t
+++ b/tests/server/report-t
@@ -8,7 +8,7 @@
 # See LICENSE for licensing terms.
 
 use strict;
-use Test::More tests => 44;
+use Test::More tests => 48;
 
 # Create a dummy class for Wallet::Report that prints what method was called
 # with its arguments and returns data for testing.
@@ -35,6 +35,7 @@ sub acls {
     shift;
     print "acls @_\n";
     return if ($error or $empty);
+    return ([ qw/d1 d2 d3/ ], [ qw/o1 o2/ ]) if (@_ && $_[0] eq 'duplicate');
     return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]);
 }
 
@@ -119,6 +120,10 @@ is ($err, '', 'List succeeds for ACLs');
 is ($out, "new\nacls \n"
     . "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n",
     ' and returns the right output');
+($out, $err) = run_report ('acls', 'duplicate');
+is ($err, '', 'Duplicate report succeeds for ACLs');
+is ($out, "new\nacls duplicate\nd1 d2 d3\no1 o2\n",
+    ' and returns the right output');
 ($out, $err) = run_report ('acls', 'entry', 'foo', 'foo');
 is ($err, '', 'List succeeds for ACLs');
 is ($out, "new\nacls entry foo foo\n"
@@ -168,6 +173,9 @@ $Wallet::Report::empty = 1;
 ($out, $err) = run_report ('acls');
 is ($err, '', 'acls runs with an empty list and no errors');
 is ($out, "new\nacls \n", ' and calls the right methods');
+($out, $err) = run_report ('acls', 'duplicate');
+is ($err, '', 'acls duplicate runs with an empty list and no errors');
+is ($out, "new\nacls duplicate\n", ' and calls the right methods');
 ($out, $err) = run_report ('audit', 'objects', 'name');
 is ($err, '', 'audit runs with an empty list and no errors');
 is ($out, "new\naudit objects name\n", ' and calls the right methods');