Add owners report

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.

2 files changed, 98 insertions, 4 deletions

diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm
index 3a2f687..c11c3d4 100644
--- a/perl/Wallet/Admin.pm
+++ b/perl/Wallet/Admin.pm
@@ -1,7 +1,7 @@
 # Wallet::Admin -- Wallet system administrative interface.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
@@ -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.02';
+$VERSION = '0.03';
 
 ##############################################################################
 # Constructor, destructor, and accessors
@@ -171,6 +171,38 @@ sub list_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
 ##############################################################################
@@ -335,6 +367,17 @@ 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/t/admin.t b/perl/t/admin.t
index 7a8b8ae..8804f34 100755
--- a/perl/t/admin.t
+++ b/perl/t/admin.t
@@ -3,11 +3,11 @@
 # t/admin.t -- Tests for wallet administrative interface.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 29;
+use Test::More tests => 57;
 
 use Wallet::Admin;
 use Wallet::Schema;
@@ -73,6 +73,57 @@ 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');
+
 # Clean up.
 is ($admin->destroy, 1, 'Destruction succeeds');
 unlink 'wallet-db';