diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/Wallet/Admin.pm | 167 | ||||
| -rwxr-xr-x | perl/t/admin.t | 55 |
2 files changed, 202 insertions, 20 deletions
diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index c11c3d4..91f1bfb 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.03'; +$VERSION = '0.04'; ############################################################################## # Constructor, destructor, and accessors @@ -114,20 +114,132 @@ 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. +# 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) = @_; + 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 $sql = 'select ob_type, ob_name from objects order by ob_type, - ob_name'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute; my $object; + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute (@search); while (defined ($object = $sth->fetchrow_arrayref)) { push (@objects, [ @$object ]); } @@ -142,6 +254,25 @@ sub list_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 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 @@ -149,13 +280,29 @@ sub list_objects { # list and an error, call error(), which will return undef if there was no # error. sub list_acls { - my ($self) = @_; + 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 (@args == 0) { + $self->error ("acl searches require an argument to search"); + } elsif ($type eq 'entry') { + ($sql, @search) = $self->list_acls_entry (@args); + } else { + $self->error ("do not know search type: $type"); + } + return unless $sql; + } + my @acls; eval { - my $sql = 'select ac_id, ac_name from acls order by ac_id'; my $sth = $self->{dbh}->prepare ($sql); - $sth->execute; + $sth->execute (@search); my $object; while (defined ($object = $sth->fetchrow_arrayref)) { push (@acls, [ @$object ]); diff --git a/perl/t/admin.t b/perl/t/admin.t index 8804f34..77c786d 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 57; +use Test::More tests => 77; use Wallet::Admin; use Wallet::Schema; @@ -54,15 +54,6 @@ is ($objects[0][1], 'service/admin', ' and the right name'); 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'); @@ -124,6 +115,50 @@ 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'); + # Clean up. is ($admin->destroy, 1, 'Destruction succeeds'); unlink 'wallet-db'; |