diff options
| -rw-r--r-- | NEWS | 4 | ||||
| -rw-r--r-- | perl/Wallet/Admin.pm | 47 | ||||
| -rwxr-xr-x | perl/t/admin.t | 55 | ||||
| -rwxr-xr-x | server/wallet-admin | 39 | ||||
| -rw-r--r-- | tests/server/admin-t.in | 45 |
5 files changed, 175 insertions, 15 deletions
@@ -8,6 +8,10 @@ wallet 0.10 (unreleased) Fix logging in wallet-backend and the remctl configuration to not log the data passed to store. + 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. + wallet 0.9 (2008-04-24) The wallet command-line client now reads the data for store from a 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'; diff --git a/server/wallet-admin b/server/wallet-admin index 0daa986..b5674c5 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -3,7 +3,7 @@ # wallet-admin -- Wallet server administrative commands. # # 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. @@ -64,6 +64,22 @@ sub command { } else { die "only objects or acls are supported for list\n"; } + } elsif ($command eq 'report') { + die "too few arguments to report\n" if @args < 1; + my $report = shift @args; + if ($report eq 'owners') { + die "too many arguments to report owners\n" if @args > 2; + die "too few arguments to report owners\n" if @args < 2; + my @lines = $admin->report_owners (@args); + if (!@lines and $admin->error) { + die $admin->error, "\n"; + } + for my $line (@lines) { + print join (' ', @$line), "\n"; + } + } else { + die "unknown report type $report\n"; + } } elsif ($command eq 'register') { die "too many arguments to register\n" if @args > 3; die "too few arguments to register\n" if @args < 3; @@ -168,6 +184,27 @@ default as part of database initialization, so this command is used primarily to register local implementations of additional object types or ACL schemes. +=item report <type> [ <arg> ... ] + +Runs a wallet report. The currently supported report types are: + +=over 4 + +=item report owners <type-pattern> <name-pattern> + +Returns a list of all ACL lines 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 + =back =head1 SEE ALSO diff --git a/tests/server/admin-t.in b/tests/server/admin-t.in index 44ea1fe..3e84022 100644 --- a/tests/server/admin-t.in +++ b/tests/server/admin-t.in @@ -3,12 +3,12 @@ # Tests for the wallet-admin dispatch code. # # 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 strict; -use Test::More tests => 54; +use Test::More tests => 64; # Create a dummy class for Wallet::Admin that prints what method was called # with its arguments and returns data for testing. @@ -71,6 +71,13 @@ 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; @@ -98,10 +105,11 @@ 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], - register => [3, 3]); +my %commands = (destroy => [0, 0], + initialize => [1, 1], + list => [1, 1], + register => [3, 3], + report => [1, -1]); for my $command (sort keys %commands) { my ($min, $max) = @{ $commands{$command} }; if ($min > 0) { @@ -110,10 +118,12 @@ for my $command (sort keys %commands) { "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'); + if ($max >= 0) { + ($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. @@ -179,6 +189,15 @@ 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'); @@ -204,6 +223,9 @@ 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; @@ -214,3 +236,6 @@ 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'); |