diff options
author | Russ Allbery <eagle@eyrie.org> | 2014-07-11 21:39:23 -0700 |
---|---|---|
committer | Russ Allbery <rra@stanford.edu> | 2014-07-11 22:39:05 -0700 |
commit | 1575d5c34a2c6235bbf6a5010f8a8c142fe47079 (patch) | |
tree | 29e51ed64f28a37530ec0b21fc24b6d20de1d6ca /perl/t/report.t | |
parent | da0aba21779529d98436e42323fc12f702390969 (diff) |
Switch to Module::Build for the Perl module
The wallet server now requires Perl 5.8 or later (instead of 5.006 in
previous versions) and is now built with Module::Build instead of
ExtUtils::MakeMaker. This should be transparent to anyone not working
with the source code, since Perl 5.8 was released in 2002, but
Module::Build is now required to build the wallet server. It is
included in some versions of Perl, or can be installed separately from
CPAN, distribution packages, or other sources.
Also reorganize the test suite to use subdirectories.
Change-Id: Id06120ba2bad1ebbfee3d8a48ca2f25869463165
Reviewed-on: https://gerrit.stanford.edu/1530
Reviewed-by: Russ Allbery <rra@stanford.edu>
Tested-by: Russ Allbery <rra@stanford.edu>
Diffstat (limited to 'perl/t/report.t')
-rwxr-xr-x | perl/t/report.t | 330 |
1 files changed, 0 insertions, 330 deletions
diff --git a/perl/t/report.t b/perl/t/report.t deleted file mode 100755 index 9563362..0000000 --- a/perl/t/report.t +++ /dev/null @@ -1,330 +0,0 @@ -#!/usr/bin/perl -w -# -# 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 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. -$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'; -} |