diff options
| -rw-r--r-- | perl/Wallet/Admin.pm | 90 | ||||
| -rwxr-xr-x | perl/t/admin.t | 69 |
2 files changed, 155 insertions, 4 deletions
diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index 258077a..481f1b8 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -111,6 +111,66 @@ sub destroy { return 1; } +############################################################################## +# Reporting +############################################################################## + +# 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. +sub list_objects { + my ($self) = @_; + undef $self->{error}; + my @objects; + eval { + my $sql = 'select ob_type, ob_name from objects order by ob_type, + ob_name'; + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute; + my $object; + 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 a list of all ACLs stored in the wallet database as a list of ACL +# IDs. 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) = @_; + undef $self->{error}; + my @acls; + eval { + my $sql = 'select ac_id from acls order by ac_id'; + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute; + my $object; + while (defined ($object = $sth->fetchrow_arrayref)) { + push (@acls, $object->[0]); + } + $self->{dbh}->commit; + }; + if ($@) { + $self->error ("cannot list ACLs: $@"); + $self->{dbh}->rollback; + return; + } else { + return @acls; + } +} + 1; __DATA__ @@ -165,6 +225,12 @@ failure to get the error message. Destroys the database, deleting all of its data and all of the tables used by the wallet server. Returns true on success and false on failure. +=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 initialize(PRINCIPAL) Initializes the database as configured in Wallet::Config and loads the @@ -178,11 +244,27 @@ 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 error() +=item list_acls() -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. +Returns a list of the ACL IDs of all ACLs found in the database or an +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. + +=item list_objects() + +Returns a list of all objects in the database. 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 "keytab" and with values +"host/example.com" and "foo", list_objects() 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. =item reinitialize(PRINCIPAL) diff --git a/perl/t/admin.t b/perl/t/admin.t new file mode 100755 index 0000000..4c387bd --- /dev/null +++ b/perl/t/admin.t @@ -0,0 +1,69 @@ +#!/usr/bin/perl -w +# $Id$ +# +# t/admin.t -- Tests for wallet administrative interface. +# +# Written by Russ Allbery <rra@stanford.edu> +# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use Test::More tests => 22; + +use Wallet::Admin; +use Wallet::Schema; +use Wallet::Server; + +use lib 't/lib'; +use Util; + +# We test database setup in init.t, so just do the basic setup here. +db_setup; +my $admin = eval { Wallet::Admin->new }; +is ($@, '', 'Wallet::Admin creation did not die'); +ok ($admin->isa ('Wallet::Admin'), ' and returned the right class'); +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; +is (scalar (@objects), 0, 'No objects in the database'); +is ($admin->error, undef, ' and no error'); +my @acls = $admin->list_acls; +is (scalar (@acls), 1, 'One ACL in the database'); +is ($acls[0], 1, ' and that is ACL ID 1'); + +# Register a base object so that we can create a simple object. +my $schema = Wallet::Schema->new; +$schema->register_object ($admin->dbh, 'base', 'Wallet::Object::Base'); + +# 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 = $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'); + +# 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], 1, ' and the first ID is correct'); +is ($acls[1], 2, ' and the second ID 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], 1, ' and the first ID is still the same'); +is ($acls[1], 3, ' but the second ID has changed'); + +# Clean up. +is ($admin->destroy, 1, 'Destruction succeeds'); +unlink 'wallet-db'; |