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.

14 files changed, 1016 insertions, 547 deletions

diff --git a/Makefile.am b/Makefile.am
index db6738a..05ffe53 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -16,9 +16,10 @@ PERL_FILES = perl/Wallet/ACL.pm perl/Wallet/ACL/Base.pm			    \
 	perl/Wallet/Config.pm perl/Wallet/Database.pm perl/Wallet/Kadmin.pm \
 	perl/Wallet/Kadmin/Heimdal.pm perl/Wallet/Kadmin/MIT.pm		    \
 	perl/Wallet/Object/Base.pm perl/Wallet/Object/File.pm		    \
-	perl/Wallet/Object/Keytab.pm perl/Wallet/Schema.pm		    \
-	perl/Wallet/Server.pm perl/t/acl.t perl/t/admin.t perl/t/config.t   \
-	perl/t/data/README perl/t/data/keytab-fake perl/t/data/keytab.conf  \
+	perl/Wallet/Object/Keytab.pm perl/Wallet/Report.pm		    \
+	perl/Wallet/Schema.pm perl/Wallet/Server.pm perl/t/acl.t	    \
+	perl/t/admin.t perl/t/config.t perl/t/data/README		    \
+	perl/t/data/keytab-fake perl/t/data/keytab.conf			    \
 	perl/t/data/netdb.conf perl/t/data/netdb-fake perl/t/init.t	    \
 	perl/t/keytab.t perl/t/lib/Util.pm perl/t/object.t perl/t/pod.t	    \
 	perl/t/schema.t perl/t/server.t perl/t/verifier-netdb.t		    \
@@ -28,14 +29,17 @@ AUTOMAKE_OPTIONS = foreign subdir-objects
 ACLOCAL_AMFLAGS = -I m4
 EXTRA_DIST = LICENSE autogen client/wallet.pod config/allow-extract	   \
 	config/keytab config/keytab.acl config/wallet docs/design	   \
-	contrib/README contrib/wallet-report contrib/wallet-report.8	   \
+	contrib/README contrib/wallet-summary contrib/wallet-summary.8	   \
 	docs/design-acl docs/design-api docs/netdb-role-api docs/notes	   \
 	docs/setup examples/stanford.conf tests/TESTS tests/data/README	   \
 	tests/data/allow-extract tests/data/basic.conf tests/data/cmd-fake \
 	tests/data/cmd-wrapper tests/data/fake-data tests/data/fake-kadmin \
 	tests/data/fake-keytab tests/data/fake-keytab-2			   \
 	tests/data/fake-keytab-merge tests/data/fake-keytab-old		   \
-	tests/data/fake-srvtab tests/data/wallet.conf $(PERL_FILES)
+	tests/data/fake-srvtab tests/data/wallet.conf			   \
+	tests/docs/pod-spelling-t tests/docs/pod-t tests/server/admin-t	   \
+	tests/server/backend-t tests/server/keytab-t tests/server/report-t \
+	$(PERL_FILES)
 
 noinst_LIBRARIES = portable/libportable.a util/libutil.a
 portable_libportable_a_SOURCES = portable/dummy.c portable/krb5-extra.c	\
@@ -74,11 +78,11 @@ warnings:
 
 # Remove some additional files.
 DISTCLEANFILES = perl/Makefile tests/data/.placeholder
-MAINTAINERCLEANFILES = Makefile.in aclocal.m4 build-aux/compile		\
-	build-aux/depcomp build-aux/install-sh build-aux/missing	\
-	client/wallet.1 config.h.in config.h.in~ configure		\
-	contrib/wallet-report.8 server/keytab-backend.8			\
-	server/wallet-backend.8
+MAINTAINERCLEANFILES = Makefile.in aclocal.m4 build-aux/compile		     \
+	build-aux/depcomp build-aux/install-sh build-aux/missing	     \
+	client/wallet.1 config.h.in config.h.in~ configure		     \
+	contrib/wallet-report.8 server/keytab-backend.8			     \
+	server/wallet-admin.8 server/wallet-backend.8 server/wallet-report.8
 
 # Take appropriate actions in the Perl directory as well.  We don't want to
 # always build the Perl directory in all-local, since otherwise Automake does
diff --git a/NEWS b/NEWS
index 96962f8..a87ae2f 100644
--- a/NEWS
+++ b/NEWS
@@ -32,15 +32,22 @@ wallet 0.10 (unreleased)
     Fix logging in wallet-backend and the remctl configuration to not log
     the data passed to store.
 
-    Add additional reports for wallet-admin list: objects owned by a
-    specific ACL, objects owned by no one, objects of a specific type,
-    objects with a specific flag, objects for which a specific ACL has
-    privileges, ACLs with an entry with a given type and identifier, and
-    ACLs with no members.
-
-    Add a new report owners command to wallet-admin and corresponding
-    report_owners() method to Wallet::Admin, which returns all ACL lines
-    on owner ACLs for matching objects.
+    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.
+
+    Add additional reports for wallet-report: objects owned by a specific
+    ACL, objects owned by no one, objects of a specific type, objects with
+    a specific flag, objects for which a specific ACL has privileges, ACLs
+    with an entry with a given type and identifier, and ACLs with no
+    members.
+
+    Add a new owners command to wallet-report and corresponding owners()
+    method to Wallet::Report, which returns all ACL lines on owner ACLs
+    for matching objects.
 
     Report ACL names as well as numbers in object history.
 
@@ -50,7 +57,7 @@ wallet 0.10 (unreleased)
     implementation than the wallet client.  This primarily helps with
     testing.
 
-    Update to rra-c-util 3.0:
+    Update to rra-c-util 2.3:
 
     * Use Kerberos portability layer to support Heimdal.
     * Avoid Kerberos API calls deprecated on Heimdal.
diff --git a/TODO b/TODO
index 662ea47..cca8780 100644
--- a/TODO
+++ b/TODO
@@ -2,8 +2,6 @@
 
 Release 0.10:
 
-* Move reporting code from Wallet::Admin to Wallet::Report.
-
 * Check whether we can just drop the realm restriction on keytabs and
   allow the name to contain the realm if the Kerberos type is Heimdal.
 
diff --git a/autogen b/autogen
index aeb4339..f7c8055 100755
--- a/autogen
+++ b/autogen
@@ -11,11 +11,13 @@ rm -rf autom4te.cache
 version=`grep '^wallet' NEWS | head -1 | cut -d' ' -f2`
 pod2man --release="$version" --center=wallet client/wallet.pod \
     > client/wallet.1
-pod2man --release="$version" --center=wallet -s 8 contrib/wallet-report \
-    > contrib/wallet-report.8
+pod2man --release="$version" --center=wallet -s 8 contrib/wallet-summary \
+    > contrib/wallet-summary.8
 pod2man --release="$version" --center=wallet -s 8 server/keytab-backend \
     > server/keytab-backend.8
 pod2man --release="$version" --center=wallet -s 8 server/wallet-admin \
     > server/wallet-admin.8
 pod2man --release="$version" --center=wallet -s 8 server/wallet-backend \
     > server/wallet-backend.8
+pod2man --release="$version" --center=wallet -s 8 server/wallet-report \
+    > server/wallet-report.8
diff --git a/contrib/wallet-report b/contrib/wallet-summary
index 1abe1f8..7a51f9e 100755
--- a/contrib/wallet-report
+++ b/contrib/wallet-summary
@@ -1,9 +1,9 @@
 #!/usr/bin/perl -w
 #
-# wallet-report -- Report on keytabs in the wallet database.
+# wallet-summarize -- Summarize keytabs in the wallet database.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2003, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2003, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
@@ -54,10 +54,10 @@ use Wallet::Admin ();
 # Return a list of keytab objects in the wallet database.  Currently, we only
 # report on keytab objects; reports for other objects will be added later.
 sub list_keytabs {
-    my $admin = Wallet::Admin->new;
-    my @objects = $admin->list_objects;
-    if (!@objects and $admin->error) {
-        die $admin->error;
+    my $report = Wallet::Report->new;
+    my @objects = $report->objects;
+    if (!@objects and $report->error) {
+        die $report->error;
     }
     return map { $$_[1] } grep { $$_[0] eq 'keytab' } @objects;
 }
@@ -176,11 +176,11 @@ close REPORT;
 
 =head1 NAME
 
-wallet-report - Report on keytabs in the wallet database
+wallet-summary - Report on keytabs in the wallet database
 
 =head1 SYNOPSIS
 
-wallet-report [B<-hm>]
+B<wallet-summary> [B<-hm>]
 
 =head1 DESCRIPTION
 
@@ -189,8 +189,8 @@ report of the types of principals contained therein and the total number
 of principals registered.  This report is sent to standard output by
 default, but see B<-m> below.
 
-The classifications of srvtabs are determined by a set of patterns at the
-beginning of this script.  Modify it to add new classifications.
+The classifications of principals are determined by a set of patterns at
+the beginning of this script.  Modify it to add new classifications.
 
 =head1 OPTIONS
 
diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm
index b4b3d86..e835713 100644
--- a/perl/Wallet/Admin.pm
+++ b/perl/Wallet/Admin.pm
@@ -22,7 +22,7 @@ use Wallet::Schema;
 # This version should be increased on any code change to this module.  Always
 # use two digits for the minor version with a leading zero if necessary so
 # that it will sort properly.
-$VERSION = '0.04';
+$VERSION = '0.05';
 
 ##############################################################################
 # Constructor, destructor, and accessors
@@ -111,256 +111,6 @@ sub destroy {
 }
 
 ##############################################################################
-# Reporting
-##############################################################################
-
-# Given an ACL name, translate it to the ID for that ACL and return it.
-# Often this is unneeded and could be done with a join, but by doing it in a
-# separate step, we can give an error for the specific case of someone
-# searching for a non-existant ACL.
-sub acl_name_to_id {
-    my ($self, $acl) = @_;
-    my ($id);
-    eval {
-        my $sql = 'select ac_id from acls where ac_name = ?';
-        my $sth = $self->{dbh}->prepare ($sql);
-        $sth->execute ($acl);
-        while (defined (my $row = $sth->fetchrow_hashref)) {
-            $id = $row->{ac_id};
-        }
-        $self->{dbh}->commit;
-    };
-    if (!defined $id || $id !~ /^\d+$/) {
-        $self->error ("could not find the acl $acl");
-        return '';
-    }
-    return $id;
-}
-
-# Return the SQL statement to find every object in the database.
-sub list_objects_all {
-    my ($self) = @_;
-    my $sql = 'select ob_type, ob_name from objects order by ob_type,
-        ob_name';
-    return $sql;
-}
-
-# Return the SQL statement and the search field required to find all objects
-# matching a specific type.
-sub list_objects_type {
-    my ($self, $type) = @_;
-    my $sql = 'select ob_type, ob_name from objects where ob_type=? order
-        by ob_type, ob_name';
-    return ($sql, $type);
-}
-
-# Return the SQL statement and search field required to find all objects
-# owned by a given ACL.  If the requested owner is 'null', then we ignore
-# this and do a different search for IS NULL.  If the requested owner does
-# not actually match any ACLs, set an error and return the empty string.
-sub list_objects_owner {
-    my ($self, $owner) = @_;
-    my ($sth);
-    if ($owner =~ /^null$/i) {
-        my $sql = 'select ob_type, ob_name from objects where ob_owner is null
-            order by objects.ob_type, objects.ob_name';
-        return ($sql);
-    } else {
-        my $id = $self->acl_name_to_id ($owner);
-        return '' unless $id;
-        my $sql = 'select ob_type, ob_name from objects where ob_owner = ?
-            order by objects.ob_type, objects.ob_name';
-        return ($sql, $id);
-    }
-}
-
-# Return the SQL statement and search field required to find all objects
-# that have a specific flag set.
-sub list_objects_flag {
-    my ($self, $flag) = @_;
-    my $sql = 'select ob_type, ob_name from objects left join flags on
-        (objects.ob_type = flags.fl_type and objects.ob_name = flags.fl_name)
-        where flags.fl_flag = ? order by objects.ob_type, objects.ob_name';
-    return ($sql, $flag);
-}
-
-# Return the SQL statement and search field required to find all objects
-# that a given ACL has any permissions on.  This expands from
-# list_objects_owner in that it will also match any records that have the ACL
-# set for get, store, show, destroy, or flags.  If the requested owner does
-# not actually match any ACLs, set an error and return the empty string.
-sub list_objects_acl {
-    my ($self, $acl) = @_;
-    my $id = $self->acl_name_to_id ($acl);
-    return '' unless $id;
-    my $sql = 'select ob_type, ob_name from objects where ob_owner = ? or
-        ob_acl_get = ? or ob_acl_store = ? or ob_acl_show = ? or
-        ob_acl_destroy = ? or ob_acl_flags = ? order by objects.ob_type,
-        objects.ob_name';
-    return ($sql, $id, $id, $id, $id, $id, $id);
-}
-
-# Returns a list of all objects stored in the wallet database in the form of
-# type and name pairs.  On error and for an empty database, the empty list
-# will be returned.  To distinguish between an empty list and an error, call
-# error(), which will return undef if there was no error.  Farms out specific
-# statement to another subroutine for specific search types, but each case
-# should return ob_type and ob_name in that order.
-sub list_objects {
-    my ($self, $type, @args) = @_;
-    undef $self->{error};
-
-    # Find the SQL statement and the arguments to use.
-    my $sql = '';
-    my @search = ();
-    if (!defined $type || $type eq '') {
-        ($sql) = $self->list_objects_all ();
-    } else {
-        if (@args != 1) {
-            $self->error ("object searches require an argument to search");
-        } elsif ($type eq 'type') {
-            ($sql, @search) = $self->list_objects_type (@args);
-        } elsif ($type eq 'owner') {
-            ($sql, @search) = $self->list_objects_owner (@args);
-        } elsif ($type eq 'flag') {
-            ($sql, @search) = $self->list_objects_flag (@args);
-        } elsif ($type eq 'acl') {
-            ($sql, @search) = $self->list_objects_acl (@args);
-        } else {
-            $self->error ("do not know search type: $type");
-        }
-        return unless $sql;
-    }
-
-    my @objects;
-    eval {
-        my $object;
-        my $sth = $self->{dbh}->prepare ($sql);
-        $sth->execute (@search);
-        while (defined ($object = $sth->fetchrow_arrayref)) {
-            push (@objects, [ @$object ]);
-        }
-        $self->{dbh}->commit;
-    };
-    if ($@) {
-        $self->error ("cannot list objects: $@");
-        $self->{dbh}->rollback;
-        return;
-    } else {
-        return @objects;
-    }
-}
-
-# Returns the SQL statement required to find and return all ACLs in the db.
-sub list_acls_all {
-    my ($self) = @_;
-    my $sql = 'select ac_id, ac_name from acls order by ac_id';
-    return ($sql);
-}
-
-# Returns the SQL statement required to find and returned all empty ACLs in
-# the db.
-sub list_acls_empty {
-    my ($self) = @_;
-    my $sql = 'select ac_id, ac_name from acls left join acl_entries
-        on (acls.ac_id = acl_entries.ae_id) where ae_id is null';
-    return ($sql);
-}
-
-# Returns the SQL statement and the field required to search the ACLs and
-# return only those entries which contain a entries with identifiers
-# matching a particular given string.
-sub list_acls_entry {
-    my ($self, $type, $identifier) = @_;
-    my $sql = 'select distinct ac_id, ac_name from acl_entries left join acls
-        on (ae_id = ac_id) where ae_scheme = ? and ae_identifier like ? order
-        by ac_id';
-    $identifier = '%'.$identifier.'%';
-    return ($sql, $type, $identifier);
-}
-
-# Returns a list of all ACLs stored in the wallet database as a list of pairs
-# of ACL IDs and ACL names.  On error and for an empty database, the empty
-# list will be returned; however, this is unlikely since any valid database
-# will have at least an ADMIN ACL.  Still, to distinguish between an empty
-# list and an error, call error(), which will return undef if there was no
-# error.
-sub list_acls {
-    my ($self, $type, @args) = @_;
-    undef $self->{error};
-
-    # Find the SQL statement and the arguments to use.
-    my $sql = '';
-    my @search = ();
-    if (!defined $type || $type eq '') {
-        ($sql) = $self->list_acls_all ();
-    } else {
-        if ($type eq 'entry') {
-            if (@args == 0) {
-                $self->error ("acl searches require an argument to search");
-            } else {
-                ($sql, @search) = $self->list_acls_entry (@args);
-            }
-        } elsif ($type eq 'empty') {
-            ($sql) = $self->list_acls_empty ();
-        } else {
-            $self->error ("do not know search type: $type");
-        }
-        return unless $sql;
-    }
-
-    my @acls;
-    eval {
-        my $sth = $self->{dbh}->prepare ($sql);
-        $sth->execute (@search);
-        my $object;
-        while (defined ($object = $sth->fetchrow_arrayref)) {
-            push (@acls, [ @$object ]);
-        }
-        $self->{dbh}->commit;
-    };
-    if ($@) {
-        $self->error ("cannot list ACLs: $@");
-        $self->{dbh}->rollback;
-        return;
-    } else {
-        return @acls;
-    }
-}
-
-# Returns a report of all ACL lines contained in owner ACLs for matching
-# objects.  Objects are specified by type and name, which may be SQL wildcard
-# expressions.  Each list member will be a pair of ACL scheme and ACL
-# identifier, with duplicates removed.  On error and for no matching entries,
-# the empty list will be returned.  To distinguish between an empty return and
-# an error, call error(), which will return undef if there was no error.
-sub report_owners {
-    my ($self, $type, $name) = @_;
-    undef $self->{error};
-    my @lines;
-    eval {
-        my $sql = 'select distinct ae_scheme, ae_identifier from acl_entries,
-            acls, objects where ae_id = ac_id and ac_id = ob_owner and
-            ob_type like ? and ob_name like ? order by ae_scheme,
-            ae_identifier';
-        my $sth = $self->{dbh}->prepare ($sql);
-        $sth->execute ($type, $name);
-        my $object;
-        while (defined ($object = $sth->fetchrow_arrayref)) {
-            push (@lines, [ @$object ]);
-        }
-        $self->{dbh}->commit;
-    };
-    if ($@) {
-        $self->error ("cannot report on owners: $@");
-        $self->{dbh}->rollback;
-        return;
-    } else {
-        return @lines;
-    }
-}
-
-##############################################################################
 # Object registration
 ##############################################################################
 
@@ -414,7 +164,7 @@ __DATA__
 Wallet::Admin - Wallet system administrative interface
 
 =for stopwords
-ACL hostname ACLs SQL wildcard Allbery
+ACL hostname Allbery
 
 =head1 SYNOPSIS
 
@@ -478,52 +228,6 @@ 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 on the object it returns.
 
-=item list_acls(TYPE, SEARCH)
-
-Returns a list of all ACLs matching a search type and string in the
-database, or all ACLs if no search information is given.  The return value
-is a list of references to pairs of ACL ID and name.  For example, if
-there are two ACLs in the database, one with name "ADMIN" and ID 1 and one
-with name "group/admins" and ID 3, list_acls() with no arguments would
-return:
-
-    ([ 1, 'ADMIN' ], [ 3, 'group/admins' ])
-
-Returns the empty list on failure.  Any valid wallet database should have
-at least one ACL, but an error can be distinguished from the odd case of a
-database with no ACLs by calling error().  error() is guaranteed to return
-the error message if there was an error and undef if there was no error.
-
-There are currently two search types.  C<empty> takes no arguments and
-will return only those ACLs that have no entries within them.  C<entry>
-takes two arguments, an entry scheme and an entry identifier, and will
-return any ACLs with an entry that matches the given scheme and contains
-the given identifier.
-
-=item list_objects(TYPE, SEARCH)
-
-Returns a list of all objects matching a search type and string in the
-database, or all objects in the database if no search information is
-given.  The return value is a list of references to pairs of type and
-name.  For example, if two objects existed in the database, both of type
-C<keytab> and with values C<host/example.com> and C<foo>, list_objects()
-with no arguments would return:
-
-    ([ 'keytab', 'host/example.com' ], [ 'keytab', 'foo' ])
-
-Returns the empty list on failure.  To distinguish between this and a
-database containing no objects, the caller should call error().  error()
-is guaranteed to return the error message if there was an error and undef
-if there was no error.
-
-There are four types of searches currently.  C<type> (with a given type)
-will return only those entries where the type matches the given type.
-C<owner>, with a given owner, will only return those objects owned by the
-given ACL name.  C<flag>, with a given flag name, will only return those
-items with a flag set to the given value.  C<acl> operates like C<owner>,
-but will return only those objects that have the given ACL name on any of
-the possible ACL settings, not just owner.
-
 =item register_object (TYPE, CLASS)
 
 Register in the database a mapping from the object type TYPE to the class
@@ -545,17 +249,6 @@ be deleted and a fresh set of wallet database tables will be created.
 This method is equivalent to calling destroy() followed by initialize().
 Returns true on success and false on failure.
 
-=item report_owners(TYPE, NAME)
-
-Returns a list of all ACL lines contained in owner ACLs for objects
-matching TYPE and NAME, which are interpreted as SQL patterns using C<%>
-as a wildcard.  The return value is a list of references to pairs of
-schema and identifier, with duplicates removed.
-
-Returns the empty list on failure.  To distinguish between this and no
-matches, the caller should call error().  error() is guaranteed to return
-the error message if there was an error and undef if there was no error.
-
 =back
 
 =head1 SEE ALSO
diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm
new file mode 100644
index 0000000..7cd8653
--- /dev/null
+++ b/perl/Wallet/Report.pm
@@ -0,0 +1,425 @@
+# Wallet::Report -- Wallet system reporting interface.
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
+#
+# See LICENSE for licensing terms.
+
+##############################################################################
+# Modules and declarations
+##############################################################################
+
+package Wallet::Report;
+require 5.006;
+
+use strict;
+use vars qw($VERSION);
+
+use Wallet::Database;
+
+# This version should be increased on any code change to this module.  Always
+# use two digits for the minor version with a leading zero if necessary so
+# that it will sort properly.
+$VERSION = '0.01';
+
+##############################################################################
+# Constructor, destructor, and accessors
+##############################################################################
+
+# Create a new wallet report object.  Opens a connection to the database that
+# will be used for all of the wallet configuration information.  Throw an
+# exception if anything goes wrong.
+sub new {
+    my ($class) = @_;
+    my $dbh = Wallet::Database->connect;
+    my $self = { dbh => $dbh };
+    bless ($self, $class);
+    return $self;
+}
+
+# Returns the database handle (used mostly for testing).
+sub dbh {
+    my ($self) = @_;
+    return $self->{dbh};
+}
+
+# Set or return the error stashed in the object.
+sub error {
+    my ($self, @error) = @_;
+    if (@error) {
+        my $error = join ('', @error);
+        chomp $error;
+        1 while ($error =~ s/ at \S+ line \d+\.?\z//);
+        $self->{error} = $error;
+    }
+    return $self->{error};
+}
+
+# Disconnect the database handle on object destruction to avoid warnings.
+sub DESTROY {
+    my ($self) = @_;
+    $self->{dbh}->disconnect unless $self->{dbh}->{InactiveDestroy};
+}
+
+##############################################################################
+# Object reports
+##############################################################################
+
+# Return the SQL statement to find every object in the database.
+sub objects_all {
+    my ($self) = @_;
+    my $sql = 'select ob_type, ob_name from objects order by ob_type,
+        ob_name';
+    return $sql;
+}
+
+# Return the SQL statement and the search field required to find all objects
+# matching a specific type.
+sub objects_type {
+    my ($self, $type) = @_;
+    my $sql = 'select ob_type, ob_name from objects where ob_type=? order
+        by ob_type, ob_name';
+    return ($sql, $type);
+}
+
+# Return the SQL statement and search field required to find all objects owned
+# by a given ACL.  If the requested owner is null, we ignore this and do a
+# different search for IS NULL.  If the requested owner does not actually
+# match any ACLs, set an error and return undef.
+sub objects_owner {
+    my ($self, $owner) = @_;
+    my ($sth);
+    if (lc ($owner) eq 'null') {
+        my $sql = 'select ob_type, ob_name from objects where ob_owner is null
+            order by objects.ob_type, objects.ob_name';
+        return ($sql);
+    } else {
+        my $acl = eval { Wallet::ACL->new ($owner, $self->{dbh}) };
+        return unless $acl;
+        my $sql = 'select ob_type, ob_name from objects where ob_owner = ?
+            order by objects.ob_type, objects.ob_name';
+        return ($sql, $acl->id);
+    }
+}
+
+# Return the SQL statement and search field required to find all objects that
+# have a specific flag set.
+sub objects_flag {
+    my ($self, $flag) = @_;
+    my $sql = 'select ob_type, ob_name from objects left join flags on
+        (objects.ob_type = flags.fl_type and objects.ob_name = flags.fl_name)
+        where flags.fl_flag = ? order by objects.ob_type, objects.ob_name';
+    return ($sql, $flag);
+}
+
+# Return the SQL statement and search field required to find all objects that
+# a given ACL has any permissions on.  This expands from objects_owner in that
+# it will also match any records that have the ACL set for get, store, show,
+# destroy, or flags.  If the requested owner does not actually match any ACLs,
+# set an error and return the empty string.
+sub objects_acl {
+    my ($self, $search) = @_;
+    my $acl = eval { Wallet::ACL->new ($search, $self->{dbh}) };
+    return unless $acl;
+    my $sql = 'select ob_type, ob_name from objects where ob_owner = ? or
+        ob_acl_get = ? or ob_acl_store = ? or ob_acl_show = ? or
+        ob_acl_destroy = ? or ob_acl_flags = ? order by objects.ob_type,
+        objects.ob_name';
+    return ($sql, ($acl->id) x 6);
+}
+
+# Returns a list of all objects stored in the wallet database in the form of
+# type and name pairs.  On error and for an empty database, the empty list
+# will be returned.  To distinguish between an empty list and an error, call
+# error(), which will return undef if there was no error.  Farms out specific
+# statement to another subroutine for specific search types, but each case
+# should return ob_type and ob_name in that order.
+sub objects {
+    my ($self, $type, @args) = @_;
+    undef $self->{error};
+
+    # Find the SQL statement and the arguments to use.
+    my $sql = '';
+    my @search = ();
+    if (!defined $type || $type eq '') {
+        ($sql) = $self->objects_all;
+    } else {
+        if (@args != 1) {
+            $self->error ("object searches require one argument to search");
+        } elsif ($type eq 'type') {
+            ($sql, @search) = $self->objects_type (@args);
+        } elsif ($type eq 'owner') {
+            ($sql, @search) = $self->objects_owner (@args);
+        } elsif ($type eq 'flag') {
+            ($sql, @search) = $self->objects_flag (@args);
+        } elsif ($type eq 'acl') {
+            ($sql, @search) = $self->objects_acl (@args);
+        } else {
+            $self->error ("do not know search type: $type");
+        }
+        return unless $sql;
+    }
+
+    # Do the search.
+    my @objects;
+    eval {
+        my $sth = $self->{dbh}->prepare ($sql);
+        $sth->execute (@search);
+        my $object;
+        while (defined ($object = $sth->fetchrow_arrayref)) {
+            push (@objects, [ @$object ]);
+        }
+        $self->{dbh}->commit;
+    };
+    if ($@) {
+        $self->error ("cannot list objects: $@");
+        $self->{dbh}->rollback;
+        return;
+    }
+    return @objects;
+}
+
+##############################################################################
+# ACL reports
+##############################################################################
+
+# Returns the SQL statement required to find and return all ACLs in the
+# database.
+sub acls_all {
+    my ($self) = @_;
+    my $sql = 'select ac_id, ac_name from acls order by ac_id';
+    return ($sql);
+}
+
+# Returns the SQL statement required to find all empty ACLs in the database.
+sub acls_empty {
+    my ($self) = @_;
+    my $sql = 'select ac_id, ac_name from acls left join acl_entries
+        on (acls.ac_id = acl_entries.ae_id) where ae_id is null';
+    return ($sql);
+}
+
+# Returns the SQL statement and the field required to find ACLs containing the
+# specified entry.  The identifier is automatically surrounded by wildcards to
+# do a substring search.
+sub acls_entry {
+    my ($self, $type, $identifier) = @_;
+    my $sql = 'select distinct ac_id, ac_name from acl_entries left join acls
+        on (ae_id = ac_id) where ae_scheme = ? and ae_identifier like ? order
+        by ac_id';
+    return ($sql, $type, '%' . $identifier . '%');
+}
+
+# Returns a list of all ACLs stored in the wallet database as a list of pairs
+# of ACL IDs and ACL names, possibly limited by some criteria.  On error and
+# for an empty database, the empty list will be returned.  To distinguish
+# between an empty list and an error, call error(), which will return undef if
+# there was no error.
+sub acls {
+    my ($self, $type, @args) = @_;
+    undef $self->{error};
+
+    # Find the SQL statement and the arguments to use.
+    my $sql;
+    my @search = ();
+    if (!defined $type || $type eq '') {
+        ($sql) = $self->acls_all;
+    } else {
+        if ($type eq 'entry') {
+            if (@args == 0) {
+                $self->error ('ACL searches require an argument to search');
+                return;
+            } else {
+                ($sql, @search) = $self->acls_entry (@args);
+            }
+        } elsif ($type eq 'empty') {
+            ($sql) = $self->acls_empty;
+        } else {
+            $self->error ("do not know search type: $type");
+            return;
+        }
+    }
+
+    # Do the search.
+    my @acls;
+    eval {
+        my $sth = $self->{dbh}->prepare ($sql);
+        $sth->execute (@search);
+        my $object;
+        while (defined ($object = $sth->fetchrow_arrayref)) {
+            push (@acls, [ @$object ]);
+        }
+        $self->{dbh}->commit;
+    };
+    if ($@) {
+        $self->error ("cannot list ACLs: $@");
+        $self->{dbh}->rollback;
+        return;
+    }
+    return @acls;
+}
+
+# Returns all ACL entries contained in owner ACLs for matching objects.
+# Objects are specified by type and name, which may be SQL wildcard
+# expressions.  Each list member will be a pair of ACL scheme and ACL
+# identifier, with duplicates removed.  On error and for no matching entries,
+# the empty list will be returned.  To distinguish between an empty return and
+# an error, call error(), which will return undef if there was no error.
+sub owners {
+    my ($self, $type, $name) = @_;
+    undef $self->{error};
+    my @lines;
+    eval {
+        my $sql = 'select distinct ae_scheme, ae_identifier from acl_entries,
+            acls, objects where ae_id = ac_id and ac_id = ob_owner and
+            ob_type like ? and ob_name like ? order by ae_scheme,
+            ae_identifier';
+        my $sth = $self->{dbh}->prepare ($sql);
+        $sth->execute ($type, $name);
+        my $object;
+        while (defined ($object = $sth->fetchrow_arrayref)) {
+            push (@lines, [ @$object ]);
+        }
+        $self->{dbh}->commit;
+    };
+    if ($@) {
+        $self->error ("cannot report on owners: $@");
+        $self->{dbh}->rollback;
+        return;
+    }
+    return @lines;
+}
+
+1;
+__DATA__
+
+##############################################################################
+# Documentation
+##############################################################################
+
+=head1 NAME
+
+Wallet::Report - Wallet system reporting interface
+
+=for stopwords
+ACL ACLs wildcard Allbery SQL tuples
+
+=head1 SYNOPSIS
+
+    use Wallet::Report;
+    my $report = Wallet::Report->new;
+    my @objects = $report->objects ('type', 'keytab');
+    for my $object (@objects) {
+        print "@$object\n";
+    }
+
+=head1 DESCRIPTION
+
+Wallet::Report provides a mechanism to generate lists and reports on the
+contents of the wallet database.  The format of the results returned
+depend on the type of search, but will generally be returned as a list of
+tuples identifying objects, ACLs, or ACL entries.
+
+To use this object, several configuration variables must be set (at least
+the database configuration).  For information on those variables and how
+to set them, see Wallet::Config(3).  For more information on the normal
+user interface to the wallet server, see Wallet::Server(3).
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item new()
+
+Creates a new wallet report object and connects to the database.  On any
+error, this method throws an exception.
+
+=back
+
+=head1 INSTANCE METHODS
+
+For all methods that can fail, the caller should call error() after a
+failure to get the error message.  For all methods that return lists, if
+they return an empty list, the caller should call error() to distinguish
+between an empty report and an error.
+
+=over 4
+
+=item acls([ TYPE [, SEARCH ... ]])
+
+Returns a list of all ACLs matching a search type and string in the
+database, or all ACLs if no search information is given.  There are
+currently two search types.  C<empty> takes no arguments and will return
+only those ACLs that have no entries within them.  C<entry> takes two
+arguments, an entry scheme and a (possibly partial) entry identifier, and
+will return any ACLs containing an entry with that scheme and with an
+identifier containing that value.
+
+The return value is a list of references to pairs of ACL ID and name.  For
+example, if there are two ACLs in the database, one with name C<ADMIN> and
+ID 1 and one with name C<group/admins> and ID 3, acls() with no arguments
+would return:
+
+    ([ 1, 'ADMIN' ], [ 3, 'group/admins' ])
+
+Returns the empty list on failure.  An error can be distinguished from
+empty search results by calling error().  error() is guaranteed to return
+the error message if there was an error and undef if there was no error.
+
+=item error()
+
+Returns the error of the last failing operation or undef if no operations
+have failed.  Callers should call this function to get the error message
+after an undef return from any other instance method.
+
+=item objects([ TYPE [, SEARCH ... ]])
+
+Returns a list of all objects matching a search type and string in the
+database, or all objects in the database if no search information is
+given.
+
+There are four types of searches currently.  C<type>, with a given type,
+will return only those entries where the type matches the given type.
+C<owner>, with a given owner, will only return those objects owned by the
+given ACL name or ID.  C<flag>, with a given flag name, will only return
+those items with a flag set to the given value.  C<acl> operates like
+C<owner>, but will return only those objects that have the given ACL name
+or ID on any of the possible ACL settings, not just owner.
+
+The return value is a list of references to pairs of type and name.  For
+example, if two objects existed in the database, both of type C<keytab>
+and with values C<host/example.com> and C<foo>, objects() with no
+arguments would return:
+
+    ([ 'keytab', 'host/example.com' ], [ 'keytab', 'foo' ])
+
+Returns the empty list on failure.  To distinguish between this and an
+empty search result, the caller should call error().  error() is
+guaranteed to return the error message if there was an error and undef if
+there was no error.
+
+=item owners(TYPE, NAME)
+
+Returns a list of all ACL lines contained in owner ACLs for objects
+matching TYPE and NAME, which are interpreted as SQL patterns using C<%>
+as a wildcard.  The return value is a list of references to pairs of
+schema and identifier, with duplicates removed.
+
+Returns the empty list on failure.  To distinguish between this and no
+matches, the caller should call error().  error() is guaranteed to return
+the error message if there was an error and undef if there was no error.
+
+=back
+
+=head1 SEE ALSO
+
+Wallet::Config(3), Wallet::Server(3)
+
+This module 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> and Jon Robertson <jonrober@stanford.edu>.
+
+=cut
diff --git a/perl/t/admin.t b/perl/t/admin.t
index f94b39b..e22088e 100755
--- a/perl/t/admin.t
+++ b/perl/t/admin.t
@@ -3,13 +3,14 @@
 # t/admin.t -- Tests for wallet administrative interface.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 83;
+use Test::More tests => 16;
 
 use Wallet::Admin;
+use Wallet::Report;
 use Wallet::Schema;
 use Wallet::Server;
 
@@ -25,10 +26,11 @@ is ($admin->initialize ('admin@EXAMPLE.COM'), 1,
     ' and initialization succeeds');
 
 # We have an empty database, so we should see no objects and one ACL.
-my @objects = $admin->list_objects;
+my $report = Wallet::Report->new;
+my @objects = $report->objects;
 is (scalar (@objects), 0, 'No objects in the database');
-is ($admin->error, undef, ' and no error');
-my @acls = $admin->list_acls;
+is ($report->error, undef, ' and no error');
+my @acls = $report->acls;
 is (scalar (@acls), 1, 'One ACL in the database');
 is ($acls[0][0], 1, ' and that is ACL ID 1');
 is ($acls[0][1], 'ADMIN', ' with the right name');
@@ -36,137 +38,20 @@ is ($acls[0][1], 'ADMIN', ' with the right name');
 # Register a base object so that we can create a simple object.
 is ($admin->register_object ('base', 'Wallet::Object::Base'), 1,
     'Registering Wallet::Object::Base works');
-
-# Create an object.
+is ($admin->register_object ('base', 'Wallet::Object::Base'), undef,
+    ' and cannot be registered twice');
 $server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') };
 is ($@, '', 'Creating a server instance did not die');
 is ($server->create ('base', 'service/admin'), 1,
     ' and creating base:service/admin succeeds');
 
-# Now, we should see one object.
-@objects = $admin->list_objects;
-is (scalar (@objects), 1, ' and now there is one object');
-is ($objects[0][0], 'base', ' with the right type');
-is ($objects[0][1], 'service/admin', ' and the right name');
-
-# Test registering a new ACL type.  We don't have a good way of really using
-# this right now.
+# Test registering a new ACL type.
 is ($admin->register_verifier ('base', 'Wallet::ACL::Base'), 1,
     'Registering Wallet::ACL::Base works');
-
-# Create another ACL.
-is ($server->acl_create ('first'), 1, 'ACL creation succeeds');
-@acls = $admin->list_acls;
-is (scalar (@acls), 2, ' and now there are two ACLs');
-is ($acls[0][0], 1, ' and the first ID is correct');
-is ($acls[0][1], 'ADMIN', ' and the first name is correct');
-is ($acls[1][0], 2, ' and the second ID is correct');
-is ($acls[1][1], 'first', ' and the second name is correct');
-
-# Delete that ACL and create another.
-is ($server->acl_create ('second'), 1, 'Second ACL creation succeeds');
-is ($server->acl_destroy ('first'), 1, ' and deletion of the first succeeds');
-@acls = $admin->list_acls;
-is (scalar (@acls), 2, ' and there are still two ACLs');
-is ($acls[0][0], 1, ' and the first ID is still the same');
-is ($acls[0][1], 'ADMIN', ' and the first name is still the same');
-is ($acls[1][0], 3, ' but the second ID has changed');
-is ($acls[1][1], 'second', ' and the second name is correct');
-
-# Currently, we have no owners, so we should get an empty owner report.
-my @lines = $admin->report_owners ('%', '%');
-is (scalar (@lines), 0, 'Owner report is currently empty');
-is ($admin->error, undef, ' and there is no error');
-
-# Set an owner and make sure we now see something in the report.
-is ($server->owner ('base', 'service/admin', 'ADMIN'), 1,
-    'Setting an owner works');
-@lines = $admin->report_owners ('%', '%');
-is (scalar (@lines), 1, ' and now there is one owner in the report');
-is ($lines[0][0], 'krb5', ' with the right scheme');
-is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier');
-@lines = $admin->report_owners ('keytab', '%');
-is (scalar (@lines), 0, 'Owners of keytabs is empty');
-is ($admin->error, undef, ' with no error');
-@lines = $admin->report_owners ('base', 'foo/%');
-is (scalar (@lines), 0, 'Owners of base foo/* objects is empty');
-is ($admin->error, undef, ' with no error');
-
-# Create a second object with the same owner.
-is ($server->create ('base', 'service/foo'), 1,
-    'Creating base:service/foo succeeds');
-is ($server->owner ('base', 'service/foo', 'ADMIN'), 1,
-    ' and setting the owner to the same value works');
-@lines = $admin->report_owners ('base', 'service/%');
-is (scalar (@lines), 1, ' and there is still owner in the report');
-is ($lines[0][0], 'krb5', ' with the right scheme');
-is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier');
-
-# Change the owner of the second object to an empty ACL.
-is ($server->owner ('base', 'service/foo', 'second'), 1,
-    ' and changing the owner to an empty ACL works');
-@lines = $admin->report_owners ('base', '%');
-is (scalar (@lines), 1, ' and there is still owner in the report');
-is ($lines[0][0], 'krb5', ' with the right scheme');
-is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier');
-
-# Add a few things to the second ACL to see what happens.
-is ($server->acl_add ('second', 'base', 'foo'), 1,
-    'Adding an ACL line to the new ACL works');
-is ($server->acl_add ('second', 'base', 'bar'), 1,
-    ' and adding another ACL line to the new ACL works');
-@lines = $admin->report_owners ('base', '%');
-is (scalar (@lines), 3, ' and now there are three owners in the report');
-is ($lines[0][0], 'base', ' first has the right scheme');
-is ($lines[0][1], 'bar', ' and the right identifier');
-is ($lines[1][0], 'base', ' second has the right scheme');
-is ($lines[1][1], 'foo', ' and the right identifier');
-is ($lines[2][0], 'krb5', ' third has the right scheme');
-is ($lines[2][1], 'admin@EXAMPLE.COM', ' and the right identifier');
-
-# Test ownership and other ACL values.  Change one keytab to be not owned by
-# ADMIN, but have group permission on it.  We'll need a third object neither
-# owned by ADMIN or with any permissions from it.
-is ($server->create ('base', 'service/null'), 1,
-    'Creating base:service/null succeeds');
-is ($server->acl ('base', 'service/foo', 'get', 'ADMIN'), 1,
-    'Changing the get ACL for the search also does');
-@lines = $admin->list_objects ('owner', 'ADMIN');
-is (scalar (@lines), 1, 'Searching for objects owned by ADMIN finds one');
-is ($lines[0][0], 'base', ' and it has the right type');
-is ($lines[0][1], 'service/admin', ' and the right name');
-@lines = $admin->list_objects ('owner', 'null');
-is (scalar (@lines), 1, 'Searching for objects with no set ownerfinds one');
-is ($lines[0][0], 'base', ' and it has the right type');
-is ($lines[0][1], 'service/null', ' and the right name');
-@lines = $admin->list_objects ('acl', 'ADMIN');
-is (scalar (@lines), 2, 'ADMIN has any rights at all on two objects');
-is ($lines[0][0], 'base', ' and the first has the right type');
-is ($lines[0][1], 'service/admin', ' and the right name');
-is ($lines[1][0], 'base', ' and the second has the right type');
-is ($lines[1][1], 'service/foo', ' and the right name');
-
-# Listing objects of a specific type.
-@lines = $admin->list_objects ('type', 'base');
-is (scalar (@lines), 3, 'Searching for all objects of type base finds three');
-is ($lines[0][0], 'base', ' and the first has the right type');
-is ($lines[0][1], 'service/admin', ' and the right name');
-is ($lines[1][0], 'base', ' and the second has the right type');
-is ($lines[1][1], 'service/foo', ' and the right name');
-is ($lines[2][0], 'base', ' and the third has the right type');
-is ($lines[2][1], 'service/null', ' and the right name');
-@lines = $admin->list_objects ('type', 'keytab');
-is (scalar (@lines), 0, 'Searching for all objects of type keytab finds none');
-
-# Test setting a flag, searching for objects with it, and then clearing it.
-is ($server->flag_set ('base', 'service/admin', 'unchanging'), 1,
-    'Setting a flag works');
-@lines = $admin->list_objects ('flag', 'unchanging');
-is (scalar (@lines), 1, 'Searching for all objects with that flag finds one');
-is ($lines[0][0], 'base', ' and it has the right type');
-is ($lines[0][1], 'service/admin', ' and the right name');
-is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1,
-    'Clearing the flag works');
+is ($admin->register_verifier ('base', 'Wallet::ACL::Base'), undef,
+    ' and cannot be registered twice');
+is ($server->acl_add ('ADMIN', 'base', 'foo'), 1,
+    ' and adding a base ACL now works');
 
 # Clean up.
 is ($admin->destroy, 1, 'Destruction succeeds');
diff --git a/perl/t/report.t b/perl/t/report.t
new file mode 100755
index 0000000..a18b995
--- /dev/null
+++ b/perl/t/report.t
@@ -0,0 +1,171 @@
+#!/usr/bin/perl -w
+#
+# t/report.t -- Tests for the wallet reporting interface.
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
+#
+# See LICENSE for licensing terms.
+
+use Test::More tests => 83;
+
+use Wallet::Admin;
+use Wallet::Report;
+use Wallet::Server;
+
+use lib 't/lib';
+use Util;
+
+# Use Wallet::Admin to set up the database.
+db_setup;
+my $admin = eval { Wallet::Admin->new };
+is ($@, '', 'Wallet::Admin creation did not die');
+is ($admin->reinitialize ('admin@EXAMPLE.COM'), 1,
+    'Database initialization succeeded');
+$admin->register_object ('base', 'Wallet::Object::Base');
+$admin->register_verifier ('base', 'Wallet::ACL::Base');
+
+# We have an empty database, so we should see no objects and one ACL.
+my $report = eval { Wallet::Report->new };
+is ($@, '', 'Wallet::Report creation did not die');
+ok ($report->isa ('Wallet::Report'), ' and returned the right class');
+my @objects = $report->objects;
+is (scalar (@objects), 0, 'No objects in the database');
+is ($report->error, undef, ' and no error');
+my @acls = $report->acls;
+is (scalar (@acls), 1, 'One ACL in the database');
+is ($acls[0][0], 1, ' and that is ACL ID 1');
+is ($acls[0][1], 'ADMIN', ' with the right name');
+
+# Create an object.
+$server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') };
+is ($@, '', 'Creating a server instance did not die');
+is ($server->create ('base', 'service/admin'), 1,
+    ' and creating base:service/admin succeeds');
+
+# Now, we should see one object.
+@objects = $report->objects;
+is (scalar (@objects), 1, ' and now there is one object');
+is ($objects[0][0], 'base', ' with the right type');
+is ($objects[0][1], 'service/admin', ' and the right name');
+
+# Create another ACL.
+is ($server->acl_create ('first'), 1, 'ACL creation succeeds');
+@acls = $report->acls;
+is (scalar (@acls), 2, ' and now there are two ACLs');
+is ($acls[0][0], 1, ' and the first ID is correct');
+is ($acls[0][1], 'ADMIN', ' and the first name is correct');
+is ($acls[1][0], 2, ' and the second ID is correct');
+is ($acls[1][1], 'first', ' and the second name is correct');
+
+# Delete that ACL and create another.
+is ($server->acl_create ('second'), 1, 'Second ACL creation succeeds');
+is ($server->acl_destroy ('first'), 1, ' and deletion of the first succeeds');
+@acls = $report->acls;
+is (scalar (@acls), 2, ' and there are still two ACLs');
+is ($acls[0][0], 1, ' and the first ID is still the same');
+is ($acls[0][1], 'ADMIN', ' and the first name is still the same');
+is ($acls[1][0], 3, ' but the second ID has changed');
+is ($acls[1][1], 'second', ' and the second name is correct');
+
+# Currently, we have no owners, so we should get an empty owner report.
+my @lines = $report->owners ('%', '%');
+is (scalar (@lines), 0, 'Owner report is currently empty');
+is ($report->error, undef, ' and there is no error');
+
+# Set an owner and make sure we now see something in the report.
+is ($server->owner ('base', 'service/admin', 'ADMIN'), 1,
+    'Setting an owner works');
+@lines = $report->owners ('%', '%');
+is (scalar (@lines), 1, ' and now there is one owner in the report');
+is ($lines[0][0], 'krb5', ' with the right scheme');
+is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier');
+@lines = $report->owners ('keytab', '%');
+is (scalar (@lines), 0, 'Owners of keytabs is empty');
+is ($report->error, undef, ' with no error');
+@lines = $report->owners ('base', 'foo/%');
+is (scalar (@lines), 0, 'Owners of base foo/* objects is empty');
+is ($report->error, undef, ' with no error');
+
+# Create a second object with the same owner.
+is ($server->create ('base', 'service/foo'), 1,
+    'Creating base:service/foo succeeds');
+is ($server->owner ('base', 'service/foo', 'ADMIN'), 1,
+    ' and setting the owner to the same value works');
+@lines = $report->owners ('base', 'service/%');
+is (scalar (@lines), 1, ' and there is still owner in the report');
+is ($lines[0][0], 'krb5', ' with the right scheme');
+is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier');
+
+# Change the owner of the second object to an empty ACL.
+is ($server->owner ('base', 'service/foo', 'second'), 1,
+    ' and changing the owner to an empty ACL works');
+@lines = $report->owners ('base', '%');
+is (scalar (@lines), 1, ' and there is still owner in the report');
+is ($lines[0][0], 'krb5', ' with the right scheme');
+is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier');
+
+# Add a few things to the second ACL to see what happens.
+is ($server->acl_add ('second', 'base', 'foo'), 1,
+    'Adding an ACL line to the new ACL works');
+is ($server->acl_add ('second', 'base', 'bar'), 1,
+    ' and adding another ACL line to the new ACL works');
+@lines = $report->owners ('base', '%');
+is (scalar (@lines), 3, ' and now there are three owners in the report');
+is ($lines[0][0], 'base', ' first has the right scheme');
+is ($lines[0][1], 'bar', ' and the right identifier');
+is ($lines[1][0], 'base', ' second has the right scheme');
+is ($lines[1][1], 'foo', ' and the right identifier');
+is ($lines[2][0], 'krb5', ' third has the right scheme');
+is ($lines[2][1], 'admin@EXAMPLE.COM', ' and the right identifier');
+
+# Test ownership and other ACL values.  Change one keytab to be not owned by
+# ADMIN, but have group permission on it.  We'll need a third object neither
+# owned by ADMIN or with any permissions from it.
+is ($server->create ('base', 'service/null'), 1,
+    'Creating base:service/null succeeds');
+is ($server->acl ('base', 'service/foo', 'get', 'ADMIN'), 1,
+    'Changing the get ACL for the search also does');
+@lines = $report->objects ('owner', 'ADMIN');
+is (scalar (@lines), 1, 'Searching for objects owned by ADMIN finds one');
+is ($lines[0][0], 'base', ' and it has the right type');
+is ($lines[0][1], 'service/admin', ' and the right name');
+@lines = $report->objects ('owner', 'null');
+is (scalar (@lines), 1, 'Searching for objects with no set ownerfinds one');
+is ($lines[0][0], 'base', ' and it has the right type');
+is ($lines[0][1], 'service/null', ' and the right name');
+@lines = $report->objects ('acl', 'ADMIN');
+is (scalar (@lines), 2, 'ADMIN has any rights at all on two objects');
+is ($lines[0][0], 'base', ' and the first has the right type');
+is ($lines[0][1], 'service/admin', ' and the right name');
+is ($lines[1][0], 'base', ' and the second has the right type');
+is ($lines[1][1], 'service/foo', ' and the right name');
+
+# Listing objects of a specific type.
+@lines = $report->objects ('type', 'base');
+is (scalar (@lines), 3, 'Searching for all objects of type base finds three');
+is ($lines[0][0], 'base', ' and the first has the right type');
+is ($lines[0][1], 'service/admin', ' and the right name');
+is ($lines[1][0], 'base', ' and the second has the right type');
+is ($lines[1][1], 'service/foo', ' and the right name');
+is ($lines[2][0], 'base', ' and the third has the right type');
+is ($lines[2][1], 'service/null', ' and the right name');
+@lines = $report->objects ('type', 'keytab');
+is (scalar (@lines), 0, 'Searching for all objects of type keytab finds none');
+
+# Test setting a flag, searching for objects with it, and then clearing it.
+is ($server->flag_set ('base', 'service/admin', 'unchanging'), 1,
+    'Setting a flag works');
+@lines = $report->objects ('flag', 'unchanging');
+is (scalar (@lines), 1, 'Searching for all objects with that flag finds one');
+is ($lines[0][0], 'base', ' and it has the right type');
+is ($lines[0][1], 'service/admin', ' and the right name');
+is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1,
+    'Clearing the flag works');
+@lines = $report->objects ('flag', 'unchanging');
+is (scalar (@lines), 0, ' and now there are no objects in the report');
+is ($report->error, undef, ' with no error');
+
+# Clean up.
+$admin->destroy;
+unlink 'wallet-db';
diff --git a/server/wallet-report b/server/wallet-report
new file mode 100755
index 0000000..a6b3b8d
--- /dev/null
+++ b/server/wallet-report
@@ -0,0 +1,203 @@
+#!/usr/bin/perl -w
+#
+# wallet-report -- Wallet server reporting interface.
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
+#
+# See LICENSE for licensing terms.
+
+##############################################################################
+# Declarations and site configuration
+##############################################################################
+
+use strict;
+use Wallet::Report;
+
+##############################################################################
+# Implementation
+##############################################################################
+
+# Parse and execute a command.  We wrap this in a subroutine call for easier
+# testing.
+sub command {
+    die "Usage: wallet-report <command> [<args> ...]\n" unless @_;
+    my $report = Wallet::Report->new;
+
+    # Parse command-line options and dispatch to the appropriate calls.
+    my ($command, @args) = @_;
+    if ($command eq 'acls') {
+        die "too many arguments to acls\n" if @args > 3;
+        my @acls = $report->acls (@args);
+        if (!@acls and $report->error) {
+            die $report->error, "\n";
+        }
+        for my $acl (sort { $$a[1] cmp $$b[1] } @acls) {
+            print "$$acl[1] (ACL ID: $$acl[0])\n";
+        }
+    } elsif ($command eq 'objects') {
+        die "too many arguments to objects\n" if @args > 2;
+        my @objects = $report->objects (@args);
+        if (!@objects and $report->error) {
+            die $report->error, "\n";
+        }
+        for my $object (@objects) {
+            print join (' ', @$object), "\n";
+        }
+    } elsif ($command eq 'owners') {
+        die "too many arguments to owners\n" if @args > 2;
+        die "too few arguments to owners\n" if @args < 2;
+        my @entries = $report->owners (@args);
+        if (!@entries and $report->error) {
+            die $report->error, "\n";
+        }
+        for my $entry (@entries) {
+            print join (' ', @$entry), "\n";
+        }
+    } else {
+        die "unknown command $command\n";
+    }
+}
+command (@ARGV);
+__END__
+
+##############################################################################
+# Documentation
+##############################################################################
+
+=head1 NAME
+
+wallet-report - Wallet server reporting interface
+
+=for stopwords
+metadata ACL hostname backend acl acls wildcard SQL Allbery remctl
+
+=head1 SYNOPSIS
+
+B<wallet-report> I<type> [I<args> ...]
+
+=head1 DESCRIPTION
+
+B<wallet-report> provides a command-line interface for running reports on
+the wallet database.  It is intended to be run on the wallet server as a
+user with access to the wallet database and configuration, but can also be
+made available via remctl to users who should have reporting privileges.
+
+This program is a fairly thin wrapper around Wallet::Report that
+translates command strings into method calls and returns the results.
+
+=head1 OPTIONS
+
+B<wallet-report> takes no traditional options.
+
+=head1 COMMANDS
+
+=over 4
+
+=item acls
+
+=item acls empty
+
+=item acls entry <scheme> <identifier>
+
+Returns a list of ACLs 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.  There will be
+one line per ACL.
+
+If no search type is given, all the ACLs in the database will be returned.
+If a search type (and possible search arguments) are given, then the ACLs
+will be limited to those that match the search.
+
+The currently supported ACL search types are:
+
+=over 4
+
+=item acls empty
+
+Returns all ACLs which have no entries, generally so that abandoned ACLs
+can be destroyed.
+
+=item acls entry <scheme> <identifier>
+
+Returns all ACLs containing an entry with given scheme and identifier.
+The scheme must be an exact match, but the <identifier> string will match
+any identifier containing that string.
+
+=back
+
+=item objects
+
+=item objects acl <acl>
+
+=item objects flag <flag>
+
+=item objects owner <owner>
+
+=item objects type <type>
+
+Returns a list of objects in the database.  Objects will be listed in the
+form:
+
+    <type> <name>
+
+There will be one line per object.
+
+If no search type is given, all objects in the database will be returned.
+If a search type (and possible search arguments) are given, the objects
+will be limited to those that match the search.
+
+The currently supported object search types are:
+
+=over 4
+
+=item list objects acl <acl>
+
+Returns all objects for which the given ACL name or ID has any
+permissions.  This includes those objects owned by the ACL as well as
+those where that ACL has any other, more limited permissions.
+
+=item list objects flag <flag>
+
+Returns all objects which have the given flag set.
+
+=item list objects owner <acl>
+
+Returns all objects owned by the given ACL name or ID.
+
+=item list objects type <type>
+
+Returns all objects of the given type.
+
+=back
+
+=item owners <type-pattern> <name-pattern>
+
+Returns a list of all ACL entries in owner ACLs for all objects matching
+both <type-pattern> and <name-pattern>.  These can be the type or name of
+objects or they can be patterns using C<%> as the wildcard character
+following the normal rules of SQL patterns.
+
+The output will be one line per ACL line in the form:
+
+    <scheme> <identifier>
+
+with duplicates suppressed.
+
+=back
+
+=head1 SEE ALSO
+
+Wallet::Config(3), Wallet::Report(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/docs/pod-spelling-t b/tests/docs/pod-spelling-t
index 433d841..6993e4c 100755
--- a/tests/docs/pod-spelling-t
+++ b/tests/docs/pod-spelling-t
@@ -48,7 +48,7 @@ my @pod = map {
     $pod =~ s,[^/.][^/]*/../,,g;
     $pod;
 } qw(client/wallet.pod server/keytab-backend server/wallet-admin
-     server/wallet-backend);
+     server/wallet-backend server/wallet-report);
 plan tests => scalar @pod;
 
 # Finally, do the checks.
diff --git a/tests/docs/pod-t b/tests/docs/pod-t
index 9b6c5d1..f92ba2c 100755
--- a/tests/docs/pod-t
+++ b/tests/docs/pod-t
@@ -13,7 +13,7 @@ eval 'use Test::Pod 1.00';
 plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@;
 
 my @files = qw(client/wallet.pod server/keytab-backend server/wallet-admin
-               server/wallet-backend);
+               server/wallet-backend server/wallet-report);
 my $total = scalar (@files);
 plan tests => $total;
 for my $file (@files) {
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');