summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--perl/Wallet/Server.pm64
-rwxr-xr-xperl/t/server.t50
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');