Allow naming policy enforcement for ACL names

Wallet::Config now supports an additional local function,
verify_acl_name, which can be used to enforce ACL naming policies.  If
set, it is called for any ACL creation or rename and can reject the
new ACL name.

4 files changed, 81 insertions, 7 deletions

diff --git a/NEWS b/NEWS
index e41b86e..1f63e07 100644
--- a/NEWS
+++ b/NEWS
@@ -8,6 +8,11 @@ wallet 0.11 (unreleased)
     integrity.  This also allows us to return a better error message
     naming an object that's still using that ACL.
 
+    Wallet::Config now supports an additional local function,
+    verify_acl_name, which can be used to enforce ACL naming policies.  If
+    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().
diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm
index c86fb80..e4014a1 100644
--- a/perl/Wallet/Config.pm
+++ b/perl/Wallet/Config.pm
@@ -513,8 +513,8 @@ 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.
@@ -549,7 +549,42 @@ 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.
+
+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/Server.pm b/perl/Wallet/Server.pm
index d525fe3..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;
diff --git a/perl/t/server.t b/perl/t/server.t
index 2a178e8..ed92d6e 100755
--- a/perl/t/server.t
+++ b/perl/t/server.t
@@ -3,11 +3,11 @@
 # 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 => 349;
+use Test::More tests => 355;
 
 use POSIX qw(strftime);
 use Wallet::Admin;
@@ -938,6 +938,26 @@ is ($server->owner ('base', 'service/acl-user', ''), 1,
 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';