path: root/perl/t/report.t

#!/usr/bin/perl -w
#
# Tests for the wallet reporting interface.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2008, 2009, 2010
#     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;
unlink 'wallet-db';
system ('rm -r test-files') == 0 or die "cannot remove test-files\n";