diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/Wallet/Server.pm | 17 | ||||
| -rwxr-xr-x | perl/t/server.t | 63 |
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) }; |