Attempt to create the object with a default owner on get and store

when the object doesn't exist.

2 files changed, 74 insertions, 6 deletions

diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm
index bb1a90c..429b3fb 100644
--- a/perl/Wallet/Server.pm
+++ b/perl/Wallet/Server.pm
@@ -401,10 +401,16 @@ sub owner {
 
 # Retrieve the information associated with an object, or returns undef and
 # sets the internal error if the retrieval fails or if the user isn't
-# authorized.
+# authorized.  If the object doesn't exist, attempts dynamic creation of the
+# object using the default ACL mappings (if any).
 sub get {
     my ($self, $type, $name) = @_;
     my $object = $self->retrieve ($type, $name);
+    if (not defined $object and $self->error =~ /^cannot find/) {
+        if ($self->create ($type, $name)) {
+            $object = $self->retrieve ($type, $name);
+        }
+    }
     return undef unless defined $object;
     return undef unless $self->acl_check ($object, 'get');
     my $result = $object->get ($self->{user}, $self->{host});
@@ -414,10 +420,17 @@ sub get {
 
 # Store new data in an object, or returns undef and sets the internal error if
 # the object can't be found or if the user isn't authorized.  Also don't
-# permit storing undef, although storing the empty string is fine.
+# permit storing undef, although storing the empty string is fine.  If the
+# object doesn't exist, attempts dynamic creation of the object using the
+# default ACL mappings (if any).
 sub store {
     my ($self, $type, $name, $data) = @_;
     my $object = $self->retrieve ($type, $name);
+    if (not defined $object and $self->error =~ /^cannot find/) {
+        if ($self->create ($type, $name)) {
+            $object = $self->retrieve ($type, $name);
+        }
+    }
     return undef unless defined $object;
     return undef unless $self->acl_check ($object, 'store');
     if (not defined ($data)) {
diff --git a/perl/t/server.t b/perl/t/server.t
index d709492..b0c196b 100755
--- a/perl/t/server.t
+++ b/perl/t/server.t
@@ -8,7 +8,7 @@
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 311;
+use Test::More tests => 321;
 
 use Wallet::Config;
 use Wallet::Server;
@@ -734,10 +734,12 @@ is ($server->attr ('base', 'service/both', 'foo', 'foo'), undef,
 is ($server->error, 'unknown attribute foo', ' but calls the method');
 is ($server->destroy ('base', 'service/both'), 1, ' and we can destroy it');
 is ($server->get ('base', 'service/both'), undef, ' and now cannot get it');
-is ($server->error, 'cannot find base:service/both', ' because it is gone');
+is ($server->error, "$user2 not authorized to create base:service/both",
+    ' because it is gone');
 is ($server->store ('base', 'service/both', 'stuff'), undef,
     ' or store it');
-is ($server->error, 'cannot find base:service/both', ' because it is gone');
+is ($server->error, "$user2 not authorized to create base:service/both",
+    ' because it is gone');
 
 # Test default ACLs on object creation.
 #
@@ -747,6 +749,9 @@ is ($server->error, 'cannot find base:service/both', ' because it is gone');
 # 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).
+#
+# Also add service/default-get and service/default-store to test auto-creation
+# on get and store.
 package Wallet::Config;
 sub default_owner {
     my ($type, $name) = @_;
@@ -756,6 +761,10 @@ sub default_owner {
         return ('both', [ 'krb5', $user1 ]);
     } elsif ($type eq 'base' and $name eq 'service/default-2') {
         return ('user2', [ 'krb5', $user2 ]);
+    } elsif ($type eq 'base' and $name eq 'service/default-get') {
+        return ('user2', [ 'krb5', $user2 ]);
+    } elsif ($type eq 'base' and $name eq 'service/default-store') {
+        return ('user2', [ 'krb5', $user2 ]);
     } else {
         return;
     }
@@ -789,7 +798,7 @@ EOO
     is ($server->error, undef, ' and the created object and ACL are correct');
 }
 
-# Try the other cases in default_acl.
+# Try the other basic 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",
@@ -811,6 +820,52 @@ Members of ACL user2 (id: 3) are:
 EOO
 is ($show, $expected, ' and the created object and ACL are correct');
 
+# Test auto-creation on get and store.
+$result = eval { $server->get ('base', 'service/default-get') };
+is ($result, undef, 'Auto-creation on get...');
+is ($@, "Do not instantiate Wallet::Object::Base directly\n", ' ...works');
+$show = $server->show ('base', 'service/default-get');
+$show =~ s/(Created on:) \d+$/$1 0/m;
+$expected = <<"EOO";
+           Type: base
+           Name: service/default-get
+          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');
+is ($server->get ('base', 'service/foo'), undef,
+    ' but auto-creation of something else fails');
+is ($server->error, "$user2 not authorized to create base:service/foo",
+    ' with the right error');
+is ($server->store ('base', 'service/default-store', 'stuff'), undef,
+    'Auto-creation on store...');
+is ($server->error,
+    "cannot store base:service/default-store: object type is immutable",
+    ' ...works');
+$show = $server->show ('base', 'service/default-store');
+$show =~ s/(Created on:) \d+$/$1 0/m;
+$expected = <<"EOO";
+           Type: base
+           Name: service/default-store
+          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');
+is ($server->store ('base', 'service/foo', 'stuff'), undef,
+    ' but auto-creation of something else fails');
+is ($server->error, "$user2 not authorized to create base:service/foo",
+    ' with the right error');
+
 # Now test handling of some configuration errors.
 undef $Wallet::Config::DB_DRIVER;
 $server = eval { Wallet::Server->new ($user2, $host) };