diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/Wallet/Report.pm | 24 | ||||
| -rwxr-xr-x | perl/t/report.t | 37 |
2 files changed, 56 insertions, 5 deletions
diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index 462cd6f..f6e6753 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -195,7 +195,8 @@ sub acls_all { 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'; + on (acls.ac_id = acl_entries.ae_id) where ae_id is null order by + ac_id'; return ($sql); } @@ -210,6 +211,18 @@ sub acls_entry { return ($sql, $type, '%' . $identifier . '%'); } +# Returns the SQL statement required to find unused ACLs. +sub acls_unused { + my ($self) = @_; + my $sql = 'select ac_id, ac_name from acls where not ac_id in (select + ob_owner from objects where ob_owner = ac_id)'; + for my $acl (qw/get store show destroy flags/) { + $sql .= " and not ac_id in (select ob_acl_$acl from objects where + ob_acl_$acl = ac_id)"; + } + return ($sql); +} + # 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 @@ -234,8 +247,10 @@ sub acls { } } elsif ($type eq 'empty') { ($sql) = $self->acls_empty; + } elsif ($type eq 'unused') { + ($sql) = $self->acls_unused; } else { - $self->error ("do not know search type: $type"); + $self->error ("unknown search type: $type"); return; } } @@ -387,11 +402,12 @@ between an empty report and an error. 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 +currently three 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. +identifier containing that value. C<unused> returns all ACLs that are not +referenced by any object. 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 diff --git a/perl/t/report.t b/perl/t/report.t index 3b94d00..b283576 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 88; +use Test::More tests => 148; use Wallet::Admin; use Wallet::Report; @@ -166,6 +166,41 @@ is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1, is (scalar (@lines), 0, ' and now there are no objects in the report'); is ($report->error, undef, ' with no error'); +# All of our ACLs should be in use. +@lines = $report->acls ('unused'); +is (scalar (@lines), 0, 'Searching for unused ACLs returns nothing'); +is ($report->error, undef, ' with no error'); + +# Create some unused ACLs that should show up in the report. +is ($server->acl_create ('third'), 1, 'Creating an empty ACL succeeds'); +is ($server->acl_create ('fourth'), 1, ' and creating another succeeds'); +@lines = $report->acls ('unused'); +is (scalar (@lines), 2, ' and now we see two unused ACLs'); +is ($server->error, undef, ' with no error'); +is ($lines[0][0], 4, ' and the first has the right ID'); +is ($lines[0][1], 'third', ' and the right name'); +is ($lines[1][0], 5, ' and the second has the right ID'); +is ($lines[1][1], 'fourth', ' and the right name'); + +# Use one of those ACLs and ensure it drops out of the report. Test that we +# try all of the possible ACL types. +for my $type (qw/get store show destroy flags/) { + is ($server->acl ('base', 'service/admin', $type, 'fourth'), 1, + "Setting ACL $type to fourth succeeds"); + @lines = $report->acls ('unused'); + is (scalar (@lines), 1, ' and now we see only one unused ACL'); + is ($lines[0][0], 4, ' with the right ID'); + is ($lines[0][1], 'third', ' and the right name'); + is ($server->acl ('base', 'service/admin', $type, ''), 1, + ' and clearing the ACL succeeds'); + @lines = $report->acls ('unused'); + is (scalar (@lines), 2, ' and now we see two unused ACLs'); + is ($lines[0][0], 4, ' and the first has the right ID'); + is ($lines[0][1], 'third', ' and the right name'); + is ($lines[1][0], 5, ' and the second has the right ID'); + is ($lines[1][1], 'fourth', ' and the right name'); +} + # The naming audit returns nothing if there's no naming policy. @lines = $report->audit ('objects', 'name'); is (scalar (@lines), 0, 'Searching for naming violations finds none'); |