Add an ACL name audit to wallet-report and Wallet::Report

Parallel to objects name, add an acls name audit that returns all ACLs
that do not follow the site naming standard.

6 files changed, 84 insertions, 23 deletions

diff --git a/NEWS b/NEWS
index 1f63e07..6744475 100644
--- a/NEWS
+++ b/NEWS
@@ -13,9 +13,10 @@ wallet 0.11 (unreleased)
     set, it is called for any ACL creation or rename and can reject the
     new ACL name.
 
-    Add an audit command to wallet-report and one audit: objects name,
-    which returns all objects that do not pass the local naming policy.
-    The corresponding Wallet::Report method is audit().
+    Add an audit command to wallet-report and two audits: acls name, which
+    returns all ACLs that do not pass the local naming policy, and objects
+    name, which does the same for objects.  The corresponding
+    Wallet::Report method is audit().
 
     Add the acls unused report to wallet-report and Wallet::Report,
     returning all ACLs not referenced by any database objects.
diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm
index e4014a1..23a051d 100644
--- a/perl/Wallet/Config.pm
+++ b/perl/Wallet/Config.pm
@@ -563,6 +563,14 @@ empty string, object creation will be allowed.  If it returns anything
 else, object creation is rejected and the return value is used as the
 error message.
 
+This function is also called for naming audits done via Wallet::Report to
+find any existing objects that violate a (possibly updated) naming policy.
+In this case, the second argument (the identity of the person creating the
+ACL) will be undef.  As a general rule, if the second argument is undef,
+the function should apply the most liberal accepted naming policy so that
+the audit returns only ACLs that violate all naming policies, but some
+sites may wish different results for their audit reports.
+
 Please note that this return status is backwards from what one would
 normally expect.  A false value is success; a true value is failure with
 an error message.
diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm
index f6e6753..c743060 100644
--- a/perl/Wallet/Report.pm
+++ b/perl/Wallet/Report.pm
@@ -310,10 +310,10 @@ sub owners {
 ##############################################################################
 
 # Audit the database for violations of local policy.  Returns a list of
-# objects (as type and name pairs) or a list of ACLs.  On error and for no
-# matching entries, the empty list will be returned.  To distinguish between
-# an empty return and an error, call error(), which will return undef if there
-# was no error.
+# objects (as type and name pairs) or a list of ACLs (as ID and name pairs).
+# On error and for no matching entries, the empty list will be returned.  To
+# distinguish between an empty return and an error, call error(), which will
+# return undef if there was no error.
 sub audit {
     my ($self, $type, $audit) = @_;
     undef $self->{error};
@@ -336,6 +336,20 @@ sub audit {
             $self->error ("unknown object audit: $audit");
             return;
         }
+    } elsif ($type eq 'acls') {
+        if ($audit eq 'name') {
+            return unless defined &Wallet::Config::verify_acl_name;
+            my @acls = $self->acls;
+            my @results;
+            for my $acl (@acls) {
+                my $error = Wallet::Config::verify_acl_name ($acl->[1]);
+                push (@results, $acl) if $error;
+            }
+            return @results;
+        } else {
+            $self->error ("unknown acl audit: $audit");
+            return;
+        }
     } else {
         $self->error ("unknown audit type: $type");
         return;
@@ -424,11 +438,12 @@ the error message if there was an error and undef if there was no error.
 
 Audits the wallet database for violations of local policy.  TYPE is the
 general class of thing to audit, and AUDIT is the specific audit to
-perform.  Currently, the only implemented type is C<objects> and the only
-audit is C<name>.  This returns a list of all objects, as references to
-pairs of type and name, that are not accepted by the verify_name()
-function defined in the wallet configuration.  See L<Wallet::Config> for
-more information.
+perform.  TYPE may be either C<objects> or C<acls>.  Currently, the only
+implemented audit is C<name>.  This returns a list of all objects, as
+references to pairs of type and name, or ACLs, as references to pairs of
+ID and name, that are not accepted by the verify_name() or
+verify_acl_name() function defined in the wallet configuration.  See
+L<Wallet::Config> for more information.
 
 Returns the empty list on failure.  An error can be distinguished from
 empty search results by calling error().  error() is guaranteed to return
diff --git a/perl/t/report.t b/perl/t/report.t
index b283576..1dc69f7 100755
--- a/perl/t/report.t
+++ b/perl/t/report.t
@@ -7,7 +7,7 @@
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 148;
+use Test::More tests => 151;
 
 use Wallet::Admin;
 use Wallet::Report;
@@ -224,6 +224,21 @@ is (scalar (@lines), 1, 'Searching for naming violations finds one');
 is ($lines[0][0], 'base', ' and the first has the right type');
 is ($lines[0][1], 'service/admin', ' and the right name');
 
+# Set an ACL naming policy and then look for objects that fail that policy.
+# Use the same deactivation trick as above.
+package Wallet::Config;
+sub verify_acl_name {
+    my ($name) = @_;
+    return unless $naming_active;
+    return 'second not allowed' if $name eq 'second';
+    return;
+}
+package main;
+@lines = $report->audit ('acls', 'name');
+is (scalar (@lines), 1, 'Searching for ACL naming violations finds one');
+is ($lines[0][0], 3, ' and the first has the right ID');
+is ($lines[0][1], 'second', ' and the right name');
+
 # Clean up.
 $admin->destroy;
 unlink 'wallet-db';
diff --git a/server/wallet-report b/server/wallet-report
index 2b7cd45..435fb73 100755
--- a/server/wallet-report
+++ b/server/wallet-report
@@ -38,12 +38,16 @@ sub command {
     } elsif ($command eq 'audit') {
         die "too many arguments to audit\n" if @args > 2;
         die "too few arguments to audit\n" if @args < 2;
-        my @objects = $report->audit (@args);
-        if (!@objects and $report->error) {
+        my @result = $report->audit (@args);
+        if (!@result and $report->error) {
             die $report->error, "\n";
         }
-        for my $object (@objects) {
-            print join (' ', @$object), "\n";
+        for my $item (@result) {
+            if ($args[0] eq 'acls') {
+                print "$$item[1] (ACL ID: $$item[0])\n";
+            } else {
+                print join (' ', @$item), "\n";
+            }
         }
     } elsif ($command eq 'objects') {
         die "too many arguments to objects\n" if @args > 2;
@@ -146,14 +150,22 @@ wallet database, either as an owner or on one of the more specific ACLs.
 
 =back
 
+=item audit acls name
+
 =item audit objects name
 
-Returns all objects that violate the current site naming policy.  Objects
-will be listed in the form:
+Returns all ACLs or objects that violate the current site naming policy.
+Objects will be listed in the form:
 
     <type> <name>
 
-There will be one line per object.
+and ACLs in the form:
+
+    <name> (ACL ID: <id>)
+
+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 object or ACL.
 
 =item objects
 
diff --git a/tests/server/report-t b/tests/server/report-t
index 61cfd9b..394a869 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 => 42;
+use Test::More tests => 44;
 
 # Create a dummy class for Wallet::Report that prints what method was called
 # with its arguments and returns data for testing.
@@ -42,7 +42,13 @@ sub audit {
     shift;
     print "audit @_\n";
     return if ($error or $empty);
-    return ([ file => 'unix-wallet-password' ]);
+    if ($_[0] eq 'objects') {
+        return ([ file => 'unix-wallet-password' ]);
+    } elsif ($_[0] eq 'acls') {
+        return ([ 2, 'group/admins' ]);
+    } else {
+        return;
+    }
 }
 
 sub objects {
@@ -119,9 +125,13 @@ is ($out, "new\nacls entry foo foo\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 ('audit', 'objects', 'name');
-is ($err, '', 'Audit report succeeds');
+is ($err, '', 'Object audit report succeeds');
 is ($out, "new\naudit objects name\nfile unix-wallet-password\n",
     ' and returns the right output');
+($out, $err) = run_report ('audit', 'acls', 'name');
+is ($err, '', 'ACL audit report succeeds');
+is ($out, "new\naudit acls name\ngroup/admins (ACL ID: 2)\n",
+    ' and returns the right output');
 ($out, $err) = run_report ('objects');
 is ($err, '', 'List succeeds for objects');
 is ($out, "new\nobjects \n"