Refactor reporting into a separate module and script

Move all reporting from Wallet::Admin to Wallet::Report and simplify
the method names since they're now part of a dedicated reporting
class.  Similarly, create a new wallet-report script to wrap
Wallet::Report, moving all reporting commands to it from wallet-admin,
and simplify the commands since they're for a dedicated reporting
script.

Remove the contrib script wallet-report to wallet-summary so that it
doesn't conflict with the new reporting backend script.

2 files changed, 154 insertions, 73 deletions

diff --git a/tests/server/admin-t b/tests/server/admin-t
index 570dc52..5bde104 100755
--- a/tests/server/admin-t
+++ b/tests/server/admin-t
@@ -8,15 +8,14 @@
 # See LICENSE for licensing terms.
 
 use strict;
-use Test::More tests => 64;
+use Test::More tests => 36;
 
 # 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);
+use vars qw($error);
 $error = 0;
-$empty = 0;
 
 sub error {
     if ($error) {
@@ -44,19 +43,6 @@ sub initialize {
     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' ]);
-}
-
 sub register_object {
     shift;
     print "register_object @_\n";
@@ -71,13 +57,6 @@ sub register_verifier {
     return 1;
 }
 
-sub report_owners {
-    shift;
-    print "report_owners @_\n";
-    return if ($error or $empty);
-    return ([ krb5 => 'admin@EXAMPLE.COM' ]);
-}
-
 # Back to the main package and the actual test suite.  Lie about whether the
 # Wallet::Admin package has already been loaded.
 package main;
@@ -107,9 +86,7 @@ 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,  4],
-                register   => [3,  3],
-                report     => [1, -1]);
+                register   => [3,  3]);
 for my $command (sort keys %commands) {
     my ($min, $max) = @{ $commands{$command} };
     if ($min > 0) {
@@ -159,22 +136,6 @@ is ($out, "new\n", ' and nothing was run');
 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 register.
 ($out, $err) = run_admin ('register', 'foo', 'foo', 'Foo::Bar');
 is ($err, "only object or verifier is supported for register\n",
@@ -189,15 +150,6 @@ is ($err, '', 'Register succeeds for verifier');
 is ($out, "new\nregister_verifier foo Foo::Verifier\n",
     ' and returns the right outout');
 
-# Test report.
-($out, $err) = run_admin ('report', 'foo');
-is ($err, "unknown report type foo\n", 'Report requires a known report');
-is ($out, "new\n", ' and nothing was run');
-($out, $err) = run_admin ('report', 'owners', '%', '%');
-is ($err, '', 'Report succeeds for owners');
-is ($out, "new\nreport_owners % %\nkrb5 admin\@EXAMPLE.COM\n",
-    ' and returns the right output');
-
 # Test error handling.
 $Wallet::Admin::error = 1;
 ($out, $err) = run_admin ('destroy');
@@ -209,12 +161,6 @@ is ($out, "new\n"
 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');
 ($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",
@@ -223,19 +169,3 @@ is ($out, "new\nregister_object foo Foo::Object\n",
 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');
-($out, $err) = run_admin ('report', 'owners', 'foo', 'bar');
-is ($err, "some error\n", 'Error handling succeeds for report owners');
-is ($out, "new\nreport_owners foo bar\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');
-($out, $err) = run_admin ('report', 'owners', 'foo', 'bar');
-is ($err, '', 'report owners runs with an empty list and no errors');
-is ($out, "new\nreport_owners foo bar\n", ' and calls the right methods');
diff --git a/tests/server/report-t b/tests/server/report-t
new file mode 100755
index 0000000..285ee5a
--- /dev/null
+++ b/tests/server/report-t
@@ -0,0 +1,151 @@
+#!/usr/bin/perl -w
+#
+# Tests for the wallet-report dispatch code.
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
+#
+# See LICENSE for licensing terms.
+
+use strict;
+use Test::More tests => 32;
+
+# Create a dummy class for Wallet::Report that prints what method was called
+# with its arguments and returns data for testing.
+package Wallet::Report;
+
+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::Report');
+}
+
+sub acls {
+    shift;
+    print "acls @_\n";
+    return if ($error or $empty);
+    return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]);
+}
+
+sub objects {
+    shift;
+    print "objects @_\n";
+    return if ($error or $empty);
+    return ([ keytab => 'host/windlord.stanford.edu' ],
+            [ file   => 'unix-wallet-password' ]);
+}
+
+sub owners {
+    shift;
+    print "owners @_\n";
+    return if ($error or $empty);
+    return ([ krb5 => 'admin@EXAMPLE.COM' ]);
+}
+
+# Back to the main package and the actual test suite.  Lie about whether the
+# Wallet::Report package has already been loaded.
+package main;
+$INC{'Wallet/Report.pm'} = 'FAKE';
+eval { do "$ENV{SOURCE}/../server/wallet-report" };
+
+# Run the wallet report client.  This fun hack takes advantage of the fact
+# that the wallet report client is written in Perl so that we can substitute
+# our own Wallet::Report class.
+sub run_report {
+    my (@args) = @_;
+    my $result = '';
+    open (OUTPUT, '>', \$result) or die "cannot create output string: $!\n";
+    select OUTPUT;
+    local $| = 1;
+    eval { command (@args) };
+    my $error = $@;
+    select STDOUT;
+    return ($result, $error);
+}
+
+# Now for the actual tests.  First check for unknown commands.
+my ($out, $err) = run_report ('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 = (acls    => [0, 3],
+                objects => [0, 2],
+                owners  => [2, 2]);
+for my $command (sort keys %commands) {
+    my ($min, $max) = @{ $commands{$command} };
+    if ($min > 0) {
+        ($out, $err) = run_report ($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');
+    }
+    if ($max >= 0) {
+        ($out, $err) = run_report ($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 the report methods.
+($out, $err) = run_report ('acls');
+is ($err, '', 'List succeeds for ACLs');
+is ($out, "new\nacls \n"
+    . "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n",
+    ' and returns the right output');
+($out, $err) = run_report ('acls', 'entry', 'foo', 'foo');
+is ($err, '', 'List succeeds for ACLs');
+is ($out, "new\nacls entry foo foo\n"
+    . "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n",
+    ' and returns the right output');
+($out, $err) = run_report ('objects');
+is ($err, '', 'List succeeds for objects');
+is ($out, "new\nobjects \n"
+    . "keytab host/windlord.stanford.edu\nfile unix-wallet-password\n",
+    ' and returns the right output');
+($out, $err) = run_report ('objects', 'type', 'foo');
+is ($err, '', 'List succeeds for objects type foo');
+is ($out, "new\nobjects type foo\n"
+    . "keytab host/windlord.stanford.edu\nfile unix-wallet-password\n",
+    ' and returns the right output');
+($out, $err) = run_report ('owners', '%', '%');
+is ($err, '', 'Report succeeds for owners');
+is ($out, "new\nowners % %\nkrb5 admin\@EXAMPLE.COM\n",
+    ' and returns the right output');
+
+# Test error handling.
+$Wallet::Report::error = 1;
+($out, $err) = run_report ('acls');
+is ($err, "some error\n", 'Error handling succeeds for list acls');
+is ($out, "new\nacls \n", ' and calls the right methods');
+($out, $err) = run_report ('objects');
+is ($err, "some error\n", 'Error handling succeeds for list objects');
+is ($out, "new\nobjects \n", ' and calls the right methods');
+($out, $err) = run_report ('owners', 'foo', 'bar');
+is ($err, "some error\n", 'Error handling succeeds for report owners');
+is ($out, "new\nowners foo bar\n", ' and calls the right methods');
+
+# Test empty lists.
+$Wallet::Report::error = 0;
+$Wallet::Report::empty = 1;
+($out, $err) = run_report ('acls');
+is ($err, '', 'list acls runs with an empty list and no errors');
+is ($out, "new\nacls \n", ' and calls the right methods');
+($out, $err) = run_report ('objects');
+is ($err, '', 'list objects runs with an empty list with no errors');
+is ($out, "new\nobjects \n", ' and calls the right methods');
+($out, $err) = run_report ('owners', 'foo', 'bar');
+is ($err, '', 'report owners runs with an empty list and no errors');
+is ($out, "new\nowners foo bar\n", ' and calls the right methods');