diff options
| -rw-r--r-- | NEWS | 6 | ||||
| -rw-r--r-- | TODO | 2 | ||||
| -rw-r--r-- | perl/Wallet/Report.pm | 20 | ||||
| -rwxr-xr-x | perl/t/report.t | 51 | ||||
| -rwxr-xr-x | server/wallet-report | 7 |
5 files changed, 80 insertions, 6 deletions
@@ -1,5 +1,11 @@ User-Visible wallet Changes +wallet 0.12 (unreleased) + + Add a objects unused report to wallet-report and Wallet::Report, + returning all objects that have never been downloaded (in other words, + have never been the target of a get command). + wallet 0.11 (2010-03-08) When deleting an ACL on the server, verify that the ACL is not @@ -137,7 +137,7 @@ Reports: previous versions before ACL deletion was checked with database backends that don't do referential integrity. - * Add report for all objects that have never been stored or downloaded. + * Add report for all objects that have never been stored. * Add report of all ACLs with identical contents. diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index c743060..64418ee 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -20,7 +20,7 @@ use Wallet::Database; # 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 @@ -128,6 +128,15 @@ sub objects_acl { return ($sql, ($acl->id) x 6); } +# Return the SQL statement to find all objects that have been created but +# have never been retrieved (via get). +sub objects_unused { + my ($self) = @_; + my $sql = 'select ob_type, ob_name from objects where ob_downloaded_on + is null order by objects.ob_type, objects.ob_name'; + return ($sql); +} + # 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 @@ -144,7 +153,7 @@ sub objects { if (!defined $type || $type eq '') { ($sql) = $self->objects_all; } else { - if (@args != 1) { + if ($type ne 'unused' && @args != 1) { $self->error ("object searches require one argument to search"); } elsif ($type eq 'type') { ($sql, @search) = $self->objects_type (@args); @@ -154,6 +163,8 @@ sub objects { ($sql, @search) = $self->objects_flag (@args); } elsif ($type eq 'acl') { ($sql, @search) = $self->objects_acl (@args); + } elsif ($type eq 'unused') { + ($sql) = $self->objects_unused (@args); } else { $self->error ("do not know search type: $type"); } @@ -461,13 +472,14 @@ Returns a list of all objects matching a search type and string in the database, or all objects in the database if no search information is given. -There are four types of searches currently. C<type>, with a given type, +There are five types of searches currently. C<type>, with a given type, will return only those entries where the type matches the given type. C<owner>, with a given owner, will only return those objects owned by the given ACL name or ID. C<flag>, with a given flag name, will only return those items with a flag set to the given value. C<acl> operates like C<owner>, but will return only those objects that have the given ACL name -or ID on any of the possible ACL settings, not just owner. +or ID on any of the possible ACL settings, not just owner. C<unused> will +return all entries for which a get command has never been issued. 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 C<keytab> diff --git a/perl/t/report.t b/perl/t/report.t index 1dc69f7..00636db 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 151; +use Test::More tests => 179; use Wallet::Admin; use Wallet::Report; @@ -49,6 +49,12 @@ 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'); +# That object should be unused. +@objects = $report->objects ('unused'); +is (scalar (@objects), 1, ' and that object is unused'); +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 = $report->acls; @@ -97,6 +103,14 @@ 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'); +# Both objects should now show as unused. +@objects = $report->objects ('unused'); +is (scalar (@objects), 2, 'There are now two unused objects'); +is ($objects[0][0], 'base', ' and the first has the right type'); +is ($objects[0][1], 'service/admin', ' and the right name'); +is ($objects[1][0], 'base', ' and the second has the right type'); +is ($objects[1][1], 'service/foo', ' and the right name'); + # 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'); @@ -239,6 +253,41 @@ is (scalar (@lines), 1, 'Searching for ACL naming violations finds one'); is ($lines[0][0], 3, ' and the first has the right ID'); is ($lines[0][1], 'second', ' and the right name'); +# Set up a file bucket so that we can create an object we can retrieve. +system ('rm -rf test-files') == 0 or die "cannot remove test-files\n"; +mkdir 'test-files' or die "cannot create test-files: $!\n"; +$Wallet::Config::FILE_BUCKET = 'test-files'; + +# Create a file object and ensure that it shows up in the unused list. +is ($server->create ('file', 'test'), 1, 'Creating file:test succeeds'); +is ($server->owner ('file', 'test', 'ADMIN'), 1, + ' and setting its owner works'); +@objects = $report->objects ('unused'); +is (scalar (@objects), 4, 'There are now four unused objects'); +is ($objects[0][0], 'base', ' and the first has the right type'); +is ($objects[0][1], 'service/admin', ' and the right name'); +is ($objects[1][0], 'base', ' and the second has the right type'); +is ($objects[1][1], 'service/foo', ' and the right name'); +is ($objects[2][0], 'base', ' and the third has the right type'); +is ($objects[2][1], 'service/null', ' and the right name'); +is ($objects[3][0], 'file', ' and the fourth has the right type'); +is ($objects[3][1], 'test', ' and the right name'); + +# Store something and retrieve it, and then check that the file object fell +# off of the list. +is ($server->store ('file', 'test', 'Some data'), 1, + 'Storing data in file:test succeeds'); +is ($server->get ('file', 'test'), 'Some data', ' and retrieving it works'); +@objects = $report->objects ('unused'); +is (scalar (@objects), 3, ' and now there are three unused objects'); +is ($objects[0][0], 'base', ' and the first has the right type'); +is ($objects[0][1], 'service/admin', ' and the right name'); +is ($objects[1][0], 'base', ' and the second has the right type'); +is ($objects[1][1], 'service/foo', ' and the right name'); +is ($objects[2][0], 'base', ' and the third has the right type'); +is ($objects[2][1], 'service/null', ' and the right name'); + # Clean up. $admin->destroy; unlink 'wallet-db'; +system ('rm -r test-files') == 0 or die "cannot remove test-files\n"; diff --git a/server/wallet-report b/server/wallet-report index 435fb73..28d5b9a 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -177,6 +177,8 @@ one line per object or ACL. =item objects type <type> +=item objects unused + Returns a list of objects in the database. Objects will be listed in the form: @@ -210,6 +212,11 @@ Returns all objects owned by the given ACL name or ID. Returns all objects of the given type. +=item objects unused + +Returns all objects that have never been downloaded (have never been the +target of a get command). + =back =item owners <type-pattern> <name-pattern> |