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.

2 files changed, 138 insertions, 8 deletions

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