Add flag clear and flag set to the public interface.

3 files changed, 96 insertions, 17 deletions

diff --git a/client/wallet.pod b/client/wallet.pod
index fd5749f..a330b0a 100644
--- a/client/wallet.pod
+++ b/client/wallet.pod
@@ -101,11 +101,11 @@ options and commands are ignored.
 =head1 COMMANDS
 
 As mentioned above, most commands are only available to wallet
-administrators.  The exceptions are C<get>, C<store>, C<show>, and
-C<destroy>.  All of those commands have their own ACLs, and if the
-appropriate ACL is set, it alone is checked to see if the user has access.
-Otherwise, C<get>, C<store>, and C<show> access is permitted if the user
-is authorized by the owner ACL of the object.
+administrators.  The exceptions are C<get>, C<store>, C<show>, C<destroy>,
+C<flag clear>, and C<flag set>.  All of those commands have their own
+ACLs, and if the appropriate ACL is set, it alone is checked to see if the
+user has access.  Otherwise, C<get>, C<store>, and C<show> access is
+permitted if the user is authorized by the owner ACL of the object.
 
 Administrators can run any command on any object or ACL except for C<get>
 and C<store>.  For C<get> and C<show>, they must still be authorized by
@@ -171,7 +171,20 @@ the object.
 
 Currently, the expiration of an object is not used.
 
-=item get <type> <output>
+=item flag clear <type> <name> <flag>
+
+Clears the flag <flag> on the object identified by <type> and <name>.
+
+=item flag set <type> <name> <flag>
+
+Sets the flag <flag> on the object identified by <type> and <name>.
+Recognized flags are C<locked>, which prevents all further actions on that
+object until the flag is cleared, and C<unchanging>, which tells the object
+backend to not generate new data on get but instead return the same data as
+previously returned.  The C<unchanging> flag is not meaningful for objects
+that do not generate new data on the fly.
+
+=item get <type> <name>
 
 Prints to standard output the data associated with the object identified
 by <type> and <name>, or stores it in a file if the B<-f> option was
diff --git a/server/wallet-backend b/server/wallet-backend
index 8777990..1eafee5 100755
--- a/server/wallet-backend
+++ b/server/wallet-backend
@@ -109,6 +109,17 @@ sub command {
                 die $server->error;
             }
         }
+    } elsif ($command eq 'flag') {
+        my $action = shift @args;
+        if ($action eq 'clear') {
+            check_args (3, [], @args);
+            $server->flag_clear (@args) or die $server->error;
+        } elsif ($action eq 'set') {
+            check_args (3, [], @args);
+            $server->flag_set (@args) or die $server->error;
+        } else {
+            die "unknown command flag $action\n";
+        }
     } elsif ($command eq 'get') {
         check_args (2, [], @args);
         my $output = $server->get (@args);
@@ -202,11 +213,11 @@ B<wallet-backend> takes no traditional options.
 =head1 COMMANDS
 
 Most commands are only available to wallet administrators (users on the
-C<ADMIN> ACL).  The exceptions are C<get>, C<store>, C<show>, and
-C<destroy>.  All of those commands have their own ACLs, and if the
-appropriate ACL is set, it alone is checked to see if the user has access.
-Otherwise, C<get>, C<store>, and C<show> access is permitted if the user is
-authorized by the owner ACL of the object.
+C<ADMIN> ACL).  The exceptions are C<get>, C<store>, C<show>, C<destroy>,
+C<flag clear>, and C<flag set>.  All of those commands have their own ACLs,
+and if the appropriate ACL is set, it alone is checked to see if the user
+has access.  Otherwise, C<get>, C<store>, and C<show> access is permitted if
+the user is authorized by the owner ACL of the object.
 
 Administrators can run any command on any object or ACL except for C<get>
 and C<store>.  For C<get> and C<show>, they must still be authorized by
@@ -272,12 +283,24 @@ the object.
 
 Currently, the expiration of an object is not used.
 
-=item get <type> <output>
+=item flag clear <type> <name> <flag>
+
+Clears the flag <flag> on the object identified by <type> and <name>.
+
+=item flag set <type> <name> <flag>
+
+Sets the flag <flag> on the object identified by <type> and <name>.
+Recognized flags are C<locked>, which prevents all further actions on that
+object until the flag is cleared, and C<unchanging>, which tells the object
+backend to not generate new data on get but instead return the same data as
+previously returned.  The C<unchanging> flag is not meaningful for objects
+that do not generate new data on the fly.
+
+=item get <type> <name>
 
-Prints to standard output the data associated with the object identified
-by <type> and <name>, or stores it in a file if the B<-f> option was
-given.  This may trigger generation of new data and invalidate old data
-for that object depending on the object type.
+Prints to standard output the data associated with the object identified by
+<type> and <name>.  This may trigger generation of new data and invalidate
+old data for that object depending on the object type.
 
 =item getacl <type> <name> <acl>
 
diff --git a/tests/server/backend-t.in b/tests/server/backend-t.in
index 408cb0f..bac2105 100644
--- a/tests/server/backend-t.in
+++ b/tests/server/backend-t.in
@@ -5,7 +5,7 @@
 
 use strict;
 use IO::String;
-use Test::More tests => 720;
+use Test::More tests => 750;
 
 # Create a dummy class for Wallet::Server that prints what method was called
 # with its arguments and returns data for testing.
@@ -48,6 +48,11 @@ sub acl_show {
     return 'acl_show';
 }
 
+sub flag_clear
+    { shift; print "flag_clear @_\n"; ($_[0] eq 'error') ? undef : 1 }
+sub flag_set
+    { shift; print "flag_set @_\n"; ($_[0] eq 'error') ? undef : 1 }
+
 sub acl {
     shift;
     print "acl @_\n";
@@ -139,6 +144,9 @@ is ($out, "$new\n", ' and nothing ran');
 ($out, $err) = run_backend ('acl', 'foo');
 is ($err, "unknown command acl foo\n", 'Unknown ACL command');
 is ($out, "$new\n", ' and nothing ran');
+($out, $err) = run_backend ('flag', 'foo');
+is ($err, "unknown command flag foo\n", 'Unknown flag command');
+is ($out, "$new\n", ' and nothing ran');
 
 # Check too few, too many, and bad arguments for every command.
 my %commands = (create  => [2, 2],
@@ -156,6 +164,8 @@ my %acl_commands = (add     => [3, 3],
                     remove  => [3, 3],
                     rename  => [2, 2],
                     show    => [1, 1]);
+my %flag_commands = (clear => [3, 3],
+                     set   => [3, 3]);
 for my $command (sort keys %commands) {
     my ($min, $max) = @{ $commands{$command} };
     ($out, $err) = run_backend ($command, ('foo') x ($min - 1));
@@ -199,6 +209,25 @@ for my $command (sort keys %acl_commands) {
         is ($out, "$new\n", ' and nothing ran');
     }
 }
+for my $command (sort keys %flag_commands) {
+    my ($min, $max) = @{ $flag_commands{$command} };
+    ($out, $err) = run_backend ('flag', $command, ('foo') x ($min - 1));
+    is ($err, "insufficient arguments\n",
+        "Too few arguments for flag $command");
+    is ($out, "$new\n", ' and nothing ran');
+    ($out, $err) = run_backend ('flag', $command, ('foo') x ($max + 1));
+    is ($err, "too many arguments\n", "Too many arguments for flag $command");
+    is ($out, "$new\n", ' and nothing ran');
+    my @base = ('foobar') x $max;
+    for my $arg (0 .. ($max - 1)) {
+        my @args = @base;
+        $args[$arg] = 'foo;bar';
+        ($out, $err) = run_backend ('flag', $command, @args);
+        is ($err, "invalid characters in argument: foo;bar\n",
+            "Invalid arguments for flag $command $arg");
+        is ($out, "$new\n", ' and nothing ran');
+    }
+}
 
 # Now, test that we ran the right functions and passed the correct arguments.
 my $error = 1;
@@ -266,6 +295,20 @@ for my $command (sort keys %acl_commands) {
         ' and ran the right method');
     $error++;
 }
+for my $command (sort keys %flag_commands) {
+    my @extra = ('foo') x ($flag_commands{$command}[0] - 2);
+    my $extra = @extra ? join (' ', '', @extra) : '';
+    ($out, $err) = run_backend ('flag', $command, 'type', 'name', @extra);
+    is ($err, '', "Command flag $command ran with no errors");
+    is ($out, "$new\nflag_$command type name$extra\n",
+        ' and ran the right method');
+    ($out, $err) = run_backend ('flag', $command, 'error', 'name', @extra);
+    is ($err, "error count $error\n",
+        "Command flag $command ran with errors");
+    is ($out, "$new\nflag_$command error name$extra\n",
+        ' and ran the right method');
+    $error++;
+}
 
 # Almost done.  All that remains is to test the robustness of the bad
 # character checks against every possible character.