wallet-admin now supports registering new object or ACL verifier

implementations in the database.

4 files changed, 70 insertions, 5 deletions

diff --git a/NEWS b/NEWS
index 960271f..2a1ab4c 100644
--- a/NEWS
+++ b/NEWS
@@ -15,6 +15,9 @@ wallet 0.8 (unreleased)
 
     wallet-backend now supports a -q flag, which disables syslog logging.
 
+    wallet-admin now supports registering new object or ACL verifier
+    implementations in the database.
+
     Add a full end-to-end test suite to catch protocol mismatches between
     the client and server, such as the one fixed in this release.
 
diff --git a/TODO b/TODO
index d49ae10..0778867 100644
--- a/TODO
+++ b/TODO
@@ -42,9 +42,6 @@ Release 1.0:
 * On upgrades, support adding new object types and ACL verifiers to the
   class tables.
 
-* Move the methods to add additional class mappings from Wallet::Schema to
-  Wallet::Admin.
-
 * Add an option to the wallet client to read the data from a file for
   object store.  The initial implementation, depending on the underlying
   remctl support, may have to ban nul characters in the uploaded data.
diff --git a/server/wallet-admin b/server/wallet-admin
index 4dab7ae..4c27e9b 100755
--- a/server/wallet-admin
+++ b/server/wallet-admin
@@ -65,6 +65,21 @@ sub command {
         } else {
             die "only objects or acls are supported for list\n";
         }
+    } elsif ($command eq 'register') {
+        die "too many arguments to register\n" if @args > 3;
+        die "too few arguments to register\n" if @args < 3;
+        my ($object, $type, $class) = @args;
+        if ($object eq 'object') {
+            unless ($admin->register_object ($type, $class)) {
+                die $admin->error, "\n";
+            }
+        } elsif ($object eq 'verifier') {
+            unless ($admin->register_verifier ($type, $class)) {
+                die $admin->error, "\n";
+            }
+        } else {
+            die "only object or verifier is supported for register\n";
+        }
     } else {
         die "unknown command $command\n";
     }
@@ -141,6 +156,19 @@ be listed in the form:
 
 In both cases, there will be one line per ACL or object.
 
+=item register (object | verifier) <type> <class>
+
+Registers an implementation of a wallet object or ACL verifier in the
+wallet database.  The Perl class <class> is registered as the
+implementation of an object of type <type> or an ACL verifier of scheme
+<type>, allowing creation of objects with that type or ACL lines with that
+scheme.
+
+All object and ACL implementations that come with wallet are registered by
+default as part of database initialization, so this command is used
+primarily to register local implementations of additional object types or
+ACL schemes.
+
 =back
 
 =head1 SEE ALSO
diff --git a/tests/server/admin-t.in b/tests/server/admin-t.in
index ae3b4f5..177ef70 100644
--- a/tests/server/admin-t.in
+++ b/tests/server/admin-t.in
@@ -10,7 +10,7 @@
 
 use strict;
 use IO::String;
-use Test::More tests => 40;
+use Test::More tests => 54;
 
 # Create a dummy class for Wallet::Admin that prints what method was called
 # with its arguments and returns data for testing.
@@ -59,6 +59,20 @@ sub list_acls {
     return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]);
 }
 
+sub register_object {
+    shift;
+    print "register_object @_\n";
+    return if $error;
+    return 1;
+}
+
+sub register_verifier {
+    shift;
+    print "register_verifier @_\n";
+    return if $error;
+    return 1;
+}
+
 # Back to the main package and the actual test suite.  Lie about whether the
 # Wallet::Admin package has already been loaded.
 package main;
@@ -88,7 +102,8 @@ is ($out, "new\n", ' and nothing ran');
 # Check too few and too many arguments for every command.
 my %commands = (destroy    => [0, 0],
                 initialize => [1, 1],
-                list       => [1, 1]);
+                list       => [1, 1],
+                register   => [3, 3]);
 for my $command (sort keys %commands) {
     my ($min, $max) = @{ $commands{$command} };
     if ($min > 0) {
@@ -152,6 +167,20 @@ is ($out, "new\nlist_acls\n"
     . "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n",
     ' and returns the right output');
 
+# Test register.
+($out, $err) = run_admin ('register', 'foo', 'foo', 'Foo::Bar');
+is ($err, "only object or verifier is supported for register\n",
+    'Register requires object or verifier');
+is ($out, "new\n", ' and nothing was run');
+($out, $err) = run_admin ('register', 'object', 'foo', 'Foo::Object');
+is ($err, '', 'Register succeeds for object');
+is ($out, "new\nregister_object foo Foo::Object\n",
+    ' and returns the right outout');
+($out, $err) = run_admin ('register', 'verifier', 'foo', 'Foo::Verifier');
+is ($err, '', 'Register succeeds for verifier');
+is ($out, "new\nregister_verifier foo Foo::Verifier\n",
+    ' and returns the right outout');
+
 # Test error handling.
 $Wallet::Admin::error = 1;
 ($out, $err) = run_admin ('destroy');
@@ -169,6 +198,14 @@ is ($out, "new\nlist_objects\n", ' and calls the right methods');
 ($out, $err) = run_admin ('list', 'acls');
 is ($err, "some error\n", 'Error handling succeeds for list acls');
 is ($out, "new\nlist_acls\n", ' and calls the right methods');
+($out, $err) = run_admin ('register', 'object', 'foo', 'Foo::Object');
+is ($err, "some error\n", 'Error handling succeeds for register object');
+is ($out, "new\nregister_object foo Foo::Object\n",
+    ' and calls the right methods');
+($out, $err) = run_admin ('register', 'verifier', 'foo', 'Foo::Verifier');
+is ($err, "some error\n", 'Error handling succeeds for register verifier');
+is ($out, "new\nregister_verifier foo Foo::Verifier\n",
+    ' and calls the right methods');
 
 # Test empty lists.
 $Wallet::Admin::error = 0;