Imported Upstream version 0.11upstream/0.11

11 files changed, 210 insertions, 47 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.