diff options
| -rw-r--r-- | perl/Wallet/Server.pm | 40 | ||||
| -rwxr-xr-x | perl/t/server.t | 25 |
2 files changed, 64 insertions, 1 deletions
diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index c417451..71294c8 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -352,6 +352,34 @@ sub destroy { } ############################################################################## +# Object flag methods +############################################################################## + +# Clear a flag on an object. Takes the object and the flag. Returns true on +# success or undef and sets the internal error on failure. +sub flag_clear { + my ($self, $type, $name, $flag) = @_; + my $object = $self->retrieve ($type, $name); + return undef unless defined $object; + return undef unless $self->acl_check ($object, 'flags'); + my $result = $object->flag_clear ($flag, $self->{user}, $self->{host}); + $self->error ($object->error) unless defined $result; + return $result; +} + +# Set a flag on an object. Takes the object and the flag. Returns true on +# success or undef and sets the internal error on failure. +sub flag_set { + my ($self, $type, $name, $flag) = @_; + my $object = $self->retrieve ($type, $name); + return undef unless defined $object; + return undef unless $self->acl_check ($object, 'flags'); + my $result = $object->flag_set ($flag, $self->{user}, $self->{host}); + $self->error ($object->error) unless defined $result; + return $result; +} + +############################################################################## # ACL methods ############################################################################## @@ -692,6 +720,18 @@ seconds since epoch. To set an expiration, the current user must be authorized by the ADMIN ACL. Returns true for success and false for failure. +=item flag_clear(TYPE, NAME, FLAG) + +Clears the flag FLAG on the object identified by TYPE and NAME. To clear a +flag, the current user must be authorized by the ADMIN ACL or the flags ACL +on the object. + +=item flag_set(TYPE, NAME, FLAG) + +Sets the flag FLAG on the object identified by TYPE and NAME. To set a +flag, the current user must be authorized by the ADMIN ACL or the flags ACL +on the object. + =item get(TYPE, NAME) Returns the data associated with the object identified by TYPE and NAME. diff --git a/perl/t/server.t b/perl/t/server.t index 84fe901..8faccc1 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 => 221; +use Test::More tests => 229; use Wallet::Config; use Wallet::Server; @@ -301,6 +301,29 @@ is ($server->store ('base', 'service/admin', 'stuff'), undef, is ($server->error, "$admin not authorized to store base:service/admin", ' due to permissions again'); +# Test manipulating flags. +is ($server->flag_clear ('base', 'service/admin', 'locked'), undef, + 'Clearing an unset flag fails'); +is ($server->error, + "cannot clear flag locked on base:service/admin: flag not set", + ' with the right error'); +if ($server->flag_set ('base', 'service/admin', 'locked')) { + ok (1, ' but setting it works'); +} else { + is ($server->error, '', ' but setting it works'); +} +is ($server->flag_clear ('base', 'service/admin', 'locked'), 1, + ' and then clearing it works'); +is ($server->flag_set ('base', 'service/admin', 'unchanging'), 1, + ' and setting unchanging works'); +is ($server->flag_clear ('base', 'service/admin', 'locked'), undef, + ' and clearing locked still does not'); +is ($server->error, + "cannot clear flag locked on base:service/admin: flag not set", + ' with the right error'); +is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1, + ' and clearing unchanging works'); + # Now let's set up some additional ACLs for future tests. is ($server->owner ('base', 'service/user1', 'user1'), 1, 'Set user1 owner'); is ($server->owner ('base', 'service/user2', 'user2'), 1, 'Set user2 owner'); |