diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/Wallet/Server.pm | 64 | ||||
| -rwxr-xr-x | perl/t/server.t | 50 |
2 files changed, 109 insertions, 5 deletions
diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index 71294c8..894a52e 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -185,7 +185,11 @@ sub object_error { my ($self, $object, $action) = @_; my $user = $self->{user}; my $id = $object->type . ':' . $object->name; - if ($action !~ /^(create|get|store|show|destroy)\z/) { + if ($action eq 'getattr') { + $action = "get attributes for"; + } elsif ($action eq 'setattr') { + $action = "set attributes for"; + } elsif ($action !~ /^(create|get|store|show|destroy)\z/) { $action = "set $action for"; } $self->error ("$self->{user} not authorized to $action $id"); @@ -198,15 +202,22 @@ sub object_error { # set the ACL accordingly. sub acl_check { my ($self, $object, $action) = @_; - unless ($action =~ /^(get|store|show|destroy|flags)\z/) { + unless ($action =~ /^(get|store|show|destroy|flags|setattr|getattr)\z/) { $self->error ("unknown action $action"); return undef; } if ($action ne 'get' and $action ne 'store') { return 1 if $self->{admin}->check ($self->{user}); } - my $id = $object->acl ($action); - if (not defined ($id) and $action =~ /^(get|store|show)\z/) { + my $id; + if ($action eq 'getattr') { + $id = $object->acl ('show'); + } elsif ($action eq 'setattr') { + $id = $object->acl ('store'); + } else { + $id = $object->acl ($action); + } + if (! defined ($id) and $action =~ /^(get|(get|set)attr|store|show)\z/) { $id = $object->owner; } unless (defined $id) { @@ -252,6 +263,31 @@ sub acl { return $result; } +# Retrieves or sets an attribute on an object. +sub attr { + my ($self, $type, $name, $attr, $values) = @_; + undef $self->{error}; + my $object = $self->retrieve ($type, $name); + return undef unless defined $object; + my $user = $self->{user}; + my $host = $self->{host}; + if (defined $values) { + return unless $self->acl_check ($object, 'setattr'); + my $result = $object->attr ($attr, $values, $user, $host); + $self->error ($object->error) unless $result; + return $result; + } else { + return unless $self->acl_check ($object, 'getattr'); + my @result = $object->attr ($attr); + if (not @result and $object->error) { + $self->error ($object->error); + return; + } else { + return @result; + } + } +} + # Retrieves or sets the expiration of an object. sub expires { my ($self, $type, $name, $expires) = @_; @@ -677,6 +713,26 @@ be aware that anyone with show access to an object can see the membership of ACLs associated with that object through the show() method). Returns the human-readable description on success and undef on failure. +=item attr(TYPE, NAME, ATTRIBUTE [, VALUES]) + +Sets or retrieves a given object attribute. Attributes are used to store +backend-specific information for a particular object type and ATTRIBUTE must +be an attribute type known to the underlying object implementation. + +If VALUES is not given, returns the values of that attribute, if any, as a +list. On error, returns the empty list. To distinguish between an error +and an empty return, call error() afterwards. It is guaranteed to return +undef unless there was an error. To retrieve an attribute setting, the user +must be authorized by the ADMIN ACL, the show ACL if set, or the owner ACL +if the show ACL is not set. + +If VALUES is given, sets the given ATTRIBUTE values to VALUES, which must be +a reference to an array (even if only one value is being set). Pass a +reference to an empty array to clear the attribute values. Returns true on +success and false on failure. To set an attribute value, the user must be +authorized by the ADMIN ACL, the store ACL 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 diff --git a/perl/t/server.t b/perl/t/server.t index e061f1a..f887fd3 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -3,7 +3,7 @@ # # t/server.t -- Tests for the wallet server API. -use Test::More tests => 261; +use Test::More tests => 286; use Wallet::Config; use Wallet::Server; @@ -182,6 +182,14 @@ is ($server->expires ('base', 'service/admin', ''), 1, ' and clear it'); is ($server->expires ('base', 'service/admin'), undef, ' and now it is gone'); is ($server->error, undef, ' and still no error'); +# Test attributes. +is ($server->attr ('base', 'service/admin', 'foo'), undef, + 'Getting an attribute fails'); +is ($server->error, 'unknown attribute foo', ' but called the method'); +is ($server->attr ('base', 'service/admin', 'foo', 'foo'), undef, + ' and setting an attribute fails'); +is ($server->error, 'unknown attribute foo', ' and called the method'); + # Because we're admin, we should be able to show one of these objects, but we # still shouldn't be able to get or store since there are no ACLs. is ($server->show ('base', 'service/test'), undef, @@ -353,6 +361,8 @@ is ($server->acl ('base', 'service/both', 'show', 'user1'), 1, ' and show'); is ($server->acl ('base', 'service/both', 'destroy', 'user2'), 1, ' and destroy'); is ($server->acl ('base', 'service/both', 'flags', 'user1'), 1, ' and flags'); +is ($server->acl ('base', 'service/admin', 'store', 'user1'), 1, + 'Set admin store'); # Okay, now we can switch users and be sure we don't have admin rights. $server = eval { Wallet::Server->new ($user1, $host) }; @@ -432,6 +442,12 @@ Members of ACL user1 (id: 2) are: krb5 $user1 EOO is ($show, $expected, ' and show an object we own'); +is ($server->attr ('base', 'service/user1', 'foo'), undef, + ' and getting an attribute fails'); +is ($server->error, 'unknown attribute foo', ' but calls the method'); +is ($server->attr ('base', 'service/user1', 'foo', 'foo'), undef, + ' and setting an attribute fails'); +is ($server->error, 'unknown attribute foo', ' but calls the method'); # But not on things we don't own. is ($server->get ('base', 'service/user2'), undef, @@ -445,6 +461,16 @@ is ($server->error, "$user1 not authorized to store base:service/user2", is ($server->show ('base', 'service/user2'), undef, ' or show it'); is ($server->error, "$user1 not authorized to show base:service/user2", ' with the right error'); +is ($server->attr ('base', 'service/user2', 'foo'), undef, + ' or get attributes'); +is ($server->error, + "$user1 not authorized to get attributes for base:service/user2", + ' with the right error'); +is ($server->attr ('base', 'service/user2', 'foo', 'foo'), undef, + ' and set attributes'); +is ($server->error, + "$user1 not authorized to set attributes for base:service/user2", + ' with the right error'); # And only some things on an object we own with some ACLs. $result = eval { $server->get ('base', 'service/both') }; @@ -494,6 +520,20 @@ is ($server->destroy ('base', 'service/both'), undef, ' but not destroy it'); is ($server->error, "$user1 not authorized to destroy base:service/both", ' due to permissions'); +is ($server->attr ('base', 'service/both', 'foo'), undef, + 'Getting an attribute fails'); +is ($server->error, 'unknown attribute foo', ' but calls the method'); +is ($server->attr ('base', 'service/both', 'foo', 'foo'), undef, + ' and setting an attribute fails'); +is ($server->error, 'unknown attribute foo', ' but calls the method'); +is ($server->attr ('base', 'service/admin', 'foo', 'foo'), undef, + ' but setting an attribute on service/admin fails'); +is ($server->error, 'unknown attribute foo', ' and calls the method'); +is ($server->attr ('base', 'service/admin', 'foo'), undef, + ' while getting an attribute on service/admin fails'); +is ($server->error, + "$user1 not authorized to get attributes for base:service/admin", + ' with a permission error'); # Now switch to the other user and make sure we can do things on objects we # own. @@ -559,6 +599,14 @@ is ($server->flag_clear ('base', 'service/both', 'unchanging'), undef, is ($server->error, "$user2 not authorized to set flags for base:service/both", ' with the right error'); +is ($server->attr ('base', 'service/both', 'foo'), undef, + ' or getting an attribute'); +is ($server->error, + "$user2 not authorized to get attributes for base:service/both", + ' with the right error'); +is ($server->attr ('base', 'service/both', 'foo', 'foo'), undef, + ' but setting an attribute fails'); +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'); |