Add support for running a user-defined function whenever an object is

created by a non-ADMIN user and using the default owner ACL returned
by that function provided that the calling user is authorized by that
ACL.  This permits dynamic creation of new objects based on a default
owner ACL programmatically determined from the name of the object.

5 files changed, 221 insertions, 16 deletions

diff --git a/NEWS b/NEWS
index d303b01..a585c03 100644
--- a/NEWS
+++ b/NEWS
@@ -2,6 +2,12 @@
 
 wallet 0.3 (unreleased)
 
+    Add support for running a user-defined function whenever an object is
+    created by a non-ADMIN user and using the default owner ACL returned
+    by that function provided that the calling user is authorized by that
+    ACL.  This permits dynamic creation of new objects based on a default
+    owner ACL programmatically determined from the name of the object.
+
     Add support for displaying the history of objects and ACLs.
 
     Add an ACL verifier that checks access against NetDB roles using the
diff --git a/TODO b/TODO
index 44b30d4..d0be3ef 100644
--- a/TODO
+++ b/TODO
@@ -16,13 +16,6 @@ Release 0.3:
 
 * Write the PTS ACL verifier.
 
-* Add support for a default creation policy and default ACLs.  The policy
-  function needs to return a list of ACLs, and we'll need an ACL function
-  to check the user against such a list rather than an ACL that already
-  exists in the database.  When we create such an object, we'll also need
-  to name the ACL, which may require fallback logic if the name was
-  already taken.
-
 * Use the class names in the database tables when loading object and
   ACL verifier implementations.
 
@@ -95,6 +88,10 @@ Release 1.0:
 * Implement a simple file wallet object.  Document a naming convention for
   those files (group-service, perhaps).
 
+* Revisit the way default ACL creation is handled.  Add a new function to
+  verify an ACL given as an array without requiring that it be in the
+  database first and write better code for comparing two ACLs.
+
 Future work:
 
 * Write a conventions document for ACL naming, object naming, and similar
diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm
index 3bd2055..ad8070b 100644
--- a/perl/Wallet/Config.pm
+++ b/perl/Wallet/Config.pm
@@ -465,6 +465,65 @@ our $NETDB_REMCTL_PORT;
 
 =back
 
+=head1 DEFAULT OWNERS
+
+By default, only users in the ADMIN ACL can create new objects in the
+wallet.  To allow other users to create new objects, define a Perl function
+named default_owner.  This function will be called whenever a non-ADMIN user
+tries to create a new object and will be passed the type and name of the
+object.  It should return undef if there is no default owner for that
+object.  If there is, it should return a list containing the name to use for
+the ACL and then zero or more anonymous arrays of two elements each giving
+the type and identifier for each ACL entry.
+
+For example, the following simple function says to use a default owner named
+C<default> with one entry of type C<krb5> and identifier C<rra@example.com>
+for the object with type C<keytab> and name C<host/example.com>:
+
+    sub default_owner {
+        my ($type, $name) = @_;
+        if ($type eq 'keytab' and $name eq 'host/example.com') {
+            return ('default', [ 'krb5', 'rra@example.com' ]);
+        } else {
+            return;
+        }
+    }
+
+Of course, normally this function is used for more complex mappings.  Here
+is a more complete example.  For objects of type keytab corresponding to
+various types of per-machine principals, return a default owner that sets as
+owner anyone with a NetDB role for that system and the system's host
+principal.  This permits authorization management using NetDB while also
+allowing the system to bootstrap itself once the host principal has been
+downloaded and rekey itself using the old host principal.
+
+    sub default_owner {
+        my ($type, $name) = @_;
+        my %allowed = map { $_ => 1 }
+            qw(HTTP cifs host imap ldap nfs pop sieve smtp webauth);
+        my $realm = 'example.com';
+        return unless $type eq 'keytab';
+        return unless $name =~ m%/%;
+        my ($service, $instance) = split ('/', $name, 2);
+        return unless $allowed{$service};
+        my $acl_name = "host/$instance";
+        my @acl = ([ 'netdb', $instance ],
+                   [ 'krb5', "host/$instance\@$realm" ]);
+        return ($acl_name, @acl);
+    }
+
+The auto-created ACL used for the owner of the new object will, in the above
+example, be named C<host/I<system>> where I<system> is the fully-qualified
+name of the system as derived from the keytab being requested.
+
+If the name of the ACL returned by the default_owner function matches an ACL
+that already exists in the wallet database, the existing ACL will be
+compared to the default ACL returned by the default_owner function.  If the
+existing ACL has the same entries as the one returned by default_owner,
+creation continues if the user is authorized by that ACL.  If they don't
+match, creation of the object is rejected, since the presence of an existing
+ACL may indicate that something different is being done with this object.
+
 =cut
 
 # Now, load the configuration file so that it can override the defaults.
diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm
index 41072a8..bb1a90c 100644
--- a/perl/Wallet/Server.pm
+++ b/perl/Wallet/Server.pm
@@ -133,11 +133,73 @@ sub DESTROY {
 # Object methods
 ##############################################################################
 
+# Given an object which doesn't currently exist, check whether a default_owner
+# function is defined and, if so, if it returns an ACL for that object.  If
+# so, create the ACL and check if the current user is authorized by that ACL.
+# Returns true if so, false if not, setting the internal error as appropriate.
+#
+# This leaves those new ACLs in the database, which may not be the best
+# behavior, but it's the simplest given the current Wallet::ACL API.  This
+# should probably be revisited later.
+sub create_check {
+    my ($self, $type, $name) = @_;
+    my $user = $self->{user};
+    my $host = $self->{host};
+    my $dbh = $self->{dbh};
+    unless (defined (&Wallet::Config::default_owner)) {
+        $self->error ("$user not authorized to create ${type}:${name}");
+        return;
+    }
+    my ($aname, @acl) = Wallet::Config::default_owner ($type, $name);
+    unless (defined $aname) {
+        $self->error ("$user not authorized to create ${type}:${name}");
+        return;
+    }
+    my $acl = eval { Wallet::ACL->new ($aname, $dbh) };
+    if ($@) {
+        $acl = eval { Wallet::ACL->create ($aname, $dbh, $user, $host) };
+        if ($@) {
+            $self->error ($@);
+            return;
+        }
+        for my $entry (@acl) {
+            unless ($acl->add ($entry->[0], $entry->[1], $user, $host)) {
+                $self->error ($acl->error);
+                return;
+            }
+        }
+    } else {
+        my @entries = $acl->list;
+        if (not @entries and $acl->error) {
+            $self->error ($acl->error);
+            return;
+        }
+        @entries = sort { $$a[0] cmp $$b[0] && $$a[1] cmp $$b[1] } @entries;
+        @acl     = sort { $$a[0] cmp $$b[0] && $$a[1] cmp $$b[1] } @acl;
+        my $okay = 1;
+        if (@entries != @acl) {
+            $okay = 0;
+        } else {
+            for my $i (0 .. $#entries) {
+                $okay = 0 unless ($entries[$i][0] eq $acl[$i][0]);
+                $okay = 0 unless ($entries[$i][1] eq $acl[$i][1]);
+            }
+        }
+        unless ($okay) {
+            $self->error ("ACL $aname exists and doesn't match default");
+            return;
+        }
+    }
+    if ($acl->check ($user)) {
+        return $aname;
+    } else {
+        $self->error ("$user not authorized to create ${type}:${name}");
+        return;
+    }
+}
+
 # Create a new object and returns that object.  On error, returns undef and
 # sets the internal error.
-#
-# For the time being, we hard-code an ACL named ADMIN to use to authorize
-# object creation.  This needs more work later.
 sub create {
     my ($self, $type, $name) = @_;
     unless ($MAPPING{$type}) {
@@ -148,15 +210,20 @@ sub create {
     my $dbh = $self->{dbh};
     my $user = $self->{user};
     my $host = $self->{host};
+    my $acl;
     unless ($self->{admin}->check ($user)) {
-        $self->error ("$user not authorized to create ${type}:${name}");
-        return undef;
+        $acl = $self->create_check ($type, $name);
+        return unless $acl;
     }
     my $object = eval { $class->create ($type, $name, $dbh, $user, $host) };
     if ($@) {
         $self->error ($@);
-        return undef;
+        return;
     } else {
+        if ($acl and not $object->owner ($acl, $user, $host)) {
+            $self->error ($object->error);
+            return;
+        }
         return 1;
     }
 }
@@ -780,10 +847,14 @@ if set, or the owner ACL if the store ACL is not set.
 =item create(TYPE, NAME)
 
 Creates a new object of type TYPE and name NAME.  TYPE must be a recognized
-type for which the wallet system has a backend implementation.  To create an
-object, the current user must be authorized by the ADMIN ACL.  Returns true
+type for which the wallet system has a backend implementation.  Returns true
 on success and false on failure.
 
+To create an object, the current user must either be authorized by the ADMIN
+ACL or authorized by the default owner as determined by the wallet
+configuration.  For more information on how to map new objects to default
+owners, see Wallet::Config(3).
+
 =item destroy(TYPE, NAME)
 
 Destroys the object identified by TYPE and NAME.  This destroys any data
diff --git a/perl/t/server.t b/perl/t/server.t
index d6ae35d..d709492 100755
--- a/perl/t/server.t
+++ b/perl/t/server.t
@@ -8,7 +8,7 @@
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 303;
+use Test::More tests => 311;
 
 use Wallet::Config;
 use Wallet::Server;
@@ -739,6 +739,78 @@ is ($server->store ('base', 'service/both', 'stuff'), undef,
     ' or store it');
 is ($server->error, 'cannot find base:service/both', ' because it is gone');
 
+# Test default ACLs on object creation.
+#
+# Create a default_acl sub that permits $user2 to create service/default with
+# a default owner of default (the same as the both ACL), $user1 to create
+# service/default-both with a default owner of both (but a different
+# definition than the existing ACL), and $user2 to create service/default-2
+# with a default owner of user2 (with the same definition as the existing
+# ACL).
+package Wallet::Config;
+sub default_owner {
+    my ($type, $name) = @_;
+    if ($type eq 'base' and $name eq 'service/default') {
+        return ('default', [ 'krb5', $user1 ], [ 'krb5', $user2 ]);
+    } elsif ($type eq 'base' and $name eq 'service/default-both') {
+        return ('both', [ 'krb5', $user1 ]);
+    } elsif ($type eq 'base' and $name eq 'service/default-2') {
+        return ('user2', [ 'krb5', $user2 ]);
+    } else {
+        return;
+    }
+}
+package main;
+
+# We're still user2, so we should now be able to create service/default.  Make
+# sure we can and that the ACLs all look good.
+is ($server->create ('base', 'service/default'), 1,
+    'Creating an object with the default ACL works');
+is ($server->create ('base', 'service/foo'), undef, ' but not any object');
+is ($server->error, "$user2 not authorized to create base:service/foo",
+    ' with the right error');
+$show = $server->show ('base', 'service/default');
+if (defined $show) {
+    $show =~ s/(Created on:) \d+$/$1 0/m;
+    $expected = <<"EOO";
+           Type: base
+           Name: service/default
+          Owner: default
+     Created by: $user2
+   Created from: $host
+     Created on: 0
+
+Members of ACL default (id: 7) are:
+  krb5 $user1
+  krb5 $user2
+EOO
+    is ($show, $expected, ' and the created object and ACL are correct');
+} else {
+    is ($server->error, undef, ' and the created object and ACL are correct');
+}
+
+# Try the other cases in default_acl.
+is ($server->create ('base', 'service/default-both'), undef,
+    'Creating an object with an ACL mismatch fails');
+is ($server->error, "ACL both exists and doesn't match default",
+    ' with the right error');
+is ($server->create ('base', 'service/default-2'), 1,
+    'Creating an object with an existing ACL works');
+$show = $server->show ('base', 'service/default-2');
+$show =~ s/(Created on:) \d+$/$1 0/m;
+$expected = <<"EOO";
+           Type: base
+           Name: service/default-2
+          Owner: user2
+     Created by: $user2
+   Created from: $host
+     Created on: 0
+
+Members of ACL user2 (id: 3) are:
+  krb5 $user2
+EOO
+is ($show, $expected, ' and the created object and ACL are correct');
+
 # Now test handling of some configuration errors.
 undef $Wallet::Config::DB_DRIVER;
 $server = eval { Wallet::Server->new ($user2, $host) };