Add a wallet-admin program which can initialize and destroy the

database and list all objects and ACLs in the database.

8 files changed, 362 insertions, 21 deletions

diff --git a/Makefile.am b/Makefile.am
index 41772b0..d00465f 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -33,7 +33,8 @@ util_libutil_a_SOURCES = util/concat.c util/messages.c util/util.h \
 	util/xmalloc.c
 
 bin_PROGRAMS = client/wallet
-dist_sbin_SCRIPTS = server/keytab-backend server/wallet-backend
+dist_sbin_SCRIPTS = server/keytab-backend server/wallet-admin \
+	server/wallet-backend
 client_wallet_SOURCES = client/error.c client/file.c client/internal.h \
 	client/keytab.c client/krb5.c client/remctl.c client/srvtab.c \
 	client/wallet.c system.h
@@ -42,7 +43,8 @@ client_wallet_LDFLAGS = $(REMCTL_LDFLAGS)
 client_wallet_LDADD = util/libutil.a portable/libportable.a $(REMCTL_LIBS) \
 	$(KRB5_LIBS)
 
-dist_man_MANS = client/wallet.1 server/keytab-backend.8 server/wallet-backend.8
+dist_man_MANS = client/wallet.1 server/keytab-backend.8 \
+	server/wallet-admin.8 server/wallet-backend.8
 
 if AFS
 sbin_PROGRAMS = kasetkey/kasetkey
@@ -65,6 +67,10 @@ $(srcdir)/server/keytab-backend.8: $(srcdir)/server/keytab-backend
 	pod2man --release=$(VERSION) --center="Administrative Commands" \
 	    --section=8 $(srcdir)/server/keytab-backend > $@
 
+$(srcdir)/server/wallet-admin.8: $(srcdir)/server/wallet-admin
+	pod2man --release=$(VERSION) --center="Administrative Commands" \
+	    --section=8 $(srcdir)/server/wallet-admin > $@
+
 $(srcdir)/server/wallet-backend.8: $(srcdir)/server/wallet-backend
 	pod2man --release=$(VERSION) --center="Administrative Commands" \
 	    --section=8 $(srcdir)/server/wallet-backend > $@
diff --git a/NEWS b/NEWS
index 0a3550a..b6f1f8c 100644
--- a/NEWS
+++ b/NEWS
@@ -23,6 +23,9 @@ wallet 0.6 (unreleased)
     credentials for the given user and use those for authentication rather
     than using an existing ticket cache.
 
+    Add a wallet-admin program which can initialize and destroy the
+    database and list all objects and ACLs in the database.
+
     Support enforcing a naming policy for wallet objects via a Perl
     function in the wallet server configuration file.
 
diff --git a/TODO b/TODO
index be39563..b61db5b 100644
--- a/TODO
+++ b/TODO
@@ -18,11 +18,10 @@ Release 1.0:
 * Display ACL names rather than index numbers when displaying history of
   owner and acl_* settings.
 
-* Provide an interface to list all objects in the database by type, by
-  owner (including null), or by all uses of an ACL.
+* Provide a way to list all objects by type, by owner (including null), or
+  by all uses of an ACL.
 
-* Provide an interface to list all ACLs in the database.  Most
-  interestingly, an interface to list all empty ACLs.
+* Provide an interface to list all empty ACLs.
 
 * Add a help function to wallet-backend listing the commands.
 
@@ -35,8 +34,8 @@ Release 1.0:
 
 * Add a test suite for kasetkey.
 
-* Log failures in the wallet-backend properly, which also requires
-  catching all exceptions.
+* Catch exceptions on object creation in wallet-backend so that we can log
+  those as well.
 
 * Error messages from ACL operations should refer to the ACLs by name
   instead of by ID.
@@ -47,11 +46,8 @@ Release 1.0:
 * On upgrades, support adding new object types and ACL verifiers to the
   class tables.
 
-* Write a wallet-admin program and a corresponding Wallet::Admin class to
-  provide an interface to things like database initialization and,
-  eventually, upgrades.  Move the methods to add additional class mappings
-  from Wallet::Schema to Wallet::Admin and the initialize and reinitialize
-  methods from Wallet::Server to Wallet::Admin.
+* Move the methods to add additional class mappings from Wallet::Schema to
+  Wallet::Admin.
 
 * Implement store support in the wallet client.  Add an option to read the
   data from a file.  The initial implementation, depending on the
@@ -88,7 +84,8 @@ Future work:
 
 * There is a lot of duplicate code in wallet-backend.  Convert that to
   use some sort of data-driven model with argument count and flags so
-  that the method calls can be written only once.
+  that the method calls can be written only once.  Convert wallet-admin to
+  use the same code.
 
 * There's a lot of code duplication in the dispatch functions in the
   Wallet::Server class.  Find a way to rewrite that so that the dispatch
diff --git a/configure.ac b/configure.ac
index cef61eb..61574b8 100644
--- a/configure.ac
+++ b/configure.ac
@@ -62,6 +62,7 @@ AC_DEFINE([_GNU_SOURCE], [1], [Define to 1 on Linux to get full prototypes.])
 AC_CONFIG_HEADER([config.h])
 AC_CONFIG_FILES([Makefile perl/Makefile.PL])
 AC_CONFIG_FILES([tests/client/basic-t], [chmod +x tests/client/basic-t])
+AC_CONFIG_FILES([tests/server/admin-t], [chmod +x tests/server/admin-t])
 AC_CONFIG_FILES([tests/server/backend-t], [chmod +x tests/server/backend-t])
 AC_CONFIG_FILES([tests/server/keytab-t], [chmod +x tests/server/keytab-t])
 AC_CONFIG_FILES([tests/util/xmalloc-t], [chmod +x tests/util/xmalloc-t])
diff --git a/docs/setup b/docs/setup
index 582c792..ac83949 100644
--- a/docs/setup
+++ b/docs/setup
@@ -45,20 +45,15 @@ SQLite Database Setup
 Database Initialization
 
     Now, you have to create the necessary tables, indexes, and similar
-    content in the database so that the wallet can start working.  There
-    is not, as yet, any command to do this easily, but you can do it with
-    the following one line of Perl:
+    content in the database so that the wallet can start working.  Run:
 
-        perl -MWallet::Server -e "Wallet::Server->initialize ('USER')"
+        wallet-admin initialize USER
 
     where USER is the fully-qualified Kerberos principal of an
     administrator.  This will create the database, create an ADMIN ACL,
     and put USER in that ACL so that user can add other administrators and
     start creating objects.
 
-    There will eventually be a wallet-admin script to do this and similar
-    tasks.
-
 Wallet Configuration
 
     Review the Wallet::Config documentation (with man Wallet::Config or
diff --git a/server/wallet-admin b/server/wallet-admin
new file mode 100755
index 0000000..4dab7ae
--- /dev/null
+++ b/server/wallet-admin
@@ -0,0 +1,157 @@
+#!/usr/bin/perl -w
+our $ID = q$Id$;
+#
+# wallet-admin -- Wallet server administrative commands.
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2008 Board of Trustees, Leland Stanford Jr. University
+#
+# See LICENSE for licensing terms.
+
+##############################################################################
+# Declarations and site configuration
+##############################################################################
+
+use strict;
+use Wallet::Admin;
+
+##############################################################################
+# Implementation
+##############################################################################
+
+# Parse and execute a command.  We wrap this in a subroutine call for easier
+# testing.
+sub command {
+    die "Usage: wallet-admin <command> [<args> ...]\n" unless @_;
+    my $admin = Wallet::Admin->new;
+
+    # Parse command-line options and dispatch to the appropriate calls.
+    my ($command, @args) = @_;
+    if ($command eq 'destroy') {
+        die "too many arguments to destroy\n" if @args;
+        print 'This will delete all data in the wallet database.  Are you'
+            . ' sure (N/y)? ';
+        my $response = <STDIN>;
+        unless ($response and $response =~ /^y/i) {
+            die "Aborted\n";
+        }
+        $admin->destroy or die $admin->error, "\n";
+    } elsif ($command eq 'initialize') {
+        die "too many arguments to initialize\n" if @args > 1;
+        die "too few arguments to initialize\n" if @args < 1;
+        die "invalid admin principal $args[0]\n"
+            unless $args[0] =~ /^[^\@\s]+\@\S+$/;
+        $admin->initialize (@args) or die $admin->error, "\n";
+    } elsif ($command eq 'list') {
+        die "too many arguments to list\n" if @args > 1;
+        die "too few arguments to list\n" if @args < 1;
+        my ($type) = @args;
+        if ($type eq 'objects') {
+            my @objects = $admin->list_objects;
+            if (!@objects and $admin->error) {
+                die $admin->error, "\n";
+            }
+            for my $object (@objects) {
+                print join (' ', @$object), "\n";
+            }
+        } elsif ($type eq 'acls') {
+            my @acls = $admin->list_acls;
+            if (!@acls and $admin->error) {
+                die $admin->error, "\n";
+            }
+            for my $acl (sort { $$a[1] cmp $$b[1] } @acls) {
+                print "$$acl[1] (ACL ID: $$acl[0])\n";
+            }
+        } else {
+            die "only objects or acls are supported for list\n";
+        }
+    } else {
+        die "unknown command $command\n";
+    }
+}
+command (@ARGV);
+__END__
+
+##############################################################################
+# Documentation
+##############################################################################
+
+=head1 NAME
+
+wallet-admin - Wallet server administrative commands
+
+=head1 SYNOPSIS
+
+B<wallet-admin> I<command> [I<args> ...]
+
+=head1 DESCRIPTION
+
+B<wallet-admin> provides a command-line interface for performing
+administrative actions for the wallet system, such as setting up a new
+database or running reports.  It is intended to be run on the wallet
+server as a user with access to the wallet database and configuration.
+
+This program is a fairly thin wrapper around Wallet::Admin that translates
+command strings into method calls and returns the results.
+
+=head1 OPTIONS
+
+B<wallet-admin> takes no traditional options.
+
+=head1 COMMANDS
+
+=over 4
+
+=item destroy
+
+Deletes all data in the wallet database and drops all of the
+wallet-created tables, restoring the database to its state prior to an
+C<initialize> command.  Since this command is destructive and cannot be
+easily recovered from, B<wallet-admin> will prompt first to be sure the
+user intends to do this.
+
+=item initialize <principal>
+
+Given an empty database, initializes it for use with the wallet server by
+creating the necessary tables and initial metadata.  Also creates an ACL
+with the name ADMIN, used for administrative privileges to the wallet
+system, and adds an ACL entry to it with a scheme of C<krb5> and an
+instance of <principal>.  This bootstraps the authentication system and
+allows that user to make further changes to the ADMIN ACL and the rest of
+the wallet database.  C<initialize> uses C<localhost> as the hostname and
+<principal> as the user when logging the history of the ADMIN ACL creation
+and for any subsequent actions required to initialize the database.
+
+Before running C<initialize>, the wallet system has to be configured.  See
+Wallet::Config(3) for more details.  Depending on the database backend
+used, the database may also have to be created in advance.
+
+=item list (acls | objects)
+
+Returns a list of all ACLs or objects in the database.  ACLs will be
+listed in the form:
+
+    <name> (ACL ID: <id>)
+
+where <name> is the human-readable name and <id> is the numeric ID.  The
+numeric ID is what's used internally by the wallet system.  Objects will
+be listed in the form:
+
+    <type> <name>
+
+In both cases, there will be one line per ACL or object.
+
+=back
+
+=head1 SEE ALSO
+
+Wallet::Admin(3), Wallet::Config(3), wallet-backend(8)
+
+This program is part of the wallet system.  The current version is available
+from L<http://www.eyrie.org/~eagle/software/wallet/>.
+
+=head1 AUTHOR
+
+Russ Allbery <rra@stanford.edu>
+
+=cut
diff --git a/tests/TESTS b/tests/TESTS
index 298f7a6..a7dbb09 100644
--- a/tests/TESTS
+++ b/tests/TESTS
@@ -1,6 +1,7 @@
 client/basic
 portable/asprintf
 portable/snprintf
+server/admin
 server/backend
 server/keytab
 util/concat
diff --git a/tests/server/admin-t.in b/tests/server/admin-t.in
new file mode 100644
index 0000000..ae3b4f5
--- /dev/null
+++ b/tests/server/admin-t.in
@@ -0,0 +1,181 @@
+#!/usr/bin/perl -w
+# $Id$
+#
+# Tests for the wallet-admin dispatch code.
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2008 Board of Trustees, Leland Stanford Jr. University
+#
+# See LICENSE for licensing terms.
+
+use strict;
+use IO::String;
+use Test::More tests => 40;
+
+# Create a dummy class for Wallet::Admin that prints what method was called
+# with its arguments and returns data for testing.
+package Wallet::Admin;
+
+use vars qw($empty $error);
+$error = 0;
+$empty = 0;
+
+sub error {
+    if ($error) {
+        return "some error";
+    } else {
+        return;
+    }
+}
+
+sub new {
+    print "new\n";
+    return bless ({}, 'Wallet::Admin');
+}
+
+sub destroy {
+    print "destroy\n";
+    return if $error;
+    return 1;
+}
+
+sub initialize {
+    shift;
+    print "initialize @_\n";
+    return if $error;
+    return 1;
+}
+
+sub list_objects {
+    print "list_objects\n";
+    return if ($error or $empty);
+    return ([ keytab => 'host/windlord.stanford.edu' ],
+            [ file   => 'unix-wallet-password' ]);
+}
+
+sub list_acls {
+    print "list_acls\n";
+    return if ($error or $empty);
+    return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]);
+}
+
+# Back to the main package and the actual test suite.  Lie about whether the
+# Wallet::Admin package has already been loaded.
+package main;
+$INC{'Wallet/Admin.pm'} = 'FAKE';
+eval { do '@abs_top_srcdir@/server/wallet-admin' };
+
+# Run the wallet admin client.  This fun hack takes advantage of the fact that
+# the wallet admin client is written in Perl so that we can substitute our own
+# Wallet::Admin class.
+sub run_admin {
+    my (@args) = @_;
+    my $result;
+    my $output = IO::String->new (\$result);
+    $output->autoflush (1);
+    select $output;
+    eval { command (@args) };
+    my $error = $@;
+    select STDOUT;
+    return ($result, $error);
+}
+
+# Now for the actual tests.  First check for unknown commands.
+my ($out, $err) = run_admin ('foo');
+is ($err, "unknown command foo\n", 'Unknown command');
+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]);
+for my $command (sort keys %commands) {
+    my ($min, $max) = @{ $commands{$command} };
+    if ($min > 0) {
+        ($out, $err) = run_admin ($command, ('foo') x ($min - 1));
+        is ($err, "too few arguments to $command\n",
+            "Too few arguments for $command");
+        is ($out, "new\n", ' and nothing ran');
+    }
+    ($out, $err) = run_admin ($command, ('foo') x ($max + 1));
+    is ($err, "too many arguments to $command\n",
+        "Too many arguments for $command");
+    is ($out, "new\n", ' and nothing ran');
+}
+
+# Test destroy.
+my $answer = '';
+close STDIN;
+open (STDIN, '<', \$answer) or die "cannot reopen standard input: $!\n";
+($out, $err) = run_admin ('destroy');
+is ($err, "Aborted\n", 'Destroy with no answer aborts');
+is ($out, "new\n" .
+    'This will delete all data in the wallet database.  Are you sure (N/y)? ',
+    ' and prints the right prompt');
+seek (STDIN, 0, 0);
+$answer = 'n';
+($out, $err) = run_admin ('destroy');
+is ($err, "Aborted\n", 'Destroy with negative answer answer aborts');
+is ($out, "new\n" .
+    'This will delete all data in the wallet database.  Are you sure (N/y)? ',
+    ' and prints the right prompt');
+seek (STDIN, 0, 0);
+$answer = 'y';
+($out, $err) = run_admin ('destroy');
+is ($err, '', 'Destroy succeeds with a positive answer');
+is ($out, "new\n"
+    . 'This will delete all data in the wallet database.'
+    . '  Are you sure (N/y)? ' . "destroy\n", ' and destroy was run');
+seek (STDIN, 0, 0);
+
+# Test initialize.
+($out, $err) = run_admin ('initialize', 'rra');
+is ($err, "invalid admin principal rra\n", 'Initialize requires a principal');
+is ($out, "new\n", ' and nothing was run');
+($out, $err) = run_admin ('initialize', 'rra@stanford.edu');
+is ($err, '', 'Initialize succeeds with a principal');
+is ($out, "new\ninitialize rra\@stanford.edu\n", ' and runs the right code');
+
+# Test list.
+($out, $err) = run_admin ('list', 'foo');
+is ($err, "only objects or acls are supported for list\n",
+    'List requires a known object');
+is ($out, "new\n", ' and nothing was run');
+($out, $err) = run_admin ('list', 'objects');
+is ($err, '', 'List succeeds for objects');
+is ($out, "new\nlist_objects\n"
+    . "keytab host/windlord.stanford.edu\nfile unix-wallet-password\n",
+    ' and returns the right output');
+($out, $err) = run_admin ('list', 'acls');
+is ($err, '', 'List succeeds for ACLs');
+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 error handling.
+$Wallet::Admin::error = 1;
+($out, $err) = run_admin ('destroy');
+is ($err, "some error\n", 'Error handling succeeds for destroy');
+is ($out, "new\n"
+    . 'This will delete all data in the wallet database.'
+    . '  Are you sure (N/y)? ' . "destroy\n", ' and calls the right methods');
+($out, $err) = run_admin ('initialize', 'rra@stanford.edu');
+is ($err, "some error\n", 'Error handling succeeds for initialize');
+is ($out, "new\ninitialize rra\@stanford.edu\n",
+    ' and calls the right methods');
+($out, $err) = run_admin ('list', 'objects');
+is ($err, "some error\n", 'Error handling succeeds for list objects');
+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');
+
+# Test empty lists.
+$Wallet::Admin::error = 0;
+$Wallet::Admin::empty = 1;
+($out, $err) = run_admin ('list', 'objects');
+is ($err, '', 'list objects runs with an empty list with no errors');
+is ($out, "new\nlist_objects\n", ' and calls the right methods');
+($out, $err) = run_admin ('list', 'acls');
+is ($err, '', 'list acls runs with an empty list and no errors');
+is ($out, "new\nlist_acls\n", ' and calls the right methods');