diff options
Diffstat (limited to 'perl/t/general/report.t')
| -rwxr-xr-x | perl/t/general/report.t | 333 |
1 files changed, 333 insertions, 0 deletions
diff --git a/perl/t/general/report.t b/perl/t/general/report.t new file mode 100755 index 0000000..8d348ed --- /dev/null +++ b/perl/t/general/report.t @@ -0,0 +1,333 @@ +#!/usr/bin/perl +# +# Tests for the wallet reporting interface. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2008, 2009, 2010, 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +use strict; +use warnings; + +use Test::More tests => 197; + +use Wallet::Admin; +use Wallet::Report; +use Wallet::Server; + +use lib 't/lib'; +use Util; + +# Use Wallet::Admin to set up the database. +db_setup; +my $admin = eval { Wallet::Admin->new }; +is ($@, '', 'Wallet::Admin creation did not die'); +is ($admin->reinitialize ('admin@EXAMPLE.COM'), 1, + 'Database initialization succeeded'); +$admin->register_object ('base', 'Wallet::Object::Base'); +$admin->register_verifier ('base', 'Wallet::ACL::Base'); + +# We have an empty database, so we should see no objects and one ACL. +my $report = eval { Wallet::Report->new }; +is ($@, '', 'Wallet::Report creation did not die'); +ok ($report->isa ('Wallet::Report'), ' and returned the right class'); +my @objects = $report->objects; +is (scalar (@objects), 0, 'No objects in the database'); +is ($report->error, undef, ' and no error'); +my @acls = $report->acls; +is (scalar (@acls), 1, 'One ACL in the database'); +is ($acls[0][0], 1, ' and that is ACL ID 1'); +is ($acls[0][1], 'ADMIN', ' with the right name'); + +# Create an object. +my $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 = $report->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'); + +# 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; +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'); +@acls = $report->acls; +is (scalar (@acls), 2, ' and there are still two ACLs'); +is ($acls[0][0], 1, ' and the first ID is still the same'); +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 = $report->owners ('%', '%'); +is (scalar (@lines), 0, 'Owner report is currently empty'); +is ($report->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 = $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 = $report->owners ('keytab', '%'); +is (scalar (@lines), 0, 'Owners of keytabs is empty'); +is ($report->error, undef, ' with no error'); +@lines = $report->owners ('base', 'foo/%'); +is (scalar (@lines), 0, 'Owners of base foo/* objects is empty'); +is ($report->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 = $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'); + +# 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'); +@lines = $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 = $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'); + +# 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 = $report->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 = $report->objects ('owner', 'null'); +is (scalar (@lines), 1, 'Searching for objects with no set owner finds one'); +is ($lines[0][0], 'base', ' and it has the right type'); +is ($lines[0][1], 'service/null', ' and the right name'); +@lines = $report->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 = $report->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 = $report->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 = $report->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'); +@lines = $report->objects ('flag', 'unchanging'); +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'); +is ($report->error, undef, ' with no error'); + +# Set a naming policy and then look for objects that fail that policy. We +# have to deactivate this policy until now so that it doesn't prevent the +# creation of that name originally, which is the reason for the variable +# reference. +our $naming_active = 1; +package Wallet::Config; +sub verify_name { + my ($type, $name) = @_; + return unless $naming_active; + return 'admin not allowed' if $name eq 'service/admin'; + return; +} +package main; +@lines = $report->audit ('objects', 'name'); +is (scalar (@lines), 1, 'Searching for naming violations finds one'); +is ($lines[0][0], 'base', ' and the first has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); + +# Set an ACL naming policy and then look for objects that fail that policy. +# Use the same deactivation trick as above. +package Wallet::Config; +sub verify_acl_name { + my ($name) = @_; + return unless $naming_active; + return 'second not allowed' if $name eq 'second'; + return; +} +package main; +@lines = $report->audit ('acls', 'name'); +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'); + +# The third and fourth ACLs are both empty and should show up as duplicate. +@acls = $report->acls ('duplicate'); +is (scalar (@acls), 1, 'There is one set of duplicate ACLs'); +is (scalar (@{ $acls[0] }), 2, ' with two members'); +is ($acls[0][0], 'fourth', ' and the first member is correct'); +is ($acls[0][1], 'third', ' and the second member is correct'); + +# Add the same line to both ACLs. They should still show up as duplicate. +is ($server->acl_add ('fourth', 'base', 'bar'), 1, + 'Adding a line to the fourth ACL works'); +is ($server->acl_add ('third', 'base', 'bar'), 1, + ' and adding a line to the third ACL works'); +@acls = $report->acls ('duplicate'); +is (scalar (@acls), 1, 'There is one set of duplicate ACLs'); +is (scalar (@{ $acls[0] }), 2, ' with two members'); +is ($acls[0][0], 'fourth', ' and the first member is correct'); +is ($acls[0][1], 'third', ' and the second member is correct'); + +# Add another line to the third ACL. Now we match second. +is ($server->acl_add ('third', 'base', 'foo'), 1, + 'Adding another line to the third ACL works'); +@acls = $report->acls ('duplicate'); +is (scalar (@acls), 1, 'There is one set of duplicate ACLs'); +is (scalar (@{ $acls[0] }), 2, ' with two members'); +is ($acls[0][0], 'second', ' and the first member is correct'); +is ($acls[0][1], 'third', ' and the second member is correct'); + +# Add yet another line to the third ACL. Now all ACLs are distinct. +is ($server->acl_add ('third', 'base', 'baz'), 1, + 'Adding another line to the third ACL works'); +@acls = $report->acls ('duplicate'); +is (scalar (@acls), 0, 'There are no duplicate ACLs'); +is ($report->error, undef, ' and no error'); + +# Clean up. +$admin->destroy; +system ('rm -r test-files') == 0 or die "cannot remove test-files\n"; +END { + unlink 'wallet-db'; +} |