Add support for attribute setting and retrieving to the high-level

interface with appropriate ACL support.  Retrieving is controlled by
the show ACL and setting is controlled by the store ACL, both falling
back to owner.

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');