diff options
Diffstat (limited to 'perl/t/general/server.t')
| -rwxr-xr-x | perl/t/general/server.t | 1033 |
1 files changed, 1033 insertions, 0 deletions
diff --git a/perl/t/general/server.t b/perl/t/general/server.t new file mode 100755 index 0000000..b270733 --- /dev/null +++ b/perl/t/general/server.t @@ -0,0 +1,1033 @@ +#!/usr/bin/perl +# +# Tests for the wallet server API. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2010, 2011, 2012, 2013, 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +use strict; +use warnings; + +use Test::More tests => 382; + +use POSIX qw(strftime); +use Wallet::Admin; +use Wallet::Config; +use Wallet::Schema; +use Wallet::Server; + +use lib 't/lib'; +use Util; + +# Some global defaults to use. +my $admin = 'admin@EXAMPLE.COM'; +my $user1 = 'alice@EXAMPLE.COM'; +my $user2 = 'bob@EXAMPLE.COM'; +my $host = 'localhost'; +my @trace = ($admin, $host); + +# Use Wallet::Admin to set up the database. +db_setup; +my $setup = eval { Wallet::Admin->new }; +is ($@, '', 'Database initialization did not die'); +is ($setup->reinitialize ($admin), 1, 'Database initialization succeeded'); + +# Now test the new method. +my $server = eval { Wallet::Server->new (@trace) }; +is ($@, '', 'Reopening with new did not die'); +ok ($server->isa ('Wallet::Server'), ' and returned the right class'); +my $schema = $server->schema; +ok (defined ($schema), ' and returns a defined schema object'); + +# Allow creation of base objects for testing purposes. +$setup->register_object ('base', 'Wallet::Object::Base'); + +# We're currently running as the administrator, so everything should succeed. +# Set up a bunch of data for us to test with, starting with some ACLs. Test +# the error handling while we're at it. +is ($server->acl_show ('ADMIN'), + "Members of ACL ADMIN (id: 1) are:\n krb5 $admin\n", + 'Showing the ADMIN ACL works'); +is ($server->acl_show (1), + "Members of ACL ADMIN (id: 1) are:\n krb5 $admin\n", + ' including by number'); +is ($server->acl_history ('ADMIN'), '', ' and initial history is empty'); +is ($server->acl_history (1), '', ' including by number'); +is ($server->acl_create (3), undef, 'Cannot create ACL with a numeric name'); +is ($server->error, 'ACL name may not be all numbers', + ' and returns the right error'); +is ($server->acl_check ('user1'), 0, 'user1 ACL does not exist'); +is ($server->acl_create ('user1'), 1, 'Can create regular ACL'); +is ($server->acl_check ('user1'), 1, 'user1 now exists'); +is ($server->acl_show ('user1'), "Members of ACL user1 (id: 2) are:\n", + ' and show works'); +is ($server->acl_create ('user1'), undef, ' but not twice'); +like ($server->error, qr/^cannot create ACL user1: /, + ' and returns a good error'); +is ($server->acl_create ('ADMIN'), undef, ' and cannot create ADMIN'); +like ($server->error, qr/^cannot create ACL ADMIN: /, + ' and returns a good error'); +is ($server->acl_create ('user2'), 1, 'Create another ACL'); +is ($server->acl_create ('both'), 1, ' and one for both users'); +is ($server->acl_create ('test2'), 1, ' and an empty one'); +is ($server->acl_create ('test'), 1, ' and another test one'); +is ($server->acl_rename ('empty', 'test'), undef, + 'Cannot rename nonexistent ACL'); +is ($server->error, 'ACL empty not found', ' and returns the right error'); +is ($server->acl_rename ('test', 'test2'), undef, + ' and cannot rename to an existing name'); +like ($server->error, qr/^cannot rename ACL 6 to test2: /, + ' and returns the right error'); +is ($server->acl_rename ('test', 'empty'), 1, 'Renaming does work'); +is ($server->acl_rename ('test', 'empty'), undef, ' but not twice'); +is ($server->error, 'ACL test not found', ' and returns the right error'); +is ($server->acl_show ('test'), undef, ' and show fails'); +is ($server->error, 'ACL test not found', ' and returns the right error'); +is ($server->acl_history ('test'), undef, ' and history fails'); +is ($server->error, 'ACL test not found', ' and returns the right error'); +is ($server->acl_destroy ('test'), undef, 'Destroying the old name fails'); +is ($server->error, 'ACL test not found', ' and returns the right error'); +is ($server->acl_check ('test2'), 1, ' but the other ACL exists'); +is ($server->acl_destroy ('test2'), 1, ' and destroying it works'); +is ($server->acl_destroy ('test2'), undef, ' but not twice'); +is ($server->acl_check ('test2'), 0, ' and now it does not exist'); +is ($server->error, 'ACL test2 not found', ' and returns the right error'); +is ($server->acl_add ('user1', 'krb4', $user1), undef, + 'Adding with a bad scheme fails'); +is ($server->error, 'unknown ACL scheme krb4', ' with the right error'); +is ($server->acl_add ('user1', 'krb5', $user1), 1, + ' but works with the right scheme'); +is ($server->acl_add ('user2', 'krb5', $user2), 1, 'Add another entry'); +is ($server->acl_add ('both', 'krb5', $user1), 1, ' and another'); +is ($server->acl_add ('both', 'krb5', $user2), 1, + ' and another to the same ACL'); +is ($server->acl_show ('both'), + "Members of ACL both (id: 4) are:\n krb5 $user1\n krb5 $user2\n", + ' and show returns the correct result'); +my $history = <<"EOO"; +DATE create + by $admin from $host +DATE add krb5 $user1 + by $admin from $host +DATE add krb5 $user2 + by $admin from $host +EOO +my $result = $server->acl_history ('both'); +$result =~ s/^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d/DATE/gm; +is ($result, $history, ' as does history'); +is ($server->acl_add ('empty', 'krb5', $user1), 1, ' and another to empty'); +is ($server->acl_add ('test', 'krb5', $user1), undef, + ' but adding to an unknown ACL fails'); +is ($server->error, 'ACL test not found', ' and returns the right error'); +is ($server->acl_remove ('test', 'krb5', $user1), undef, + 'Removing from a nonexistent ACL fails'); +is ($server->error, 'ACL test not found', ' and returns the right error'); +is ($server->acl_remove ('empty', 'krb5', $user2), undef, + ' and removing an entry not there fails'); +is ($server->error, + "cannot remove krb5:$user2 from 6: entry not found in ACL", + ' and returns the right error'); +is ($server->acl_show ('empty'), + "Members of ACL empty (id: 6) are:\n krb5 $user1\n", + ' and show returns the correct status'); +is ($server->acl_remove ('empty', 'krb5', $user1), 1, + ' but removing a good one works'); +is ($server->acl_remove ('empty', 'krb5', $user1), undef, + ' but does not work twice'); +is ($server->error, + "cannot remove krb5:$user1 from 6: entry not found in ACL", + ' and returns the right error'); +is ($server->acl_show ('empty'), "Members of ACL empty (id: 6) are:\n", + ' and show returns the correct status'); + +# Make sure we can't cripple the ADMIN ACL. +is ($server->acl_destroy ('ADMIN'), undef, 'Cannot destroy the ADMIN ACL'); +is ($server->error, 'cannot destroy the ADMIN ACL', ' with the right error'); +is ($server->acl_rename ('ADMIN', 'foo'), undef, ' or rename it'); +is ($server->error, 'cannot rename the ADMIN ACL', ' with the right error'); +is ($server->acl_remove ('ADMIN', 'krb5', $admin), undef, + ' or remove its last entry'); +is ($server->error, 'cannot remove last ADMIN ACL entry', + ' with the right error'); +is ($server->acl_add ('ADMIN', 'krb5', $user1), 1, + ' but we can add another entry'); +is ($server->acl_remove ('ADMIN', 'krb5', $user1), 1, ' and then remove it'); +is ($server->acl_remove ('ADMIN', 'krb5', $user1), undef, + ' and remove a user not on it'); +is ($server->error, + "cannot remove krb5:$user1 from 1: entry not found in ACL", + ' and get the right error'); + +# Now, create a few objects to use for testing and test the object API while +# we're at it. +is ($server->create ('base', 'service/admin'), 1, + 'Creating an object works'); +is ($server->create ('base', 'service/admin'), undef, ' but not twice'); +like ($server->error, qr{^cannot create object base:service/admin: }, + ' and returns the right error'); +is ($server->check ('base', 'service/admin'), 1, ' and check works'); +is ($server->create ('srvtab', 'service.admin'), undef, + 'Creating an unknown object fails'); +is ($server->error, 'unknown object type srvtab', ' with the right error'); +is ($server->check ('srvtab', 'service.admin'), undef, ' and check fails'); +is ($server->error, 'unknown object type srvtab', ' with the right error'); +is ($server->create ('', 'service.admin'), undef, + ' and likewise with an empty type'); +is ($server->error, 'unknown object type ', ' with the right error'); +is ($server->create ('base', 'service/user1'), 1, + ' but we can create a base object'); +is ($server->create ('base', 'service/user2'), 1, ' and another'); +is ($server->create ('base', 'service/both'), 1, ' and another'); +is ($server->create ('base', 'service/test'), 1, ' and another'); +is ($server->create ('base', ''), undef, ' but not with an empty name'); +is ($server->error, 'invalid object name', ' with the right error'); +is ($server->destroy ('base', 'service/none'), undef, + 'Destroying an unknown object fails'); +is ($server->error, 'cannot find base:service/none', ' with the right error'); +is ($server->destroy ('srvtab', 'service/test'), undef, + ' and destroying an unknown type fails'); +is ($server->error, 'unknown object type srvtab', ' with a different error'); +is ($server->destroy ('base', 'service/test'), 1, + ' but destroying a good object works'); +is ($server->check ('base', 'service/test'), 0, + ' and now check says it is not there'); +is ($server->destroy ('base', 'service/test'), undef, ' but not twice'); +is ($server->error, 'cannot find base:service/test', ' with the right error'); + +# Test manipulating comments. +is ($server->comment ('base', 'service/test'), undef, + 'Retrieving comment on an unknown object fails'); +is ($server->error, 'cannot find base:service/test', ' with the right error'); +is ($server->comment ('base', 'service/test', 'this is a comment'), undef, + ' and setting it also fails'); +is ($server->error, 'cannot find base:service/test', ' with the right error'); +is ($server->comment ('base', 'service/admin'), undef, + 'Retrieving comment for the right object returns undef'); +is ($server->error, undef, ' but there is no error'); +is ($server->comment ('base', 'service/admin', 'this is a comment'), 1, + ' and we can set it'); +is ($server->comment ('base', 'service/admin'), 'this is a comment', + ' and get the value back'); +is ($server->comment ('base', 'service/admin', ''), 1, ' and clear it'); +is ($server->comment ('base', 'service/admin'), undef, ' and now it is gone'); +is ($server->error, undef, ' and still no error'); + +# Test manipulating expires. +my $now = strftime ('%Y-%m-%d %T', localtime time); +is ($server->expires ('base', 'service/test'), undef, + 'Retrieving expires on an unknown object fails'); +is ($server->error, 'cannot find base:service/test', ' with the right error'); +is ($server->expires ('base', 'service/test', $now), undef, + ' and setting it also fails'); +is ($server->error, 'cannot find base:service/test', ' with the right error'); +is ($server->expires ('base', 'service/admin'), undef, + 'Retrieving expires for the right object returns undef'); +is ($server->error, undef, ' but there is no error'); +is ($server->expires ('base', 'service/admin', $now), 1, + ' and we can set it'); +is ($server->expires ('base', 'service/admin'), $now, + ' and get the value back'); +is ($server->expires ('base', 'service/admin', ''), 1, ' and clear it'); +is ($server->expires ('base', 'service/admin'), undef, ' and now it is gone'); +is ($server->error, undef, ' and still no error'); + +# Test attributes. +is ($server->attr ('base', 'service/admin', 'foo'), undef, + 'Getting an attribute fails'); +is ($server->error, 'unknown attribute foo', ' but called the method'); +is ($server->attr ('base', 'service/admin', 'foo', 'foo'), undef, + ' and setting an attribute fails'); +is ($server->error, 'unknown attribute foo', ' and called the method'); + +# Because we're admin, we should be able to show one of these objects, but we +# still shouldn't be able to get or store since there are no ACLs. +is ($server->show ('base', 'service/test'), undef, + 'Cannot show nonexistent object'); +is ($server->error, 'cannot find base:service/test', ' with the right error'); +my $show = $server->show ('base', 'service/admin'); +$show =~ s/(Created on:) [\d-]+ [\d:]+$/$1 0/; +my $expected = <<"EOO"; + Type: base + Name: service/admin + Created by: $admin + Created from: $host + Created on: 0 +EOO +is ($show, $expected, ' but showing an existing object works'); +is ($server->get ('base', 'service/admin'), undef, 'Getting an object fails'); +is ($server->error, "$admin not authorized to get base:service/admin", + ' with the right error'); +is ($server->store ('base', 'service/admin', 'stuff'), undef, + ' and storing the object also fails'); +is ($server->error, "$admin not authorized to store base:service/admin", + ' with the right error'); + +# Grant only the get ACL, which should give us partial permissions. +is ($server->acl ('base', 'service/test', 'get', 'ADMIN'), undef, + 'Setting ACL on unknown object fails'); +is ($server->error, 'cannot find base:service/test', ' with the right error'); +is ($server->acl ('base', 'service/admin', 'foo', 'ADMIN'), undef, + ' as does setting an unknown ACL'); +is ($server->error, 'invalid ACL type foo', ' with the right error'); +is ($server->acl ('base', 'service/admin', 'get', 'test2'), undef, + ' as does setting it to an unknown ACL'); +is ($server->error, 'ACL test2 not found', ' with the right error'); +is ($server->acl ('base', 'service/admin', 'get', 'ADMIN'), 1, + ' but setting the right ACL works'); +$result = eval { $server->get ('base', 'service/admin') }; +is ($result, undef, 'Get still fails'); +is ($@, "Do not instantiate Wallet::Object::Base directly\n", + ' but the method is called'); +is ($server->store ('base', 'service/admin', 'stuff'), undef, + ' and storing the object still fails'); +is ($server->error, "$admin not authorized to store base:service/admin", + ' with the right error'); +is ($server->acl ('base', 'service/admin', 'get', ''), 1, + 'Clearing the ACL works'); +is ($server->get ('base', 'service/admin'), undef, ' and now get fails'); +is ($server->error, "$admin not authorized to get base:service/admin", + ' with the right error'); +is ($server->acl ('base', 'service/admin', 'store', 'ADMIN'), 1, + 'Setting the store ACL works'); +is ($server->store ('base', 'service/admin', 'stuff'), undef, + ' and now store fails'); +is ($server->error, + "cannot store base:service/admin: object type is immutable", + ' with a different error message'); +is ($server->get ('base', 'service/admin'), undef, ' and get still fails'); +is ($server->error, "$admin not authorized to get base:service/admin", + ' with the right error'); +is ($server->acl ('base', 'service/admin', 'store', ''), 1, + 'Clearing the ACL works'); +is ($server->store ('base', 'service/admin', 'stuff'), undef, + ' and storing the object now fails'); +is ($server->error, "$admin not authorized to store base:service/admin", + ' with the right error'); + +# Test manipulating the owner. +is ($server->owner ('base', 'service/test'), undef, + 'Owner of nonexistent object fails'); +is ($server->error, 'cannot find base:service/test', ' with the right error'); +is ($server->owner ('base', 'service/test', 'ADMIN'), undef, + ' as does setting it'); +is ($server->error, 'cannot find base:service/test', ' with the right error'); +is ($server->owner ('base', 'service/admin'), undef, + 'Owner of existing object is also undef'); +is ($server->error, undef, ' but there is no error'); +is ($server->owner ('base', 'service/admin', 'test2'), undef, + 'Setting it to an unknown ACL fails'); +is ($server->error, 'ACL test2 not found', ' with the right error'); +is ($server->owner ('base', 'service/admin', 'ADMIN'), 1, + 'Setting it to ADMIN works'); +$result = eval { $server->get ('base', 'service/admin') }; +is ($result, undef, ' and get still fails'); +is ($@, "Do not instantiate Wallet::Object::Base directly\n", + ' but the method is called'); +is ($server->store ('base', 'service/admin', 'stuff'), undef, + ' and now store fails'); +is ($server->error, + "cannot store base:service/admin: object type is immutable", + ' with a different error message'); +is ($server->acl ('base', 'service/admin', 'get', 'empty'), 1, + 'Setting the get ACL succeeds'); +is ($server->get ('base', 'service/admin'), undef, ' and get now fails'); +is ($server->error, "$admin not authorized to get base:service/admin", + ' with the right error'); +is ($server->store ('base', 'service/admin', 'stuff'), undef, + ' but store fails'); +is ($server->error, + "cannot store base:service/admin: object type is immutable", + ' with the same error message'); +is ($server->acl ('base', 'service/admin', 'store', 'empty'), 1, + ' until we do the same thing with store'); +is ($server->store ('base', 'service/admin', 'stuff'), undef, + ' and now store fails'); +is ($server->error, "$admin not authorized to store base:service/admin", + ' due to permissions'); +is ($server->acl ('base', 'service/admin', 'store', ''), 1, + 'Clearing the store ACL works'); +is ($server->store ('base', 'service/admin', 'stuff'), undef, + ' and fixes that'); +is ($server->error, + "cannot store base:service/admin: object type is immutable", + ' since we are back to immutable'); +is ($server->owner ('base', 'service/admin', ''), 1, + ' but clearing the owner works'); +is ($server->store ('base', 'service/admin', 'stuff'), undef, + ' and now store fails'); +is ($server->error, "$admin not authorized to store base:service/admin", + ' due to permissions again'); +is ($server->owner ('base', 'service/admin', 'ADMIN'), 1, + ' and setting the owner again works'); + +# Test manipulating flags. +is ($server->flag_clear ('base', 'service/admin', 'locked'), undef, + 'Clearing an unset flag fails'); +is ($server->error, + "cannot clear flag locked on base:service/admin: flag not set", + ' with the right error'); +if ($server->flag_set ('base', 'service/admin', 'locked')) { + ok (1, ' but setting it works'); +} else { + is ($server->error, '', ' but setting it works'); +} +is ($server->store ('base', 'service/admin', 'stuff'), undef, + ' now store fails'); +is ($server->error, 'cannot store base:service/admin: object is locked', + ' because the object is locked'); +is ($server->expires ('base', 'service/admin', ''), undef, + ' and expires fails'); +is ($server->error, 'cannot modify base:service/admin: object is locked', + ' because the object is locked'); +is ($server->owner ('base', 'service/admin', ''), undef, ' and owner fails'); +is ($server->error, 'cannot modify base:service/admin: object is locked', + ' because the object is locked'); +for my $acl (qw/get store show destroy flags/) { + is ($server->acl ('base', 'service/admin', $acl, ''), undef, + " and setting $acl ACL fails"); + is ($server->error, 'cannot modify base:service/admin: object is locked', + ' for the same reason'); +} +is ($server->flag_clear ('base', 'service/admin', 'locked'), 1, + ' and then clearing it works'); +is ($server->owner ('base', 'service/admin', ''), 1, + ' and then clearing owner works'); +is ($server->flag_set ('base', 'service/admin', 'unchanging'), 1, + ' and setting unchanging works'); +is ($server->flag_clear ('base', 'service/admin', 'locked'), undef, + ' and clearing locked still does not'); +is ($server->error, + "cannot clear flag locked on base:service/admin: flag not set", + ' with the right error'); +is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1, + ' and clearing unchanging works'); + +# Test history. +$history = <<"EOO"; +DATE create + by $admin from $host +DATE set comment to this is a comment + by $admin from $host +DATE unset comment (was this is a comment) + by $admin from $host +DATE set expires to $now + by $admin from $host +DATE unset expires (was $now) + by $admin from $host +DATE set acl_get to ADMIN (1) + by $admin from $host +DATE unset acl_get (was ADMIN (1)) + by $admin from $host +DATE set acl_store to ADMIN (1) + by $admin from $host +DATE unset acl_store (was ADMIN (1)) + by $admin from $host +DATE set owner to ADMIN (1) + by $admin from $host +DATE set acl_get to empty (6) + by $admin from $host +DATE set acl_store to empty (6) + by $admin from $host +DATE unset acl_store (was empty (6)) + by $admin from $host +DATE unset owner (was ADMIN (1)) + by $admin from $host +DATE set owner to ADMIN (1) + by $admin from $host +DATE set flag locked + by $admin from $host +DATE clear flag locked + by $admin from $host +DATE unset owner (was ADMIN (1)) + by $admin from $host +DATE set flag unchanging + by $admin from $host +DATE clear flag unchanging + by $admin from $host +EOO +my $seen = $server->history ('base', 'service/admin'); +$seen =~ s/^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d/DATE/gm; +is ($seen, $history, 'History for service/admin is correct'); + +# Now let's set up some additional ACLs for future tests. +is ($server->owner ('base', 'service/user1', 'user1'), 1, 'Set user1 owner'); +is ($server->owner ('base', 'service/user2', 'user2'), 1, 'Set user2 owner'); +is ($server->owner ('base', 'service/both', 'both'), 1, 'Set both owner'); +is ($server->acl ('base', 'service/both', 'show', 'user1'), 1, ' and show'); +is ($server->acl ('base', 'service/both', 'destroy', 'user2'), 1, + ' and destroy'); +is ($server->acl ('base', 'service/both', 'flags', 'user1'), 1, ' and flags'); +is ($server->acl ('base', 'service/admin', 'store', 'user1'), 1, + 'Set admin store'); + +# Okay, now we can switch users and be sure we don't have admin rights. +$server = eval { Wallet::Server->new ($user1, $host) }; +is ($@, '', 'Switching users works'); +is ($server->acl_create ('new'), undef, ' and now we cannot create ACLs'); +is ($server->error, "$user1 not authorized to create ACL", ' with error'); +is ($server->acl_rename ('user1', 'alice'), undef, ' or rename ACLs'); +is ($server->error, "$user1 not authorized to rename ACL user1", + ' with error'); +is ($server->acl_show ('user1'), undef, ' or show ACLs'); +is ($server->error, "$user1 not authorized to show ACL user1", ' with error'); +is ($server->acl_history ('user1'), undef, ' or see history for ACLs'); +is ($server->error, "$user1 not authorized to see history of ACL user1", + ' with error'); +is ($server->acl_destroy ('user2'), undef, ' or destroy ACLs'); +is ($server->error, "$user1 not authorized to destroy ACL user2", + ' with error'); +is ($server->acl_add ('user1', 'krb5', $user2), undef, ' or add to ACLs'); +is ($server->error, "$user1 not authorized to add to ACL user1", + ' with error'); +is ($server->acl_remove ('user1', 'krb5', $user1), undef, + ' or remove from ACLs'); +is ($server->error, "$user1 not authorized to remove from ACL user1", + ' with error'); +is ($server->create ('base', 'service/test'), undef, + ' nor can we create objects'); +is ($server->error, "$user1 not authorized to create base:service/test", + ' with error'); +is ($server->owner ('base', 'service/user1', 'user2'), undef, + ' or set the owner'); +is ($server->error, + "$user1 not authorized to set owner for base:service/user1", + ' with error'); +is ($server->expires ('base', 'service/user1', $now), undef, + ' or set expires'); +is ($server->error, + "$user1 not authorized to set expires for base:service/user1", + ' with error'); +is ($server->acl ('base', 'service/user1', 'get', 'user1'), undef, + ' or set an ACL'); +is ($server->error, + "$user1 not authorized to set ACL for base:service/user1", + ' with error'); +is ($server->flag_set ('base', 'service/user1', 'unchanging'), undef, + ' or set flags'); +is ($server->error, + "$user1 not authorized to set flags for base:service/user1", + ' with error'); +is ($server->flag_clear ('base', 'service/user1', 'unchanging'), undef, + ' or clear flags'); +is ($server->error, + "$user1 not authorized to set flags for base:service/user1", + ' with error'); + +# However, we can perform object actions on things we own. +$result = eval { $server->get ('base', 'service/user1') }; +is ($result, undef, 'We can get an object we own'); +is ($@, "Do not instantiate Wallet::Object::Base directly\n", + ' and the method is called'); +is ($server->store ('base', 'service/user1', 'stuff'), undef, + ' or store an object we own'); +is ($server->error, + "cannot store base:service/user1: object type is immutable", + ' and the method is called'); +is ($server->comment ('base', 'service/user1', 'this is a comment'), 1, + ' and set a comment'); +$show = $server->show ('base', 'service/user1'); +$show =~ s/(Created on:) [\d-]+ [\d:]+$/$1 0/m; +$expected = <<"EOO"; + Type: base + Name: service/user1 + Owner: user1 + Comment: this is a comment + Created by: $admin + Created from: $host + Created on: 0 + +Members of ACL user1 (id: 2) are: + krb5 $user1 +EOO +is ($show, $expected, ' and show an object we own'); +$history = <<"EOO"; +DATE create + by $admin from $host +DATE set owner to user1 (2) + by $admin from $host +DATE set comment to this is a comment + by $user1 from $host +EOO +$seen = $server->history ('base', 'service/user1'); +$seen =~ s/^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d/DATE/gm; +is ($seen, $history, ' and see history for an object we own'); +is ($server->attr ('base', 'service/user1', 'foo'), undef, + ' and getting an attribute fails'); +is ($server->error, 'unknown attribute foo', ' but calls the method'); +is ($server->attr ('base', 'service/user1', 'foo', 'foo'), undef, + ' and setting an attribute fails'); +is ($server->error, 'unknown attribute foo', ' but calls the method'); + +# But not on things we don't own. +is ($server->get ('base', 'service/user2'), undef, + 'But we cannot get an object we do not own'); +is ($server->error, "$user1 not authorized to get base:service/user2", + ' with the right error'); +is ($server->store ('base', 'service/user2', 'stuff'), undef, + ' or store it'); +is ($server->error, "$user1 not authorized to store base:service/user2", + ' with the right error'); +is ($server->show ('base', 'service/user2'), undef, ' or show it'); +is ($server->error, "$user1 not authorized to show base:service/user2", + ' with the right error'); +is ($server->history ('base', 'service/user2'), undef, + ' or see history for it'); +is ($server->error, "$user1 not authorized to show base:service/user2", + ' with the right error'); +is ($server->attr ('base', 'service/user2', 'foo'), undef, + ' or get attributes'); +is ($server->error, + "$user1 not authorized to get attributes for base:service/user2", + ' with the right error'); +is ($server->attr ('base', 'service/user2', 'foo', ''), undef, + ' and set attributes'); +is ($server->error, + "$user1 not authorized to set attributes for base:service/user2", + ' with the right error'); +is ($server->comment ('base', 'service/user2', 'this is a comment'), undef, + ' and set comment'); +is ($server->error, + "$user1 not authorized to set comment for base:service/user2", + ' with the right error'); + +# And only some things on an object we own with some ACLs. +$result = eval { $server->get ('base', 'service/both') }; +is ($result, undef, 'We can get an object we jointly own'); +is ($@, "Do not instantiate Wallet::Object::Base directly\n", + ' and the method is called'); +is ($server->store ('base', 'service/both', 'stuff'), undef, + ' or store an object we jointly own'); +is ($server->error, + "cannot store base:service/both: object type is immutable", + ' and the method is called'); +is ($server->flag_set ('base', 'service/both', 'unchanging'), 1, + ' and set flags on an object we have an ACL'); +is ($server->flag_set ('base', 'service/both', 'locked'), 1, ' both flags'); +$show = $server->show ('base', 'service/both'); +$show =~ s/(Created on:) [\d-]+ [\d:]+$/$1 0/m; +$expected = <<"EOO"; + Type: base + Name: service/both + Owner: both + Show ACL: user1 + Destroy ACL: user2 + Flags ACL: user1 + Flags: locked unchanging + Created by: $admin + Created from: $host + Created on: 0 + +Members of ACL both (id: 4) are: + krb5 $user1 + krb5 $user2 + +Members of ACL user1 (id: 2) are: + krb5 $user1 + +Members of ACL user2 (id: 3) are: + krb5 $user2 +EOO +is ($show, $expected, ' and show an object we jointly own'); +$history = <<"EOO"; +DATE create + by $admin from $host +DATE set owner to both (4) + by $admin from $host +DATE set acl_show to user1 (2) + by $admin from $host +DATE set acl_destroy to user2 (3) + by $admin from $host +DATE set acl_flags to user1 (2) + by $admin from $host +DATE set flag unchanging + by $user1 from $host +DATE set flag locked + by $user1 from $host +EOO +$seen = $server->history ('base', 'service/both'); +$seen =~ s/^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d/DATE/gm; +is ($seen, $history, ' and see history for an object we jointly own'); +is ($server->store ('base', 'service/both', 'stuff'), undef, + ' but not store data'); +is ($server->error, 'cannot store base:service/both: object is locked', + ' when the object is locked'); +is ($server->flag_clear ('base', 'service/both', 'locked'), 1, + ' and clear flags'); +is ($server->destroy ('base', 'service/both'), undef, + ' but not destroy it'); +is ($server->error, "$user1 not authorized to destroy base:service/both", + ' due to permissions'); +is ($server->attr ('base', 'service/both', 'foo'), undef, + 'Getting an attribute fails'); +is ($server->error, 'unknown attribute foo', ' but calls the method'); +is ($server->attr ('base', 'service/both', 'foo', ''), undef, + ' and setting an attribute fails'); +is ($server->error, 'unknown attribute foo', ' but calls the method'); +is ($server->attr ('base', 'service/admin', 'foo', ''), undef, + ' but setting an attribute on service/admin fails'); +is ($server->error, 'unknown attribute foo', ' and calls the method'); +is ($server->attr ('base', 'service/admin', 'foo'), undef, + ' while getting an attribute on service/admin fails'); +is ($server->error, + "$user1 not authorized to get attributes for base:service/admin", + ' with a permission error'); + +# Now switch to the other user and make sure we can do things on objects we +# own. +$server = eval { Wallet::Server->new ($user2, $host) }; +is ($@, '', 'Switching users works'); +$result = eval { $server->get ('base', 'service/user2') }; +is ($result, undef, 'We can get an object we own'); +is ($@, "Do not instantiate Wallet::Object::Base directly\n", + ' and the method is called'); +is ($server->store ('base', 'service/user2', 'stuff'), undef, + ' or store an object we own'); +is ($server->error, + "cannot store base:service/user2: object type is immutable", + ' and the method is called'); +$show = $server->show ('base', 'service/user2'); +$show =~ s/(Created on:) [\d-]+ [\d:]+$/$1 0/m; +$expected = <<"EOO"; + Type: base + Name: service/user2 + Owner: user2 + Created by: $admin + Created from: $host + Created on: 0 + +Members of ACL user2 (id: 3) are: + krb5 $user2 +EOO +is ($show, $expected, ' and show an object we own'); +$history = <<"EOO"; +DATE create + by $admin from $host +DATE set owner to user2 (3) + by $admin from $host +EOO +$seen = $server->history ('base', 'service/user2'); +$seen =~ s/^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d/DATE/gm; +is ($seen, $history, ' and see history for an object we own'); + +# But not on things we don't own. +is ($server->get ('base', 'service/user1'), undef, + 'But we cannot get an object we do not own'); +is ($server->error, "$user2 not authorized to get base:service/user1", + ' with the right error'); +is ($server->store ('base', 'service/user1', 'stuff'), undef, + ' or store it'); +is ($server->error, "$user2 not authorized to store base:service/user1", + ' with the right error'); +is ($server->show ('base', 'service/user1'), undef, ' or show it'); +is ($server->error, "$user2 not authorized to show base:service/user1", + ' with the right error'); +is ($server->history ('base', 'service/user1'), undef, + ' or see history for it'); +is ($server->error, "$user2 not authorized to show base:service/user1", + ' with the right error'); +is ($server->comment ('base', 'service/user1', 'this is a comment'), undef, + ' or set a comment for it'); +is ($server->error, + "$user2 not authorized to set comment for base:service/user1", + ' with the right error'); + +# Test that setting a comment is controlled by the owner but retrieving it is +# controlled by the show ACL. +$result = eval { $server->get ('base', 'service/both') }; +is ($result, undef, 'We can get an object we jointly own'); +is ($@, "Do not instantiate Wallet::Object::Base directly\n", + ' and the method is called'); +is ($server->comment ('base', 'service/both', 'this is a comment'), 1, + ' and can set a comment on it'); +is ($server->error, undef, ' with no error'); +is ($server->comment ('base', 'service/both'), undef, + ' but cannot see the comment on it'); +is ($server->error, "$user2 not authorized to show base:service/both", + ' with the right error'); + +# And can only do some things on an object we own with some ACLs. +$result = eval { $server->get ('base', 'service/both') }; +is ($result, undef, 'We can get an object we jointly own'); +is ($@, "Do not instantiate Wallet::Object::Base directly\n", + ' and the method is called'); +is ($server->store ('base', 'service/both', 'stuff'), undef, + ' or store an object we jointly own'); +is ($server->error, + "cannot store base:service/both: object type is immutable", + ' and the method is called'); +is ($server->show ('base', 'service/both'), undef, ' but we cannot show it'); +is ($server->error, "$user2 not authorized to show base:service/both", + ' with the right error'); +is ($server->history ('base', 'service/both'), undef, + ' or see history for it'); +is ($server->error, "$user2 not authorized to show base:service/both", + ' with the right error'); +is ($server->flag_set ('base', 'service/both', 'locked'), undef, + ' or set flags on it'); +is ($server->error, + "$user2 not authorized to set flags for base:service/both", + ' with the right error'); +is ($server->flag_clear ('base', 'service/both', 'unchanging'), undef, + ' or clear flags on it'); +is ($server->error, + "$user2 not authorized to set flags for base:service/both", + ' with the right error'); +is ($server->attr ('base', 'service/both', 'foo'), undef, + ' or getting an attribute'); +is ($server->error, + "$user2 not authorized to get attributes for base:service/both", + ' with the right error'); +is ($server->attr ('base', 'service/both', 'foo', 'foo'), undef, + ' but setting an attribute fails'); +is ($server->error, 'unknown attribute foo', ' but calls the method'); +is ($server->destroy ('base', 'service/both'), 1, ' and we can destroy it'); +is ($server->get ('base', 'service/both'), undef, ' and now cannot get it'); +is ($server->error, 'cannot find base:service/both', ' because it is gone'); +is ($server->store ('base', 'service/both', 'stuff'), undef, + ' or store it'); +is ($server->error, 'cannot find base:service/both', ' because it is gone'); + +# Switch back to user1 and test destroy. +$server = eval { Wallet::Server->new ($user1, $host) }; +is ($@, '', 'Switching users works'); +is ($server->destroy ('base', 'service/user1'), 1, + 'Destroy of an object we own with no destroy ACLs works'); + +# Test default ACLs on object creation. +# +# Create a default_acl sub that permits $user2 to create service/default with +# a default owner of default (the same as the both ACL), $user1 to create +# service/default-both with a default owner of both (but a different +# definition than the existing ACL), and $user2 to create service/default-2 +# with a default owner of user2 (with the same definition as the existing +# ACL). +# +# Also add service/default-get and service/default-store to test auto-creation +# on get and store, and service/default-admin to test auto-creation when one +# is an admin. +package Wallet::Config; +sub default_owner { + my ($type, $name) = @_; + if ($type eq 'base' and $name eq 'service/default') { + return ('default', [ 'krb5', $user1 ], [ 'krb5', $user2 ]); + } elsif ($type eq 'base' and $name eq 'service/default-both') { + return ('both', [ 'krb5', $user1 ]); + } elsif ($type eq 'base' and $name eq 'service/default-2') { + return ('user2', [ 'krb5', $user2 ]); + } elsif ($type eq 'base' and $name eq 'service/default-get') { + return ('user2', [ 'krb5', $user2 ]); + } elsif ($type eq 'base' and $name eq 'service/default-store') { + return ('user2', [ 'krb5', $user2 ]); + } elsif ($type eq 'base' and $name eq 'service/default-admin') { + return ('auto-admin', [ 'krb5', $admin ]); + } elsif ($type eq 'base' and $name eq 'host/default') { + return ('auto-host', [ 'krb5', $admin ]); + } else { + return; + } +} +package main; + +# Switch back to user2, so we should now be able to create service/default. +# Make sure we can and that the ACLs all look good. +$server = eval { Wallet::Server->new ($user2, $host) }; +is ($@, '', 'Switching users works'); +is ($server->create ('base', 'service/default'), undef, + 'Creating an object with the default ACL fails'); +is ($server->error, "$user2 not authorized to create base:service/default", + ' due to lack of authorization'); +is ($server->autocreate ('base', 'service/default'), 1, + ' but autocreation succeeds'); +is ($server->autocreate ('base', 'service/foo'), undef, + ' but not any object'); +is ($server->error, "$user2 not authorized to create base:service/foo", + ' with the right error'); +$show = $server->show ('base', 'service/default'); +if (defined $show) { + $show =~ s/(Created on:) [\d-]+ [\d:]+$/$1 0/m; + $expected = <<"EOO"; + Type: base + Name: service/default + Owner: default + Created by: $user2 + Created from: $host + Created on: 0 + +Members of ACL default (id: 7) are: + krb5 $user1 + krb5 $user2 +EOO + is ($show, $expected, ' and the created object and ACL are correct'); +} else { + is ($server->error, undef, ' and the created object and ACL are correct'); +} + +# Try the other basic cases in default_owner. +is ($server->autocreate ('base', 'service/default-both'), undef, + 'Creating an object with an ACL mismatch fails'); +is ($server->error, "ACL both exists and doesn't match default", + ' with the right error'); +is ($server->autocreate ('base', 'service/default-2'), 1, + 'Creating an object with an existing ACL works'); +$show = $server->show ('base', 'service/default-2'); +$show =~ s/(Created on:) [\d-]+ [\d:]+$/$1 0/m; +$expected = <<"EOO"; + Type: base + Name: service/default-2 + Owner: user2 + Created by: $user2 + Created from: $host + Created on: 0 + +Members of ACL user2 (id: 3) are: + krb5 $user2 +EOO +is ($show, $expected, ' and the created object and ACL are correct'); + +# Auto-creation does not work on get or store; this is done by the client. +$result = eval { $server->get ('base', 'service/default-get') }; +is ($result, undef, 'Auto-creation on get fails'); +is ($@, '', ' does not die'); +is ($server->error, 'cannot find base:service/default-get', + ' and fails with the right error'); +is ($server->store ('base', 'service/default-store', 'stuff'), undef, + 'Auto-creation on store fails'); +is ($server->error, 'cannot find base:service/default-store', + ' with the right error'); + +# Switch back to admin to test auto-creation. +$server = eval { Wallet::Server->new ($admin, $host) }; +is ($@, '', 'Switching users back to admin works'); +is ($server->autocreate ('base', 'service/default-admin'), 1, + 'Autocreation works for admin'); +$show = $server->show ('base', 'service/default-admin'); +$show =~ s/(Created on:) [\d-]+ [\d:]+$/$1 0/m; +$expected = <<"EOO"; + Type: base + Name: service/default-admin + Owner: auto-admin + Created by: $admin + Created from: $host + Created on: 0 + +Members of ACL auto-admin (id: 8) are: + krb5 $admin +EOO +is ($show, $expected, ' and the created object and ACL are correct'); +is ($server->destroy ('base', 'service/default-admin'), 1, + ' and we can destroy it'); + +# Test naming enforcement. Permit any base service/* name, but only permit +# base host/* if the host is fully qualified and ends in .example.edu. +package Wallet::Config; +sub verify_name { + my ($type, $name) = @_; + if ($type eq 'base' and $name =~ m,^service/,) { + return; + } elsif ($type eq 'base' and $name =~ m,^host/(.*),) { + my $host = $1; + return "host $host must be fully qualified (add .example.edu)" + unless $host =~ /\./; + return "host $host not in .example.edu domain" + unless $host =~ /\.example\.edu$/; + return; + } else { + return; + } +} +package main; + +# Recreate service/default-admin, which should succeed, and then try the +# various host/* principals. +is ($server->create ('base', 'service/default-admin'), 1, + 'Creating default/admin succeeds'); +if ($server->create ('base', 'host/default.example.edu')) { + ok (1, ' as does creating host/default.example.edu'); +} else { + is ($server->error, '', ' as does creating host/default.example.edu'); +} +is ($server->destroy ('base', 'service/default-admin'), 1, + ' and destroying default-admin works'); +is ($server->destroy ('base', 'host/default.example.edu'), 1, + ' and destroying host/default.example.edu works'); +is ($server->create ('base', 'host/default'), undef, + ' but an unqualified host fails'); +is ($server->error, 'base:host/default rejected: host default must be fully' + . ' qualified (add .example.edu)', ' with the right error'); +is ($server->create ('base', 'host/default.stanford.edu'), undef, + ' and a host in the wrong domain fails'); +is ($server->error, 'base:host/default.stanford.edu rejected: host' + . ' default.stanford.edu not in .example.edu domain', + ' with the right error'); +is ($server->autocreate ('base', 'service/default-admin'), 1, + 'Creating default/admin succeeds'); +is ($server->autocreate ('base', 'host/default'), undef, + ' but an unqualified host fails'); +is ($server->error, 'base:host/default rejected: host default must be fully' + . ' qualified (add .example.edu)', ' with the right error'); +is ($server->acl_show ('auto-host'), undef, ' and the ACL is not present'); +is ($server->error, 'ACL auto-host not found', ' with the right error'); +is ($server->autocreate ('base', 'host/default.stanford.edu'), undef, + ' and a host in the wrong domain fails'); +is ($server->error, 'base:host/default.stanford.edu rejected: host' + . ' default.stanford.edu not in .example.edu domain', + ' with the right error'); + +# Ensure that we can't destroy an ACL that's in use. +is ($server->acl_create ('test-destroy'), 1, 'Creating an ACL works'); +is ($server->create ('base', 'service/acl-user'), 1, 'Creating object works'); +is ($server->owner ('base', 'service/acl-user', 'test-destroy'), 1, + ' and setting owner'); +is ($server->acl_destroy ('test-destroy'), undef, + ' and now we cannot destroy that ACL'); +is ($server->error, + 'cannot destroy ACL 9: ACL in use by base:service/acl-user', + ' with the right error'); +is ($server->owner ('base', 'service/acl-user', ''), 1, + ' but after we clear the owner'); +is ($server->acl_destroy ('test-destroy'), 1, ' now we can destroy the ACL'); +is ($server->destroy ('base', 'service/acl-user'), 1, ' and the object'); + +# Test ACL naming enforcement. Require that ACL names not contain a slash. +package Wallet::Config; +sub verify_acl_name { + my ($name, $user) = @_; + return 'ACL names may not contain slash' if $name =~ m,/,; + return; +} +package main; +is ($server->acl_create ('test/naming'), undef, + 'Creating an ACL with a disallowed name fails'); +is ($server->error, 'test/naming rejected: ACL names may not contain slash', + ' with the right error message'); +is ($server->acl_create ('test-naming'), 1, + 'Creating test-naming succeeds'); +is ($server->acl_rename ('test-naming', 'test/naming'), undef, + ' but renaming it fails'); +is ($server->error, 'test/naming rejected: ACL names may not contain slash', + ' with the right error message'); +is ($server->acl_destroy ('test-naming'), 1, 'Destroying it succeeds'); + +# Clean up. +$setup->destroy; +END { + unlink 'wallet-db'; +} + +# Now test handling of some configuration errors. +undef $Wallet::Config::DB_DRIVER; +$server = eval { Wallet::Server->new ($user2, $host) }; +is ($@, "database connection information not configured\n", + 'Fail if DB_DRIVER is not set'); +$Wallet::Config::DB_DRIVER = 'SQLite'; +undef $Wallet::Config::DB_INFO; +$server = eval { Wallet::Server->new ($user2, $host) }; +is ($@, "database connection information not configured\n", + ' or if DB_INFO is not set'); +$Wallet::Config::DB_INFO = 't'; +$server = eval { Wallet::Server->new ($user2, $host) }; +like ($@, qr/unable to open database file/, + ' or if the database connection fails'); |