Add auditing for names that violate the naming policy

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().

Wallet::Config::verify_name may now be called with an undefined third
argument (normally the user attempting to create an object).  This
calling convention is used when auditing, and the local policy
function should select the correct policy to apply for useful audit
results.

6 files changed, 141 insertions, 10 deletions

diff --git a/NEWS b/NEWS
index e66d1b3..03fe99b 100644
--- a/NEWS
+++ b/NEWS
@@ -8,6 +8,16 @@ wallet 0.11 (unreleased)
     integrity.  This also allows us to return a better error message
     naming an object that's still using that ACL.
 
+    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().
+
+    Wallet::Config::verify_name may now be called with an undefined third
+    argument (normally the user attempting to create an object).  This
+    calling convention is used when auditing, and the local policy
+    function should select the correct policy to apply for useful audit
+    results.
+
     Fix portability to older Kerberos libraries without
     krb5_free_error_message.
 
diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm
index 396bf7d..2991361 100644
--- a/perl/Wallet/Config.pm
+++ b/perl/Wallet/Config.pm
@@ -14,7 +14,7 @@ use vars qw($PATH $VERSION);
 # This version should be increased on any code change to this module.  Always
 # use two digits for the minor version with a leading zero if necessary so
 # that it will sort properly.
-$VERSION = '0.04';
+$VERSION = '0.05';
 
 # Path to the config file to load.
 $PATH = $ENV{WALLET_CONFIG} || '/etc/wallet/wallet.conf';
@@ -519,6 +519,15 @@ creation.  If it returns undef or the 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 third argument (the identity of the person
+creating the object) will be undef.  As a general rule, if the third
+argument is undef, the function should apply the most liberal accepted
+naming policy so that the audit returns only objects 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 7cd8653..ff4fa8b 100644
--- a/perl/Wallet/Report.pm
+++ b/perl/Wallet/Report.pm
@@ -20,7 +20,7 @@ use Wallet::Database;
 # This version should be increased on any code change to this module.  Always
 # use two digits for the minor version with a leading zero if necessary so
 # that it will sort properly.
-$VERSION = '0.01';
+$VERSION = '0.02';
 
 ##############################################################################
 # Constructor, destructor, and accessors
@@ -290,6 +290,43 @@ sub owners {
     return @lines;
 }
 
+##############################################################################
+# Auditing
+##############################################################################
+
+# 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.
+sub audit {
+    my ($self, $type, $audit) = @_;
+    undef $self->{error};
+    unless (defined ($type) and defined ($audit)) {
+        $self->error ("type and audit not specified");
+        return;
+    }
+    if ($type eq 'objects') {
+        if ($audit eq 'name') {
+            return unless defined &Wallet::Config::verify_name;
+            my @objects = $self->objects;
+            my @results;
+            for my $object (@objects) {
+                my ($type, $name) = @$object;
+                my $error = Wallet::Config::verify_name ($type, $name);
+                push (@results, $object) if $error;
+            }
+            return @results;
+        } else {
+            $self->error ("unknown object audit: $audit");
+            return;
+        }
+    } else {
+        $self->error ("unknown audit type: $type");
+        return;
+    }
+}
+
 1;
 __DATA__
 
@@ -312,6 +349,7 @@ ACL ACLs wildcard Allbery SQL tuples
     for my $object (@objects) {
         print "@$object\n";
     }
+    @objects = $report->audit ('objects', 'name');
 
 =head1 DESCRIPTION
 
@@ -366,6 +404,20 @@ 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.
 
+=item audit(TYPE, AUDIT)
+
+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.
+
+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.
+
 =item error()
 
 Returns the error of the last failing operation or undef if no operations
diff --git a/perl/t/report.t b/perl/t/report.t
index a37681a..3b94d00 100755
--- a/perl/t/report.t
+++ b/perl/t/report.t
@@ -7,7 +7,7 @@
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 83;
+use Test::More tests => 88;
 
 use Wallet::Admin;
 use Wallet::Report;
@@ -166,6 +166,29 @@ is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1,
 is (scalar (@lines), 0, ' and now there are no objects in the report');
 is ($report->error, undef, ' with no error');
 
+# The naming audit returns nothing if there's no naming policy.
+@lines = $report->audit ('objects', 'name');
+is (scalar (@lines), 0, 'Searching for naming violations finds none');
+is ($report->error, undef, ' with no error');
+
+# Set a naming policy and then look for objects that fail that policy.  We
+# have to deactivate this policy until now so that it doesn't prevent the
+# creation of that name originally, which is the reason for the variable
+# reference.
+our $naming_active = 1;
+package Wallet::Config;
+sub verify_name {
+    my ($type, $name) = @_;
+    return unless $naming_active;
+    return 'admin not allowed' if $name eq 'service/admin';
+    return;
+}
+package main;
+@lines = $report->audit ('objects', 'name');
+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');
+
 # Clean up.
 $admin->destroy;
 unlink 'wallet-db';
diff --git a/server/wallet-report b/server/wallet-report
index a6b3b8d..caa7e2c 100755
--- a/server/wallet-report
+++ b/server/wallet-report
@@ -35,6 +35,16 @@ sub command {
         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;
+        die "too few arguments to audit\n" if @args < 2;
+        my @objects = $report->audit (@args);
+        if (!@objects and $report->error) {
+            die $report->error, "\n";
+        }
+        for my $object (@objects) {
+            print join (' ', @$object), "\n";
+        }
     } elsif ($command eq 'objects') {
         die "too many arguments to objects\n" if @args > 2;
         my @objects = $report->objects (@args);
@@ -129,6 +139,15 @@ any identifier containing that string.
 
 =back
 
+=item audit objects name
+
+Returns all objects that violate the current site naming policy.  Objects
+will be listed in the form:
+
+    <type> <name>
+
+There will be one line per object.
+
 =item objects
 
 =item objects acl <acl>
diff --git a/tests/server/report-t b/tests/server/report-t
index 285ee5a..61cfd9b 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 => 32;
+use Test::More tests => 42;
 
 # Create a dummy class for Wallet::Report that prints what method was called
 # with its arguments and returns data for testing.
@@ -38,6 +38,13 @@ sub acls {
     return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]);
 }
 
+sub audit {
+    shift;
+    print "audit @_\n";
+    return if ($error or $empty);
+    return ([ file => 'unix-wallet-password' ]);
+}
+
 sub objects {
     shift;
     print "objects @_\n";
@@ -81,6 +88,7 @@ is ($out, "new\n", ' and nothing ran');
 
 # Check too few and too many arguments for every command.
 my %commands = (acls    => [0, 3],
+                audit   => [2, 2],
                 objects => [0, 2],
                 owners  => [2, 2]);
 for my $command (sort keys %commands) {
@@ -110,6 +118,10 @@ is ($err, '', 'List succeeds for ACLs');
 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 ($out, "new\naudit objects name\nfile unix-wallet-password\n",
+    ' and returns the right output');
 ($out, $err) = run_report ('objects');
 is ($err, '', 'List succeeds for objects');
 is ($out, "new\nobjects \n"
@@ -128,24 +140,30 @@ is ($out, "new\nowners % %\nkrb5 admin\@EXAMPLE.COM\n",
 # Test error handling.
 $Wallet::Report::error = 1;
 ($out, $err) = run_report ('acls');
-is ($err, "some error\n", 'Error handling succeeds for list acls');
+is ($err, "some error\n", 'Error handling succeeds for acls');
 is ($out, "new\nacls \n", ' and calls the right methods');
+($out, $err) = run_report ('audit', 'objects', 'name');
+is ($err, "some error\n", 'Error handling succeeds for audit');
+is ($out, "new\naudit objects name\n", ' and calls the right methods');
 ($out, $err) = run_report ('objects');
-is ($err, "some error\n", 'Error handling succeeds for list objects');
+is ($err, "some error\n", 'Error handling succeeds for objects');
 is ($out, "new\nobjects \n", ' and calls the right methods');
 ($out, $err) = run_report ('owners', 'foo', 'bar');
-is ($err, "some error\n", 'Error handling succeeds for report owners');
+is ($err, "some error\n", 'Error handling succeeds for owners');
 is ($out, "new\nowners foo bar\n", ' and calls the right methods');
 
 # Test empty lists.
 $Wallet::Report::error = 0;
 $Wallet::Report::empty = 1;
 ($out, $err) = run_report ('acls');
-is ($err, '', 'list acls runs with an empty list and no errors');
+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 ('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');
 ($out, $err) = run_report ('objects');
-is ($err, '', 'list objects runs with an empty list with no errors');
+is ($err, '', 'objects runs with an empty list with no errors');
 is ($out, "new\nobjects \n", ' and calls the right methods');
 ($out, $err) = run_report ('owners', 'foo', 'bar');
-is ($err, '', 'report owners runs with an empty list and no errors');
+is ($err, '', 'owners runs with an empty list and no errors');
 is ($out, "new\nowners foo bar\n", ' and calls the right methods');