Imported Upstream version 0.11upstream/0.11

28 files changed, 348 insertions, 75 deletions

diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm
index 76e7354..44a82b2 100644
--- a/perl/Wallet/ACL.pm
+++ b/perl/Wallet/ACL.pm
@@ -21,7 +21,7 @@ use POSIX qw(strftime);
 # 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.06';
+$VERSION = '0.07';
 
 ##############################################################################
 # Constructors
@@ -191,11 +191,25 @@ sub rename {
 
 # Destroy the ACL, deleting it out of the database.  Returns true on success,
 # false on failure.
+#
+# Checks to ensure that the ACL is not referenced anywhere in the database,
+# since we may not have referential integrity enforcement.  It's not clear
+# that this is the right place to do this; it's a bit of an abstraction
+# violation, since it's a query against the object table.
 sub destroy {
     my ($self, $user, $host, $time) = @_;
     $time ||= time;
     eval {
-        my $sql = 'delete from acl_entries where ae_id = ?';
+        my $sql = 'select ob_type, ob_name from objects where ob_owner = ?
+            or ob_acl_get = ? or ob_acl_store = ? or ob_acl_show = ? or
+            ob_acl_destroy = ? or ob_acl_flags = ?';
+        my $sth = $self->{dbh}->prepare ($sql);
+        $sth->execute (($self->{id}) x 6);
+        my $entry = $sth->fetchrow_arrayref;
+        if (defined $entry) {
+            die "ACL in use by $entry->[0]:$entry->[1]";
+        }
+        $sql = 'delete from acl_entries where ae_id = ?';
         $self->{dbh}->do ($sql, undef, $self->{id});
         $sql = 'delete from acls where ac_id = ?';
         $self->{dbh}->do ($sql, undef, $self->{id});
@@ -525,13 +539,13 @@ array context and undef in scalar context.
 
 =item destroy(PRINCIPAL, HOSTNAME [, DATETIME])
 
-Destroys this ACL from the database.  Note that this will fail due to
-integrity constraint errors if the ACL is still referenced by any object;
-the ACL must be removed from all objects first.  Returns true on success
-and false on failure.  On failure, the caller should call error() to get
-the error message.  PRINCIPAL, HOSTNAME, and DATETIME are stored as
-history information.  PRINCIPAL should be the user who is destroying the
-ACL.  If DATETIME isn't given, the current time is used.
+Destroys this ACL from the database.  Note that this will fail if the ACL
+is still referenced by any object; the ACL must be removed from all
+objects first.  Returns true on success and false on failure.  On failure,
+the caller should call error() to get the error message.  PRINCIPAL,
+HOSTNAME, and DATETIME are stored as history information.  PRINCIPAL
+should be the user who is destroying the ACL.  If DATETIME isn't given,
+the current time is used.
 
 =item error()
 
diff --git a/perl/Wallet/ACL/NetDB.pm b/perl/Wallet/ACL/NetDB.pm
index 2096ba8..0fb5a2c 100644
--- a/perl/Wallet/ACL/NetDB.pm
+++ b/perl/Wallet/ACL/NetDB.pm
@@ -23,7 +23,7 @@ use Wallet::Config;
 # 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';
 
 ##############################################################################
 # Interface
@@ -163,7 +163,7 @@ only if that principal has one of the roles user, admin, or team for that
 node.
 
 To use this object, several configuration parameters must be set.  See
-Wallet::Config(3) for details on those configuration parameters and
+L<Wallet::Config> for details on those configuration parameters and
 information about how to set wallet configuration.
 
 =head1 METHODS
diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm
index e835713..f208e13 100644
--- a/perl/Wallet/Admin.pm
+++ b/perl/Wallet/Admin.pm
@@ -183,8 +183,8 @@ its actions.
 
 To use this object, several configuration variables must be set (at least
 the database configuration).  For information on those variables and how
-to set them, see Wallet::Config(3).  For more information on the normal
-user interface to the wallet server, see Wallet::Server(3).
+to set them, see L<Wallet::Config>.  For more information on the normal
+user interface to the wallet server, see L<Wallet::Server>.
 
 =head1 CLASS METHODS
 
diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm
index 396bf7d..23a051d 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';
@@ -90,7 +90,7 @@ Sets the Perl database driver to use for the wallet database.  Common
 values would be C<SQLite> or C<MySQL>.  Less common values would be
 C<Oracle>, C<Sybase>, or C<ODBC>.  The appropriate DBD::* Perl module for
 the chosen driver must be installed and will be dynamically loaded by the
-wallet.  For more information, see DBI(3).
+wallet.  For more information, see L<DBI>.
 
 This variable must be set.
 
@@ -104,7 +104,7 @@ Sets the remaining contents for the DBI DSN (everything after the driver).
 Using this variable provides full control over the connect string passed
 to DBI.  When using SQLite, set this variable to the path to the SQLite
 database.  If this variable is set, DB_NAME, DB_HOST, and DB_PORT are
-ignored.  For more information, see DBI(3) and the documentation for the
+ignored.  For more information, see L<DBI> and the documentation for the
 database driver you're using.
 
 Either DB_INFO or DB_NAME must be set.  If you don't need to pass any
@@ -119,7 +119,7 @@ our $DB_INFO;
 If DB_INFO is not set, specifies the database name.  The third part of the
 DBI connect string will be set to C<database=DB_NAME>, possibly with a
 host and port appended if DB_HOST and DB_PORT are set.  For more
-information, see DBI(3) and the documentation for the database driver
+information, see L<DBI> and the documentation for the database driver
 you're using.
 
 Either DB_INFO or DB_NAME must be set.
@@ -131,7 +131,7 @@ our $DB_NAME;
 =item DB_HOST
 
 If DB_INFO is not set, specifies the database host.  C<;host=DB_HOST> will
-be appended to the DBI connect string.  For more information, see DBI(3)
+be appended to the DBI connect string.  For more information, see L<DBI>
 and the documentation for the database driver you're using.
 
 =cut
@@ -142,7 +142,7 @@ our $DB_HOST;
 
 If DB_PORT is not set, specifies the database port.  C<;port=DB_PORT> will
 be appended to the DBI connect string.  If this variable is set, DB_HOST
-should also be set.  For more information, see DBI(3) and the
+should also be set.  For more information, see L<DBI> and the
 documentation for the database driver you're using.
 
 =cut
@@ -179,7 +179,7 @@ C<file> object type (the Wallet::Object::File class).
 =item FILE_BUCKET
 
 The directory into which to store file objects.  File objects will be
-stored in subdirectories of this directory.  See Wallet::Object::File(3)
+stored in subdirectories of this directory.  See L<Wallet::Object::File>
 for the full details of the naming scheme.  This directory must be
 writable by the wallet server and the wallet server must be able to create
 subdirectories of it.
@@ -513,12 +513,21 @@ By default, wallet permits administrators to create objects of any name
 (unless the object backend rejects the name).  However, naming standards
 for objects can be enforced, even for administrators, by defining a Perl
 function in the configuration file named verify_name.  If such a function
-exists, it will be called for any object creation and given the type of
-object, the object name, and the identity of the person doing the
+exists, it will be called for any object creation and will be passed the
+type of object, the object name, and the identity of the person doing the
 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.
@@ -540,7 +549,50 @@ keytab objects for particular principals have fully-qualified hostnames:
     }
 
 Objects that aren't of type C<keytab> or which aren't for a host-based key
-have no naming requirements enforced.
+have no naming requirements enforced by this example.
+
+=head1 ACL NAMING ENFORCEMENT
+
+Similar to object names, by default wallet permits administrators to
+create ACLs with any name.  However, naming standards for ACLs can be
+enforced by defining a Perl function in the configuration file named
+verify_acl_name.  If such a function exists, it will be called for any ACL
+creation or rename and will be passed given the new ACL name and the
+identity of the person doing the 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 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.
+
+For example, the following verify_acl_name function would ensure that any
+ACLs created contain a slash and the part before the slash be one of
+C<host>, C<group>, C<user>, or C<service>.
+
+    sub verify_acl_name {
+        my ($name, $user) = @_;
+        return 'ACL names must contain a slash' unless $name =~ m,/,;
+        my ($first, $rest) = split ('/', $name, 2);
+        my %types = map { $_ => 1 } qw(host group user service);
+        unless ($types{$first}) {
+            return "unknown ACL type $first";
+        }
+        return;
+    }
+
+Obvious improvements could be made, such as checking that the part after
+the slash for a C<host/> ACL looked like a host name and the part after a
+slash for a C<user/> ACL look like a user name.
 
 =head1 ENVIRONMENT
 
diff --git a/perl/Wallet/Database.pm b/perl/Wallet/Database.pm
index 7b3474a..7daab9f 100644
--- a/perl/Wallet/Database.pm
+++ b/perl/Wallet/Database.pm
@@ -39,7 +39,7 @@ use Wallet::Config;
 # 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.02';
+$VERSION = '0.03';
 
 ##############################################################################
 # Core overrides
@@ -101,7 +101,7 @@ methods should work the same as in DBI and Wallet::Database objects should
 be usable exactly as if they were DBI objects.
 
 connect() will obtain the database connection information from the wallet
-configuration; see Wallet::Config(3) for more details.  It will also
+configuration; see L<Wallet::Config> for more details.  It will also
 automatically set the RaiseError attribute to true and the PrintError and
 AutoCommit attributes to false, matching the assumptions made by the
 wallet database code.
diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm
index d1eecda..658ac04 100644
--- a/perl/Wallet/Kadmin/Heimdal.pm
+++ b/perl/Wallet/Kadmin/Heimdal.pm
@@ -24,7 +24,7 @@ use Wallet::Kadmin ();
 # 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.03';
+$VERSION = '0.04';
 
 ##############################################################################
 # Utility functions
@@ -254,7 +254,7 @@ Wallet::Kadmin::Heimdal - Wallet Kerberos administration API for Heimdal
 
 Wallet::Kadmin::Heimdal implements the Wallet::Kadmin API for Heimdal,
 providing an interface to create and delete principals and create keytabs.
-It provides the API documented in Wallet::Kadmin(3) for a Heimdal KDC.
+It provides the API documented in L<Wallet::Kadmin> for a Heimdal KDC.
 
 To use this class, several configuration parameters must be set.  See
 L<Wallet::Config/"KEYTAB OBJECT CONFIGURATION"> for details.
diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm
index 434e93d..fc4d271 100644
--- a/perl/Wallet/Kadmin/MIT.pm
+++ b/perl/Wallet/Kadmin/MIT.pm
@@ -25,7 +25,7 @@ use Wallet::Kadmin ();
 # 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.02';
+$VERSION = '0.03';
 
 ##############################################################################
 # kadmin Interaction
@@ -275,7 +275,7 @@ Wallet::Kadmin::MIT - Wallet Kerberos administration API for MIT
 
 Wallet::Kadmin::MIT implements the Wallet::Kadmin API for MIT Kerberos,
 providing an interface to create and delete principals and create keytabs.
-It provides the API documented in Wallet::Kadmin(3) for an MIT Kerberos
+It provides the API documented in L<Wallet::Kadmin> for an MIT Kerberos
 KDC.
 
 MIT Kerberos does not provide any method via the kadmin network protocol
diff --git a/perl/Wallet/Object/File.pm b/perl/Wallet/Object/File.pm
index c655b44..47c8ac2 100644
--- a/perl/Wallet/Object/File.pm
+++ b/perl/Wallet/Object/File.pm
@@ -24,7 +24,7 @@ use Wallet::Object::Base;
 # 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.02';
+$VERSION = '0.03';
 
 ##############################################################################
 # File naming
@@ -159,7 +159,7 @@ it when the file object is deleted.  A file object must be stored before
 it can be retrieved with get.
 
 To use this object, the configuration option specifying where on the
-wallet server to store file objects must be set.  See Wallet::Config(3)
+wallet server to store file objects must be set.  See L<Wallet::Config>
 for details on this configuration parameter and information about how to
 set wallet configuration.
 
diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm
index edb26b3..b7c2805 100644
--- a/perl/Wallet/Object/Keytab.pm
+++ b/perl/Wallet/Object/Keytab.pm
@@ -25,7 +25,7 @@ use Wallet::Kadmin;
 # 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.08';
+$VERSION = '0.09';
 
 ##############################################################################
 # Enctype restriction
@@ -379,7 +379,7 @@ This implementation generates a new random key (and hence invalidates all
 existing keytabs) each time the keytab is retrieved with the get() method.
 
 To use this object, several configuration parameters must be set.  See
-Wallet::Config(3) for details on those configuration parameters and
+L<Wallet::Config> for details on those configuration parameters and
 information about how to set wallet configuration.
 
 =head1 METHODS
@@ -456,7 +456,7 @@ configuration.  If the principal already exists, create() still succeeds
 wallet).  Otherwise, if the Kerberos principal could not be created,
 create() fails.  The principal is created with the randomized keys.  NAME
 must not contain the realm; instead, the KEYTAB_REALM configuration
-variable should be set.  See Wallet::Config(3) for more information.
+variable should be set.  See L<Wallet::Config> for more information.
 
 If create() fails, it throws an exception.
 
diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm
index 7cd8653..c743060 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
@@ -195,7 +195,8 @@ sub acls_all {
 sub acls_empty {
     my ($self) = @_;
     my $sql = 'select ac_id, ac_name from acls left join acl_entries
-        on (acls.ac_id = acl_entries.ae_id) where ae_id is null';
+        on (acls.ac_id = acl_entries.ae_id) where ae_id is null order by
+        ac_id';
     return ($sql);
 }
 
@@ -210,6 +211,18 @@ sub acls_entry {
     return ($sql, $type, '%' . $identifier . '%');
 }
 
+# Returns the SQL statement required to find unused ACLs.
+sub acls_unused {
+    my ($self) = @_;
+    my $sql = 'select ac_id, ac_name from acls where not ac_id in (select
+        ob_owner from objects where ob_owner = ac_id)';
+    for my $acl (qw/get store show destroy flags/) {
+        $sql .= " and not ac_id in (select ob_acl_$acl from objects where
+            ob_acl_$acl = ac_id)";
+    }
+    return ($sql);
+}
+
 # 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
@@ -234,8 +247,10 @@ sub acls {
             }
         } elsif ($type eq 'empty') {
             ($sql) = $self->acls_empty;
+        } elsif ($type eq 'unused') {
+            ($sql) = $self->acls_unused;
         } else {
-            $self->error ("do not know search type: $type");
+            $self->error ("unknown search type: $type");
             return;
         }
     }
@@ -290,6 +305,57 @@ 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 (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};
+    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;
+        }
+    } 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;
+    }
+}
+
 1;
 __DATA__
 
@@ -312,6 +378,7 @@ ACL ACLs wildcard Allbery SQL tuples
     for my $object (@objects) {
         print "@$object\n";
     }
+    @objects = $report->audit ('objects', 'name');
 
 =head1 DESCRIPTION
 
@@ -322,8 +389,8 @@ tuples identifying objects, ACLs, or ACL entries.
 
 To use this object, several configuration variables must be set (at least
 the database configuration).  For information on those variables and how
-to set them, see Wallet::Config(3).  For more information on the normal
-user interface to the wallet server, see Wallet::Server(3).
+to set them, see L<Wallet::Config>.  For more information on the normal
+user interface to the wallet server, see L<Wallet::Server>.
 
 =head1 CLASS METHODS
 
@@ -349,11 +416,12 @@ 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 two search types.  C<empty> takes no arguments and will return
+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.
+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
@@ -366,6 +434,21 @@ 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.  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
+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/Wallet/Server.pm b/perl/Wallet/Server.pm
index dd596c4..185bf23 100644
--- a/perl/Wallet/Server.pm
+++ b/perl/Wallet/Server.pm
@@ -23,7 +23,7 @@ use Wallet::Schema;
 # 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.08';
+$VERSION = '0.09';
 
 ##############################################################################
 # Utility methods
@@ -536,9 +536,16 @@ sub acl_create {
         $self->error ("$self->{user} not authorized to create ACL");
         return;
     }
-    my $dbh = $self->{dbh};
     my $user = $self->{user};
     my $host = $self->{host};
+    if (defined (&Wallet::Config::verify_acl_name)) {
+        my $error = Wallet::Config::verify_acl_name ($name, $user);
+        if ($error) {
+            $self->error ("$name rejected: $error");
+            return;
+        }
+    }
+    my $dbh = $self->{dbh};
     my $acl = eval { Wallet::ACL->create ($name, $dbh, $user, $host) };
     if ($@) {
         $self->error ($@);
@@ -620,6 +627,13 @@ sub acl_rename {
         $self->error ('cannot rename the ADMIN ACL');
         return;
     }
+    if (defined (&Wallet::Config::verify_acl_name)) {
+        my $error = Wallet::Config::verify_acl_name ($name, $self->{user});
+        if ($error) {
+            $self->error ("$name rejected: $error");
+            return;
+        }
+    }
     unless ($acl->rename ($name)) {
         $self->error ($acl->error);
         return;
@@ -739,7 +753,7 @@ object.
 
 To use this object, several configuration variables must be set (at least
 the database configuration).  For information on those variables and how
-to set them, see Wallet::Config(3).
+to set them, see L<Wallet::Config>.
 
 =head1 CLASS METHODS
 
@@ -777,9 +791,9 @@ also returns undef, that ACL wasn't set; otherwise, error() will return
 the error message.
 
 If ID is given, sets the specified ACL to ID, which can be either the name
-of an ACL or a numeric ACL ID.  To set an ACL, the current user must be
-authorized by the ADMIN ACL.  Returns true for success and false for
-failure.
+of an ACL or a numeric ACL ID.  To clear the ACL, pass in an empty string
+as the ID.  To set or clear an ACL, the current user must be authorized by
+the ADMIN ACL.  Returns true for success and false for failure.
 
 ACL settings are checked before the owner and override the owner setting.
 
diff --git a/perl/t/acl.t b/perl/t/acl.t
index 95aa763..f169eb5 100755
--- a/perl/t/acl.t
+++ b/perl/t/acl.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/api.t -- Tests for the wallet ACL API.
+# Tests for the wallet ACL API.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/admin.t b/perl/t/admin.t
index e22088e..074dbc6 100755
--- a/perl/t/admin.t
+++ b/perl/t/admin.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/admin.t -- Tests for wallet administrative interface.
+# Tests for wallet administrative interface.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/config.t b/perl/t/config.t
index 1377cb8..6b9f226 100755
--- a/perl/t/config.t
+++ b/perl/t/config.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/config.t -- Tests for the wallet server configuration.
+# Tests for the wallet server configuration.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/data/keytab-fake b/perl/t/data/keytab-fake
index 0ecf264..f4f0fb3 100755
--- a/perl/t/data/keytab-fake
+++ b/perl/t/data/keytab-fake
@@ -1,6 +1,6 @@
 #!/bin/sh
 #
-# keytab-fake -- Fake keytab-backend implementation.
+# Fake keytab-backend implementation.
 #
 # This keytab-fake script is meant to be run by remctld during testing of
 # the keytab object implementation.  It returns a fixed string for
diff --git a/perl/t/data/netdb-fake b/perl/t/data/netdb-fake
index ae5be18..9624102 100755
--- a/perl/t/data/netdb-fake
+++ b/perl/t/data/netdb-fake
@@ -1,6 +1,6 @@
 #!/bin/sh
 #
-# netdb-fake -- Fake NetDB remctl interface.
+# Fake NetDB remctl interface.
 #
 # This netdb-fake script is meant to be run by remctld during testing of
 # the NetDB ACL verifier.  It returns known roles or errors for different
diff --git a/perl/t/file.t b/perl/t/file.t
index 7ab5d75..a821c4f 100755
--- a/perl/t/file.t
+++ b/perl/t/file.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/file.t -- Tests for the file object implementation.
+# Tests for the file object implementation.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2008 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/init.t b/perl/t/init.t
index d0fae9f..213aedf 100755
--- a/perl/t/init.t
+++ b/perl/t/init.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/init.t -- Tests for database initialization.
+# Tests for database initialization.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t
index 6365ce5..e5fb2fa 100755
--- a/perl/t/kadmin.t
+++ b/perl/t/kadmin.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/kadmin.t -- Tests for the kadmin object implementation.
+# Tests for the kadmin object implementation.
 #
 # Written by Jon Robertson <jonrober@stanford.edu>
 # Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University
@@ -81,6 +81,9 @@ SKIP: {
     $Wallet::Config::KEYTAB_KRBTYPE   = contents ('t/data/test.krbtype');
     $Wallet::Config::KEYTAB_TMP       = '.';
 
+    # Don't destroy the user's Kerberos ticket cache.
+    $ENV{KRB5CCNAME} = 'krb5cc_test';
+
     # Create the object and clean up the principal we're going to use.
     $kadmin = eval { Wallet::Kadmin->new };
     ok (defined $kadmin, 'Creating Wallet::Kadmin object succeeds');
diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index 046da9c..b16cea5 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/keytab.t -- Tests for the keytab object implementation.
+# Tests for the keytab object implementation.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2007, 2008, 2009, 2010
diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm
index ab88b39..44a4d21 100644
--- a/perl/t/lib/Util.pm
+++ b/perl/t/lib/Util.pm
@@ -1,4 +1,4 @@
-# Util -- Utility class for wallet tests.
+# Utility class for wallet tests.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
@@ -16,7 +16,7 @@ use Wallet::Config;
 # 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.02';
+$VERSION = '0.03';
 
 use Exporter ();
 @ISA    = qw(Exporter);
diff --git a/perl/t/object.t b/perl/t/object.t
index 46e67e5..3949786 100755
--- a/perl/t/object.t
+++ b/perl/t/object.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/object.t -- Tests for the basic object implementation.
+# Tests for the basic object implementation.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/pod-spelling.t b/perl/t/pod-spelling.t
index d3ab858..6d9f7b0 100755
--- a/perl/t/pod-spelling.t
+++ b/perl/t/pod-spelling.t
@@ -9,8 +9,7 @@
 #
 # Copyright 2008, 2009 Russ Allbery <rra@stanford.edu>
 #
-# This program is free software; you may redistribute it and/or modify it
-# under the same terms as Perl itself.
+# See LICENSE for licensing terms.
 
 use strict;
 use Test::More;
diff --git a/perl/t/report.t b/perl/t/report.t
index a18b995..1dc69f7 100755
--- a/perl/t/report.t
+++ b/perl/t/report.t
@@ -1,13 +1,13 @@
 #!/usr/bin/perl -w
 #
-# t/report.t -- Tests for the wallet reporting interface.
+# Tests for the wallet reporting interface.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 83;
+use Test::More tests => 151;
 
 use Wallet::Admin;
 use Wallet::Report;
@@ -166,6 +166,79 @@ 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');
 
+# All of our ACLs should be in use.
+@lines = $report->acls ('unused');
+is (scalar (@lines), 0, 'Searching for unused ACLs returns nothing');
+is ($report->error, undef, ' with no error');
+
+# Create some unused ACLs that should show up in the report.
+is ($server->acl_create ('third'), 1, 'Creating an empty ACL succeeds');
+is ($server->acl_create ('fourth'), 1, ' and creating another succeeds');
+@lines = $report->acls ('unused');
+is (scalar (@lines), 2, ' and now we see two unused ACLs');
+is ($server->error, undef, ' with no error');
+is ($lines[0][0], 4, ' and the first has the right ID');
+is ($lines[0][1], 'third', ' and the right name');
+is ($lines[1][0], 5, ' and the second has the right ID');
+is ($lines[1][1], 'fourth', ' and the right name');
+
+# Use one of those ACLs and ensure it drops out of the report.  Test that we
+# try all of the possible ACL types.
+for my $type (qw/get store show destroy flags/) {
+    is ($server->acl ('base', 'service/admin', $type, 'fourth'), 1,
+        "Setting ACL $type to fourth succeeds");
+    @lines = $report->acls ('unused');
+    is (scalar (@lines), 1, ' and now we see only one unused ACL');
+    is ($lines[0][0], 4, ' with the right ID');
+    is ($lines[0][1], 'third', ' and the right name');
+    is ($server->acl ('base', 'service/admin', $type, ''), 1,
+        ' and clearing the ACL succeeds');
+    @lines = $report->acls ('unused');
+    is (scalar (@lines), 2, ' and now we see two unused ACLs');
+    is ($lines[0][0], 4, ' and the first has the right ID');
+    is ($lines[0][1], 'third', ' and the right name');
+    is ($lines[1][0], 5, ' and the second has the right ID');
+    is ($lines[1][1], 'fourth', ' and the right name');
+}
+
+# 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');
+
+# 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/perl/t/schema.t b/perl/t/schema.t
index 559ece4..7f0aea4 100755
--- a/perl/t/schema.t
+++ b/perl/t/schema.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/schema.t -- Tests for the wallet schema class.
+# Tests for the wallet schema class.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/server.t b/perl/t/server.t
index 090387b..ed92d6e 100755
--- a/perl/t/server.t
+++ b/perl/t/server.t
@@ -1,13 +1,13 @@
 #!/usr/bin/perl -w
 #
-# t/server.t -- Tests for the wallet server API.
+# Tests for the wallet server API.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 341;
+use Test::More tests => 355;
 
 use POSIX qw(strftime);
 use Wallet::Admin;
@@ -923,6 +923,41 @@ is ($server->error, 'base:host/default.stanford.edu rejected: host'
     . ' default.stanford.edu not in .example.edu domain',
     ' with the right error');
 
+# Ensure that we can't destroy an ACL that's in use.
+is ($server->acl_create ('test-destroy'), 1, 'Creating an ACL works');
+is ($server->create ('base', 'service/acl-user'), 1, 'Creating object works');
+is ($server->owner ('base', 'service/acl-user', 'test-destroy'), 1,
+    ' and setting owner');
+is ($server->acl_destroy ('test-destroy'), undef,
+    ' and now we cannot destroy that ACL');
+is ($server->error,
+    'cannot destroy ACL 9: ACL in use by base:service/acl-user',
+    ' with the right error');
+is ($server->owner ('base', 'service/acl-user', ''), 1,
+    ' but after we clear the owner');
+is ($server->acl_destroy ('test-destroy'), 1, ' now we can destroy the ACL');
+is ($server->destroy ('base', 'service/acl-user'), 1, ' and the object');
+
+# Test ACL naming enforcement.  Require that ACL names not contain a slash.
+package Wallet::Config;
+sub verify_acl_name {
+    my ($name, $user) = @_;
+    return 'ACL names may not contain slash' if $name =~ m,/,;
+    return;
+}
+package main;
+is ($server->acl_create ('test/naming'), undef,
+    'Creating an ACL with a disallowed name fails');
+is ($server->error, 'test/naming rejected: ACL names may not contain slash',
+    ' with the right error message');
+is ($server->acl_create ('test-naming'), 1,
+    'Creating test-naming succeeds');
+is ($server->acl_rename ('test-naming', 'test/naming'), undef,
+    ' but renaming it fails');
+is ($server->error, 'test/naming rejected: ACL names may not contain slash',
+    ' with the right error message');
+is ($server->acl_destroy ('test-naming'), 1, 'Destroying it succeeds');
+
 # Clean up.
 $setup->destroy;
 unlink 'wallet-db';
diff --git a/perl/t/verifier-netdb.t b/perl/t/verifier-netdb.t
index dcbbdd8..6bd4e73 100755
--- a/perl/t/verifier-netdb.t
+++ b/perl/t/verifier-netdb.t
@@ -1,15 +1,15 @@
 #!/usr/bin/perl -w
 #
-# t/verifier-netdb.t -- Tests for the NetDB wallet ACL verifiers.
+# Tests for the NetDB wallet ACL verifiers.
+#
+# This test can only be run by someone local to Stanford with appropriate
+# access to the NetDB role server and will be skipped in all other
+# environments.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2008 Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
-#
-# This test can only be run by someone local to Stanford with appropriate
-# access to the NetDB role server and will be skipped in all other
-# environments.
 
 use Test::More tests => 4;
 
diff --git a/perl/t/verifier.t b/perl/t/verifier.t
index 3243d9c..74d7ba8 100755
--- a/perl/t/verifier.t
+++ b/perl/t/verifier.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/verifier.t -- Tests for the basic wallet ACL verifiers.
+# Tests for the basic wallet ACL verifiers.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
@@ -39,8 +39,8 @@ is ($verifier->error, 'no principal specified', ' and right error');
 is ($verifier->check ('rra@stanford.edu', ''), undef, 'Empty ACL');
 is ($verifier->error, 'malformed krb5 ACL', ' and right error');
 
-# Tests for unchanging support.  Skip these if we don't have a keytab or if we
-# can't find remctld.
+# Tests for the NetDB verifiers.  Skip these if we don't have a keytab or if
+# we can't find remctld.
 SKIP: {
     skip 'no keytab configuration', 34 unless -f 't/data/test.keytab';
     my @path = (split (':', $ENV{PATH}), '/usr/local/sbin', '/usr/sbin');