diff options
Diffstat (limited to 'perl/t/object')
| -rwxr-xr-x | perl/t/object/base.t | 356 | ||||
| -rwxr-xr-x | perl/t/object/duo.t | 157 | ||||
| -rwxr-xr-x | perl/t/object/file.t | 153 | ||||
| -rwxr-xr-x | perl/t/object/keytab.t | 774 | ||||
| -rwxr-xr-x | perl/t/object/wa-keyring.t | 183 |
5 files changed, 1623 insertions, 0 deletions
diff --git a/perl/t/object/base.t b/perl/t/object/base.t new file mode 100755 index 0000000..ee9ff4b --- /dev/null +++ b/perl/t/object/base.t @@ -0,0 +1,356 @@ +#!/usr/bin/perl +# +# Tests for the basic object implementation. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2011, 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +use strict; +use warnings; + +use POSIX qw(strftime); +use Test::More tests => 137; + +use Wallet::ACL; +use Wallet::Admin; +use Wallet::Config; +use Wallet::Object::Base; + +use lib 't/lib'; +use Util; + +# Some global defaults to use. +my $user = 'admin@EXAMPLE.COM'; +my $host = 'localhost'; +my @trace = ($user, $host, time); +my $princ = 'service/test@EXAMPLE.COM'; + +# Use Wallet::Admin to set up the database. +db_setup; +my $admin = eval { Wallet::Admin->new }; +is ($@, '', 'Database connection succeeded'); +is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); +my $schema = $admin->schema; + +# Okay, now we have a database. Test create and new. We make believe this is +# a keytab object; it won't matter for what we're doing. +my $object = eval { + Wallet::Object::Base->create ('keytab', $princ, $schema, @trace) + }; +is ($@, '', 'Object creation did not die'); +ok ($object->isa ('Wallet::Object::Base'), ' and returned the right class'); +my $other = eval { + Wallet::Object::Base->create ('keytab', $princ, $schema, @trace) + }; +like ($@, qr/^cannot create object \Qkeytab:$princ: /, 'Repeating fails'); +$other = eval { Wallet::Object::Base->create ('', $princ, $schema, @trace) }; +is ($@, "invalid object type\n", 'Using an empty type fails'); +$other = eval { Wallet::Object::Base->create ('keytab', '', $schema, @trace) }; +is ($@, "invalid object name\n", ' as does an empty name'); +$object = eval { Wallet::Object::Base->new ('keytab', "a$princ", $schema) }; +is ($@, "cannot find keytab:a$princ\n", 'Searching for unknown object fails'); +$object = eval { Wallet::Object::Base->new ('keytab', $princ, $schema) }; +is ($@, '', 'Object new did not die'); +ok ($object->isa ('Wallet::Object::Base'), ' and returned the right class'); + +# Simple accessor tests. +is ($object->type, 'keytab', 'Type accessor works'); +is ($object->name, $princ, 'Name accessor works'); + +# We'll use this for later tests. +my $acl = Wallet::ACL->new ('ADMIN', $schema); + +# Owner. +is ($object->owner, undef, 'Owner is not set to start'); +if ($object->owner ('ADMIN', @trace)) { + ok (1, ' and setting it to ADMIN works'); +} else { + is ($object->error, '', ' and setting it to ADMIN works'); +} +is ($object->owner, $acl->name, ' at which point it is ADMIN'); +ok (! $object->owner ('unknown', @trace), + ' but setting it to something bogus fails'); +is ($object->error, 'ACL unknown not found', ' with the right error'); +if ($object->owner ('', @trace)) { + ok (1, ' and clearing it works'); +} else { + is ($object->error, '', ' and clearing it works'); +} +is ($object->owner, undef, ' at which point it is cleared'); +is ($object->owner ('ADMIN', @trace), 1, ' and setting it again works'); + +# Expires. +is ($object->expires, undef, 'Expires is not set to start'); +my $now = strftime ('%Y-%m-%d %T', localtime time); +if ($object->expires ($now, @trace)) { + ok (1, ' and setting it works'); +} else { + is ($object->error, '', ' and setting it works'); +} +is ($object->expires, $now, ' at which point it matches'); +ok (! $object->expires ('13/13/13 13:13:13', @trace), + ' but setting it to something bogus fails'); +is ($object->error, 'malformed expiration time 13/13/13 13:13:13', + ' with the right error'); +if ($object->expires ('', @trace)) { + ok (1, ' and clearing it works'); +} else { + is ($object->error, '', ' and clearing it works'); +} +is ($object->expires, undef, ' at which point it is cleared'); +is ($object->expires ($now, @trace), 1, ' and setting it again works'); + +# Comment. +is ($object->comment, undef, 'Comment is not set to start'); +if ($object->comment ('this is a comment', @trace)) { + ok (1, ' and setting it works'); +} else { + is ($object->error, '', ' and setting it works'); +} +is ($object->comment, 'this is a comment', ' at which point it matches'); +if ($object->comment ('', @trace)) { + ok (1, ' and clearing it works'); +} else { + is ($object->error, '', ' and clearing it works'); +} +is ($object->comment, undef, ' at which point it is cleared'); +is ($object->comment (join (' ', ('this is a comment') x 5), @trace), 1, + ' and setting it again works'); + +# ACLs. +for my $type (qw/get store show destroy flags/) { + is ($object->acl ($type), undef, "ACL $type is not set to start"); + if ($object->acl ($type, $acl->id, @trace)) { + ok (1, ' and setting it to ADMIN (numeric) works'); + } else { + is ($object->error, '', ' and setting it to ADMIN (numeric) works'); + } + is ($object->acl ($type), $acl->name, ' at which point it is ADMIN'); + ok (! $object->acl ($type, 22, @trace), + ' but setting it to something bogus fails'); + is ($object->error, 'ACL 22 not found', ' with the right error'); + if ($object->acl ($type, '', @trace)) { + ok (1, ' and clearing it works'); + } else { + is ($object->error, '', ' and clearing it works'); + } + is ($object->acl ($type), undef, ' at which point it is cleared'); + is ($object->acl ($type, $acl->name, @trace), 1, + ' and setting it again by name works'); +} + +# Flags. +my @flags = $object->flag_list; +is (scalar (@flags), 0, 'No flags set to start'); +is ($object->flag_check ('locked'), 0, ' and locked is not set'); +is ($object->flag_set ('locked', @trace), 1, ' and setting locked works'); +is ($object->flag_check ('locked'), 1, ' and now locked is set'); +@flags = $object->flag_list; +is (scalar (@flags), 1, ' and there is one flag'); +is ($flags[0], 'locked', ' which is locked'); +is ($object->flag_set ('locked', @trace), undef, 'Setting locked again fails'); +is ($object->error, + "cannot set flag locked on keytab:$princ: flag already set", + ' with the right error'); +is ($object->flag_set ('unchanging', @trace), 1, + ' but setting unchanging works'); +is ($object->flag_check ('unchanging'), 1, ' and unchanging is now set'); +@flags = $object->flag_list; +is (scalar (@flags), 2, ' and there are two flags'); +is ($flags[0], 'locked', ' which are locked'); +is ($flags[1], 'unchanging', ' and unchanging'); +is ($object->flag_clear ('locked', @trace), 1, 'Clearing locked works'); +is ($object->flag_check ('locked'), 0, ' and now it is not set'); +is ($object->flag_check ('unchanging'), 1, ' but unchanging still is'); +is ($object->flag_clear ('locked', @trace), undef, + ' and clearing it again fails'); +is ($object->error, + "cannot clear flag locked on keytab:$princ: flag not set", + ' with the right error'); +if ($object->flag_set ('locked', @trace)) { + ok (1, ' and setting it again works'); +} else { + is ($object->error, '', ' and setting it again works'); +} + +# Attributes. Very boring. +is ($object->attr ('foo'), undef, 'Retrieving an attribute fails'); +is ($object->error, 'unknown attribute foo', ' with the right error'); +is ($object->attr ('foo', [ 'foo' ], @trace), undef, ' and setting fails'); +is ($object->error, 'unknown attribute foo', ' with the right error'); + +# Test stub methods and locked status. +is ($object->store ("Some data", @trace), undef, 'Store fails'); +is ($object->error, "cannot store keytab:${princ}: object is locked", + ' because the object is locked'); +is ($object->owner ('', @trace), undef, ' and setting owner fails'); +is ($object->error, "cannot modify keytab:${princ}: object is locked", + ' for the same reason'); +is ($object->owner, 'ADMIN', ' but retrieving the owner works'); +is ($object->expires ('', @trace), undef, ' and setting expires fails'); +is ($object->error, "cannot modify keytab:${princ}: object is locked", + ' for the same reason'); +is ($object->expires, $now, ' but retrieving expires works'); +for my $acl (qw/get store show destroy flags/) { + is ($object->acl ($acl, '', @trace), undef, " and setting $acl ACL fails"); + is ($object->error, "cannot modify keytab:${princ}: object is locked", + ' for the same reason'); + is ($object->acl ($acl), 'ADMIN', " but retrieving $acl ACL works"); +} +is ($object->flag_check ('locked'), 1, ' and checking flags works'); +@flags = $object->flag_list; +is (scalar (@flags), 2, ' and listing flags works'); +is ("@flags", 'locked unchanging', ' and returns the right data'); +is ($object->flag_clear ('locked', @trace), 1, 'Clearing locked succeeds'); +eval { $object->get (@trace) }; +is ($@, "Do not instantiate Wallet::Object::Base directly\n", + 'Get fails with the right error'); +ok (! $object->store ("Some data", @trace), 'Store fails'); +is ($object->error, "cannot store keytab:$princ: object type is immutable", + ' with the right error'); + +# Test show. +my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); +my $output = <<"EOO"; + Type: keytab + Name: $princ + Owner: ADMIN + Get ACL: ADMIN + Store ACL: ADMIN + Show ACL: ADMIN + Destroy ACL: ADMIN + Flags ACL: ADMIN + Expires: $now + Comment: this is a comment this is a comment this is a comment this is + a comment this is a comment + Flags: unchanging + Created by: $user + Created from: $host + Created on: $date + +Members of ACL ADMIN (id: 1) are: + krb5 $user +EOO +is ($object->show, $output, 'Show output is correct'); +is ($object->flag_set ('locked', @trace), 1, ' and setting locked works'); +$output = <<"EOO"; + Type: keytab + Name: $princ + Owner: ADMIN + Get ACL: ADMIN + Store ACL: ADMIN + Show ACL: ADMIN + Destroy ACL: ADMIN + Flags ACL: ADMIN + Expires: $now + Comment: this is a comment this is a comment this is a comment this is + a comment this is a comment + Flags: locked unchanging + Created by: $user + Created from: $host + Created on: $date + +Members of ACL ADMIN (id: 1) are: + krb5 $user +EOO +is ($object->show, $output, ' and show still works and is correct'); + +# Test destroy. +is ($object->destroy (@trace), undef, 'Destroy fails'); +is ($object->error, "cannot destroy keytab:${princ}: object is locked", + ' because of the locked status'); +is ($object->flag_clear ('locked', @trace), 1, + ' and clearing locked status works'); +if ($object->destroy (@trace)) { + ok (1, 'Destroy is successful'); +} else { + is ($object->error, '', 'Destroy is successful'); +} +$object = eval { Wallet::Object::Base->new ('keytab', $princ, $schema) }; +is ($@, "cannot find keytab:$princ\n", ' and object is all gone'); + +# Test history. +$object = eval { + Wallet::Object::Base->create ('keytab', $princ, $schema, @trace) + }; +ok (defined ($object), 'Recreating the object succeeds'); +$output = <<"EOO"; +$date create + by $user from $host +$date set owner to ADMIN (1) + by $user from $host +$date unset owner (was ADMIN (1)) + by $user from $host +$date set owner to ADMIN (1) + by $user from $host +$date set expires to $now + by $user from $host +$date unset expires (was $now) + by $user from $host +$date set expires to $now + by $user from $host +$date set comment to this is a comment + by $user from $host +$date unset comment (was this is a comment) + by $user from $host +$date set comment to this is a comment this is a comment this is a comment this is a comment this is a comment + by $user from $host +$date set acl_get to ADMIN (1) + by $user from $host +$date unset acl_get (was ADMIN (1)) + by $user from $host +$date set acl_get to ADMIN (1) + by $user from $host +$date set acl_store to ADMIN (1) + by $user from $host +$date unset acl_store (was ADMIN (1)) + by $user from $host +$date set acl_store to ADMIN (1) + by $user from $host +$date set acl_show to ADMIN (1) + by $user from $host +$date unset acl_show (was ADMIN (1)) + by $user from $host +$date set acl_show to ADMIN (1) + by $user from $host +$date set acl_destroy to ADMIN (1) + by $user from $host +$date unset acl_destroy (was ADMIN (1)) + by $user from $host +$date set acl_destroy to ADMIN (1) + by $user from $host +$date set acl_flags to ADMIN (1) + by $user from $host +$date unset acl_flags (was ADMIN (1)) + by $user from $host +$date set acl_flags to ADMIN (1) + by $user from $host +$date set flag locked + by $user from $host +$date set flag unchanging + by $user from $host +$date clear flag locked + by $user from $host +$date set flag locked + by $user from $host +$date clear flag locked + by $user from $host +$date set flag locked + by $user from $host +$date clear flag locked + by $user from $host +$date destroy + by $user from $host +$date create + by $user from $host +EOO +is ($object->history, $output, ' and the history is correct'); + +# Clean up. +$admin->destroy; +END { + unlink 'wallet-db'; +} diff --git a/perl/t/object/duo.t b/perl/t/object/duo.t new file mode 100755 index 0000000..4229afe --- /dev/null +++ b/perl/t/object/duo.t @@ -0,0 +1,157 @@ +#!/usr/bin/perl +# +# Tests for the Duo integration object implementation. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +use strict; +use warnings; + +use POSIX qw(strftime); +use Test::More; + +BEGIN { + eval 'use Net::Duo'; + plan skip_all => 'Net::Duo required for testing duo' + if $@; + eval 'use Net::Duo::Mock::Agent'; + plan skip_all => 'Net::Duo::Mock::Agent required for testing duo' + if $@; +} + +BEGIN { + use_ok('Wallet::Admin'); + use_ok('Wallet::Config'); + use_ok('Wallet::Object::Duo'); +} + +use lib 't/lib'; +use Util; + +# Some global defaults to use. +my $user = 'admin@EXAMPLE.COM'; +my $host = 'localhost'; +my @trace = ($user, $host, time); +my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); + +# Flush all output immediately. +$| = 1; + +# Use Wallet::Admin to set up the database. +db_setup; +my $admin = eval { Wallet::Admin->new }; +is ($@, '', 'Database connection succeeded'); +is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); +my $schema = $admin->schema; + +# Create a mock object to use for Duo calls. +my $mock = Net::Duo::Mock::Agent->new ({ key_file => 't/data/duo/keys.json' }); + +# Test error handling in the absence of configuration. +my $object = eval { + Wallet::Object::Duo->new ('duo', 'test', $schema); +}; +is ($object, undef, 'Wallet::Object::Duo new with no config failed'); +is ($@, "duo object implementation not configured\n", '...with correct error'); +$object = eval { + Wallet::Object::Duo->create ('duo', 'test', $schema, @trace); +}; +is ($object, undef, 'Wallet::Object::Duo creation with no config failed'); +is ($@, "duo object implementation not configured\n", '...with correct error'); + +# Set up the Duo configuration. +$Wallet::Config::DUO_AGENT = $mock; +$Wallet::Config::DUO_KEY_FILE = 't/data/duo/keys.json'; + +# Test creating an integration. +note ('Test creating an integration'); +my $expected = { + name => 'test', + notes => 'Managed by wallet', + type => 'unix', +}; +$mock->expect ( + { + method => 'POST', + uri => '/admin/v1/integrations', + content => $expected, + response_file => 't/data/duo/integration.json', + } +); +$object = Wallet::Object::Duo->create ('duo', 'test', $schema, @trace); +isa_ok ($object, 'Wallet::Object::Duo'); + +# Check the metadata about the new wallet object. +$expected = <<"EOO"; + Type: duo + Name: test + Duo key: DIRWIH0ZZPV4G88B37VQ + Created by: $user + Created from: $host + Created on: $date +EOO +is ($object->show, $expected, 'Show output is correct'); + +# Test retrieving the integration information. +note ('Test retrieving an integration'); +$mock->expect ( + { + method => 'GET', + uri => '/admin/v1/integrations/DIRWIH0ZZPV4G88B37VQ', + response_file => 't/data/duo/integration.json', + } +); +my $data = $object->get (@trace); +ok (defined ($data), 'Retrieval succeeds'); +$expected = <<'EOO'; +[duo] +ikey = DIRWIH0ZZPV4G88B37VQ +skey = QO4ZLqQVRIOZYkHfdPDORfcNf8LeXIbCWwHazY7o +host = example-admin.duosecurity.com +EOO +is ($data, $expected, '...and integration data is correct'); + +# Ensure that we can't retrieve the object when locked. +is ($object->flag_set ('locked', @trace), 1, + 'Setting object to locked succeeds'); +is ($object->get, undef, '...and now get fails'); +is ($object->error, 'cannot get duo:test: object is locked', + '...with correct error'); +is ($object->flag_clear ('locked', @trace), 1, + '...and clearing locked flag works'); + +# Create a new object by wallet type and name. +$object = Wallet::Object::Duo->new ('duo', 'test', $schema); + +# Test deleting an integration. We can't test this entirely properly because +# currently Net::Duo::Mock::Agent doesn't support stacking multiple expected +# calls and delete makes two calls. +note ('Test deleting an integration'); +$mock->expect ( + { + method => 'GET', + uri => '/admin/v1/integrations/DIRWIH0ZZPV4G88B37VQ', + response_file => 't/data/duo/integration.json', + } +); +TODO: { + local $TODO = 'Net::Duo::Mock::Agent not yet capable'; + + is ($object->destroy (@trace), 1, 'Duo object deletion succeeded'); + $object = eval { Wallet::Object::Duo->new ('duo', 'test', $schema) }; + is ($object, undef, '...and now object cannot be retrieved'); + is ($@, "cannot find duo:test\n", '...with correct error'); +} + +# Clean up. +$admin->destroy; +END { + unlink ('wallet-db'); +} + +# Done testing. +done_testing (); diff --git a/perl/t/object/file.t b/perl/t/object/file.t new file mode 100755 index 0000000..201f46d --- /dev/null +++ b/perl/t/object/file.t @@ -0,0 +1,153 @@ +#!/usr/bin/perl +# +# Tests for the file object implementation. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2008, 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +use strict; +use warnings; + +use POSIX qw(strftime); +use Test::More tests => 56; + +use Wallet::Admin; +use Wallet::Config; +use Wallet::Object::File; + +use lib 't/lib'; +use Util; + +# Some global defaults to use. +my $user = 'admin@EXAMPLE.COM'; +my $host = 'localhost'; +my @trace = ($user, $host, time); + +# Flush all output immediately. +$| = 1; + +# Use Wallet::Admin to set up the database. +system ('rm -rf test-files') == 0 or die "cannot remove test-files\n"; +db_setup; +my $admin = eval { Wallet::Admin->new }; +is ($@, '', 'Database connection succeeded'); +is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); +my $schema = $admin->schema; + +# Use this to accumulate the history traces so that we can check history. +my $history = ''; +my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); + +# Test error handling in the absence of configuration. +my $object = eval { + Wallet::Object::File->create ('file', 'test', $schema, @trace) + }; +ok (defined ($object), 'Creating a basic file object succeeds'); +ok ($object->isa ('Wallet::Object::File'), ' and is the right class'); +is ($object->get (@trace), undef, ' and get fails'); +is ($object->error, 'file support not configured', ' with the right error'); +is ($object->store (@trace), undef, ' and store fails'); +is ($object->error, 'file support not configured', ' with the right error'); +is ($object->destroy (@trace), 1, ' but destroy succeeds'); + +# Set up our configuration. +mkdir 'test-files' or die "cannot create test-files: $!\n"; +$Wallet::Config::FILE_BUCKET = 'test-files'; + +# Okay, now we can test. First, the basic object without store. +$object = eval { + Wallet::Object::File->create ('file', 'test', $schema, @trace) + }; +ok (defined ($object), 'Creating a basic file object succeeds'); +ok ($object->isa ('Wallet::Object::File'), ' and is the right class'); +is ($object->get (@trace), undef, ' and get fails'); +is ($object->error, 'cannot get file:test: object has not been stored', + ' with the right error'); +is ($object->destroy (@trace), 1, ' but destroying the object succeeds'); + +# Now store something and be sure that we get something reasonable. +$object = eval { + Wallet::Object::File->create ('file', 'test', $schema, @trace) + }; +ok (defined ($object), 'Recreating the object succeeds'); +is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds'); +ok (-d 'test-files/09', ' and the hash bucket was created'); +ok (-f 'test-files/09/test', ' and the file exists'); +is (contents ('test-files/09/test'), 'foo', ' with the right contents'); +is ($object->get (@trace), "foo\n", ' and get returns correctly'); +unlink 'test-files/09/test'; +is ($object->get (@trace), undef, ' and get fails if we delete it'); +is ($object->error, 'cannot get file:test: object has not been stored', + ' as if it had not been stored'); +is ($object->store ("bar\n\0baz\n", @trace), 1, ' but storing again works'); +ok (-f 'test-files/09/test', ' and the file exists'); +is (contents ('test-files/09/test'), 'bar', ' with the right contents'); +is ($object->get (@trace), "bar\n\0baz\n", ' and get returns correctly'); + +# Try exceeding the store size. +$Wallet::Config::FILE_MAX_SIZE = 1024; +is ($object->store ('x' x 1024, @trace), 1, + ' and storing exactly 1024 characters works'); +is ($object->get (@trace), 'x' x 1024, ' and get returns the right thing'); +is ($object->store ('x' x 1025, @trace), undef, + ' but storing 1025 characters fails'); +is ($object->error, 'data exceeds maximum of 1024 bytes', + ' with the right error'); + +# Try storing the empty data object. +is ($object->store ('', @trace), 1, 'Storing the empty object works'); +is ($object->get (@trace), '', ' and get returns the right thing'); + +# Test destruction. +is ($object->destroy (@trace), 1, 'Destroying the object works'); +ok (! -f 'test-files/09/test', ' and the file is gone'); + +# Now try some aggressive names. +$object = eval { + Wallet::Object::File->create ('file', '../foo', $schema, @trace) + }; +ok (defined ($object), 'Creating ../foo succeeds'); +is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds'); +ok (-d 'test-files/39', ' and the hash bucket was created'); +ok (-f 'test-files/39/%2E%2E%2Ffoo', ' and the file exists'); +is (contents ('test-files/39/%2E%2E%2Ffoo'), 'foo', + ' with the right contents'); +is ($object->get (@trace), "foo\n", ' and get returns correctly'); +is ($object->destroy (@trace), 1, 'Destroying the object works'); +ok (! -f 'test-files/39/%2E%2E%2Ffoo', ' and the file is gone'); +$object = eval { + Wallet::Object::File->create ('file', "\0", $schema, @trace) + }; +ok (defined ($object), 'Creating nul succeeds'); +is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds'); +ok (-d 'test-files/93', ' and the hash bucket was created'); +ok (-f 'test-files/93/%00', ' and the file exists'); +is (contents ('test-files/93/%00'), 'foo', + ' with the right contents'); +is ($object->get (@trace), "foo\n", ' and get returns correctly'); +is ($object->destroy (@trace), 1, 'Destroying the object works'); +ok (! -f 'test-files/93/%00', ' and the file is gone'); + +# Test error handling in the file store. +system ('rm -r test-files') == 0 or die "cannot remove test-files\n"; +$object = eval { + Wallet::Object::File->create ('file', 'test', $schema, @trace) + }; +ok (defined ($object), 'Recreating the object succeeds'); +is ($object->store ("foo\n", @trace), undef, + ' and storing data in it fails'); +like ($object->error, qr/^cannot create file bucket 09: /, + ' with the right error'); +is ($object->get (@trace), undef, ' and get fails'); +like ($object->error, qr/^cannot create file bucket 09: /, + ' with the right error'); +is ($object->destroy (@trace), 1, ' but destroying the object succeeds'); + +# Clean up. +$admin->destroy; +END { + unlink ('wallet-db'); +} diff --git a/perl/t/object/keytab.t b/perl/t/object/keytab.t new file mode 100755 index 0000000..69db438 --- /dev/null +++ b/perl/t/object/keytab.t @@ -0,0 +1,774 @@ +#!/usr/bin/perl +# +# Tests for the keytab object implementation. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2009, 2010, 2013, 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +use strict; +use warnings; + +use POSIX qw(strftime); +use Test::More tests => 141; + +BEGIN { $Wallet::Config::KEYTAB_TMP = '.' } + +use DBI; +use Wallet::Admin; +use Wallet::Config; +use Wallet::Kadmin; +use Wallet::Object::Keytab; + +use lib 't/lib'; +use Util; + +# Mapping of klist -ke encryption type names to the strings that Kerberos uses +# internally. It's very annoying to have to maintain this, and it probably +# breaks with Heimdal. +my %enctype = + ('triple des cbc mode with hmac/sha1' => 'des3-cbc-sha1', + 'des cbc mode with crc-32' => 'des-cbc-crc', + 'des cbc mode with rsa-md5' => 'des-cbc-md5', + 'aes-256 cts mode with 96-bit sha-1 hmac' => 'aes256-cts-hmac-sha1-96', + 'arcfour with hmac/md5' => 'rc4-hmac'); + +# Some global defaults to use. +my $user = 'admin@EXAMPLE.COM'; +my $host = 'localhost'; +my @trace = ($user, $host, time); + +# Flush all output immediately. +$| = 1; + +# Run a command and throw away the output, returning the exit status. +sub system_quiet { + my ($command, @args) = @_; + my $pid = fork; + if (not defined $pid) { + die "cannot fork: $!\n"; + } elsif ($pid == 0) { + open (STDIN, '<', '/dev/null') or die "cannot reopen stdin: $!\n"; + open (STDOUT, '>', '/dev/null') or die "cannot reopen stdout: $!\n"; + open (STDERR, '>', '/dev/null') or die "cannot reopen stderr: $!\n"; + exec ($command, @args) or die "cannot exec $command: $!\n"; + } else { + waitpid ($pid, 0); + return $?; + } +} + +# Create a principal out of Kerberos. Only usable once the configuration has +# been set up. +sub create { + my ($principal) = @_; + my $kadmin = Wallet::Kadmin->new; + return $kadmin->create ($principal); +} + +# Destroy a principal out of Kerberos. Only usable once the configuration has +# been set up. +sub destroy { + my ($principal) = @_; + my $kadmin = Wallet::Kadmin->new; + return $kadmin->destroy ($principal); +} + +# Check whether a principal exists. MIT uses kvno and Heimdal uses kgetcred. +# Note that the Kerberos type may be different than our local userspace, so +# don't use the Kerberos type to decide here. Instead, check for which +# program is available on the path. +sub created { + my ($principal) = @_; + $principal .= '@' . $Wallet::Config::KEYTAB_REALM; + local $ENV{KRB5CCNAME} = 'krb5cc_temp'; + getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL); + if (grep { -x "$_/kvno" } split (':', $ENV{PATH})) { + return (system_quiet ('kvno', $principal) == 0); + } elsif (grep { -x "$_/kgetcred" } split (':', $ENV{PATH})) { + return (system_quiet ('kgetcred', $principal) == 0); + } else { + warn "# No kvno or kgetcred found\n"; + return; + } +} + +# Given keytab data, write it to a file and try to determine the enctypes of +# the keys present in that file. Returns the enctypes as a list, with UNKNOWN +# for encryption types that weren't recognized. This is an ugly way of doing +# this for MIT. Heimdal is much more straightforward, but MIT ktutil doesn't +# have the needed abilities. +sub enctypes { + my ($keytab) = @_; + open (KEYTAB, '>', 'keytab') or die "cannot create keytab: $!\n"; + print KEYTAB $keytab; + close KEYTAB; + + my @enctypes; + my $pid = open (KLIST, '-|'); + if (not defined $pid) { + die "cannot fork: $!\n"; + } elsif ($pid == 0) { + open (STDERR, '>', '/dev/null') or die "cannot reopen stderr: $!\n"; + exec ('klist', '-ke', 'keytab') + or die "cannot run klist: $!\n"; + } + local $_; + while (<KLIST>) { + next unless /^ *\d+ /; + my ($string) = /\((.*)\)\s*$/; + next unless $string; + my $enctype = $enctype{lc $string} || 'UNKNOWN'; + push (@enctypes, $enctype); + } + close KLIST; + + # If that failed, we may have a Heimdal user space instead, so try ktutil. + # If we try this directly, it will just hang with MIT ktutil. + if ($? != 0 || !@enctypes) { + @enctypes = (); + open (KTUTIL, '-|', 'ktutil', '-k', 'keytab', 'list') + or die "cannot run ktutil: $!\n"; + local $_; + while (<KTUTIL>) { + next unless /^ *\d+ /; + my ($string) = /^\s*\d+\s+(\S+)/; + next unless $string; + push (@enctypes, $string); + } + close KTUTIL; + } + unlink 'keytab'; + return sort @enctypes; +} + +# Use Wallet::Admin to set up the database. +unlink ('krb5cc_temp', 'krb5cc_test', 'test-acl', 'test-pid'); +db_setup; +my $admin = eval { Wallet::Admin->new }; +is ($@, '', 'Database connection succeeded'); +is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); +my $schema = $admin->schema; +my $dbh = $admin->dbh; + +# Use this to accumulate the history traces so that we can check history. +my $history = ''; +my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); + +# Basic keytab creation and manipulation tests. +SKIP: { + skip 'no keytab configuration', 52 unless -f 't/data/test.keytab'; + + # Set up our configuration. + $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; + $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal'); + $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); + $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); + my $realm = $Wallet::Config::KEYTAB_REALM; + + # Clean up the principals we're going to use. + destroy ('wallet/one'); + destroy ('wallet/two'); + + # Don't destroy the user's Kerberos ticket cache. + $ENV{KRB5CCNAME} = 'krb5cc_test'; + + # Test that object creation without KEYTAB_TMP fails. + undef $Wallet::Config::KEYTAB_TMP; + my $object = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) + }; + is ($object, undef, 'Creating keytab without KEYTAB_TMP fails'); + is ($@, "KEYTAB_TMP configuration variable not set\n", + ' with the right error'); + $Wallet::Config::KEYTAB_TMP = '.'; + + # Okay, now we can test. First, create. + $object = eval { + Wallet::Object::Keytab->create ('keytab', "wallet\nf", $schema, + @trace) + }; + is ($object, undef, 'Creating malformed principal fails'); + if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + is ($@, "invalid principal name wallet\nf\n", ' with the right error'); + } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { + like ($@, qr/^error adding principal wallet\nf/, + ' with the right error'); + } + $object = eval { + Wallet::Object::Keytab->create ('keytab', '', $schema, @trace) + }; + is ($object, undef, 'Creating empty principal fails'); + if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + is ($@, "invalid principal name \n", ' with the right error'); + } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { + like ($@, qr/^error adding principal \@/, ' with the right error'); + } + $object = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) + }; + if (defined ($object)) { + ok (defined ($object), 'Creating good principal succeeds'); + } else { + is ($@, '', 'Creating good principal succeeds'); + } + ok ($object->isa ('Wallet::Object::Keytab'), ' and is the right class'); + ok (created ('wallet/one'), ' and the principal was created'); + create ('wallet/two'); + $object = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/two', $schema, + @trace) + }; + if (defined ($object)) { + ok (defined ($object), 'Creating an existing principal succeeds'); + } else { + is ($@, '', 'Creating an existing principal succeeds'); + } + ok ($object->isa ('Wallet::Object::Keytab'), ' and is the right class'); + is ($object->destroy (@trace), 1, ' and destroying it succeeds'); + is ($object->error, undef, ' with no error message'); + ok (! created ('wallet/two'), ' and now it does not exist'); + my @name = qw(keytab wallet-test/one); + $object = eval { Wallet::Object::Keytab->create (@name, $schema, @trace) }; + is ($object, undef, 'Creation without permissions fails'); + like ($@, qr{^error adding principal wallet-test/one\@\Q$realm: }, + ' with the right error'); + + # Now, try retrieving the keytab. + $object = Wallet::Object::Keytab->new ('keytab', 'wallet/one', $schema); + ok (defined ($object), 'Retrieving the object works'); + ok ($object->isa ('Wallet::Object::Keytab'), ' and is the right type'); + is ($object->flag_set ('locked', @trace), 1, ' and setting locked works'); + is ($object->get (@trace), undef, ' and get fails'); + is ($object->error, "cannot get keytab:wallet/one: object is locked", + ' because it is locked'); + is ($object->flag_clear ('locked', @trace), 1, + ' and clearing locked works'); + my $data = $object->get (@trace); + if (defined ($data)) { + ok (defined ($data), ' and getting the keytab works'); + } else { + is ($object->error, '', ' and getting the keytab works'); + } + ok (! -f "./keytab.$$", ' and the temporary file was cleaned up'); + ok (keytab_valid ($data, 'wallet/one'), ' and the keytab is valid'); + + # For right now, this is the only backend type that we have for which we + # can do a get, so test display of the last download information. + my $expected = <<"EOO"; + Type: keytab + Name: wallet/one + Created by: $user + Created from: $host + Created on: $date + Downloaded by: $user +Downloaded from: $host + Downloaded on: $date +EOO + is ($object->show, $expected, 'Show output is correct'); + + # Test error handling on keytab retrieval. + SKIP: { + skip 'no kadmin program test for Heimdal', 2 + if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal'; + $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; + $data = $object->get (@trace); + is ($data, undef, 'Cope with a failure to run kadmin'); + like ($object->error, qr{^cannot run /some/nonexistent/file: }, + ' with the right error'); + $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; + } + destroy ('wallet/one'); + $data = $object->get (@trace); + is ($data, undef, 'Getting a keytab for a nonexistent principal fails'); + like ($object->error, + qr{^error creating keytab for wallet/one\@\Q$realm\E: }, + ' with the right error'); + is ($object->destroy (@trace), 1, ' but we can still destroy it'); + + # Test principal deletion on object destruction. + $object = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) + }; + ok (defined ($object), 'Creating good principal succeeds'); + ok (created ('wallet/one'), ' and the principal was created'); + SKIP: { + skip 'no kadmin program test for Heimdal', 2 + if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal'; + $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; + is ($object->destroy (@trace), undef, + ' and destroying it with bad kadmin fails'); + like ($object->error, qr{^cannot run /some/nonexistent/file: }, + ' with the right error'); + $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; + } + is ($object->flag_set ('locked', @trace), 1, ' and setting locked works'); + is ($object->destroy (@trace), undef, ' and destroying it fails'); + is ($object->error, "cannot destroy keytab:wallet/one: object is locked", + ' because it is locked'); + is ($object->flag_clear ('locked', @trace), 1, + ' and clearing locked works'); + is ($object->destroy (@trace), 1, ' and destroying it succeeds'); + ok (! created ('wallet/one'), ' and now it does not exist'); + + # Test history (which should still work after the object is deleted). + $history .= <<"EOO"; +$date create + by $user from $host +$date set flag locked + by $user from $host +$date clear flag locked + by $user from $host +$date get + by $user from $host +$date destroy + by $user from $host +$date create + by $user from $host +$date set flag locked + by $user from $host +$date clear flag locked + by $user from $host +$date destroy + by $user from $host +EOO + is ($object->history, $history, 'History is correct to this point'); + + # Test configuration errors. + undef $Wallet::Config::KEYTAB_FILE; + $object = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) + }; + is ($object, undef, 'Creating with bad configuration fails'); + is ($@, "keytab object implementation not configured\n", + ' with the right error'); + $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; + undef $Wallet::Config::KEYTAB_PRINCIPAL; + $object = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) + }; + is ($object, undef, ' likewise with another missing variable'); + is ($@, "keytab object implementation not configured\n", + ' with the right error'); + $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal'); + undef $Wallet::Config::KEYTAB_REALM; + $object = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) + }; + is ($object, undef, ' and another'); + is ($@, "keytab object implementation not configured\n", + ' with the right error'); + $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); + undef $Wallet::Config::KEYTAB_KRBTYPE; + $object = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) + }; + is ($object, undef, ' and another'); + is ($@, "keytab object implementation not configured\n", + ' with the right error'); + $Wallet::Config::KEYTAB_KRBTYPE = 'Active Directory'; + $object = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) + }; + is ($object, undef, ' and one set to an invalid value'); + is ($@, "unknown KEYTAB_KRBTYPE setting: Active Directory\n", + ' with the right error'); + $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); +} + +# Tests for unchanging support. Skip these if we don't have a keytab or if we +# can't find remctld. +SKIP: { + skip 'no keytab configuration', 32 unless -f 't/data/test.keytab'; + + # Set up our configuration. + $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; + $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal'); + $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); + $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); + $Wallet::Config::KEYTAB_TMP = '.'; + my $realm = $Wallet::Config::KEYTAB_REALM; + my $principal = $Wallet::Config::KEYTAB_PRINCIPAL; + + # Create the objects for testing and set the unchanging flag. + my $one = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) + }; + ok (defined ($one), 'Creating wallet/one succeeds'); + is ($one->flag_set ('unchanging', @trace), 1, ' and setting unchanging'); + my $two = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/two', $schema, + @trace); + }; + ok (defined ($two), 'Creating wallet/two succeeds'); + is ($two->flag_set ('unchanging', @trace), 1, ' and setting unchanging'); + + # Finally we can test. First the MIT Kerberos tests. + SKIP: { + skip 'skipping MIT unchanging tests for Heimdal', 16 + if (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'heimdal'); + + # We need remctld and Net::Remctl. + my @path = (split (':', $ENV{PATH}), '/usr/local/sbin', '/usr/sbin'); + my ($remctld) = grep { -x $_ } map { "$_/remctld" } @path; + skip 'remctld not found', 16 unless $remctld; + eval { require Net::Remctl }; + skip 'Net::Remctl not available', 16 if $@; + + # Now spawn our remctld server and get a ticket cache. + remctld_spawn ($remctld, $principal, 't/data/test.keytab', + 't/data/keytab.conf'); + $ENV{KRB5CCNAME} = 'krb5cc_test'; + getcreds ('t/data/test.keytab', $principal); + $ENV{KRB5CCNAME} = 'krb5cc_good'; + + # Do the unchanging tests for MIT Kerberos. + is ($one->get (@trace), undef, 'Get without configuration fails'); + is ($one->error, 'keytab unchanging support not configured', + ' with the right error'); + $Wallet::Config::KEYTAB_REMCTL_CACHE = 'krb5cc_test'; + is ($one->get (@trace), undef, ' and still fails without host'); + is ($one->error, 'keytab unchanging support not configured', + ' with the right error'); + $Wallet::Config::KEYTAB_REMCTL_HOST = 'localhost'; + $Wallet::Config::KEYTAB_REMCTL_PRINCIPAL = $principal; + $Wallet::Config::KEYTAB_REMCTL_PORT = 14373; + is ($one->get (@trace), undef, ' and still fails without ACL'); + is ($one->error, + "cannot retrieve keytab for wallet/one\@$realm: Access denied", + ' with the right error'); + open (ACL, '>', 'test-acl') or die "cannot create test-acl: $!\n"; + print ACL "$principal\n"; + close ACL; + is ($one->get (@trace), 'Keytab for wallet/one', 'Now get works'); + is ($ENV{KRB5CCNAME}, 'krb5cc_good', + ' and we did not nuke the cache name'); + is ($one->get (@trace), 'Keytab for wallet/one', + ' and we get the same thing the second time'); + is ($one->flag_clear ('unchanging', @trace), 1, + 'Clearing the unchanging flag works'); + my $data = $one->get (@trace); + ok (defined ($data), ' and getting the keytab works'); + ok (keytab_valid ($data, 'wallet/one'), ' and the keytab is valid'); + is ($two->get (@trace), undef, 'Get for wallet/two does not work'); + is ($two->error, + "cannot retrieve keytab for wallet/two\@$realm: bite me", + ' with the right error'); + is ($one->destroy (@trace), 1, 'Destroying wallet/one works'); + is ($two->destroy (@trace), 1, ' as does destroying wallet/two'); + remctld_stop; + unlink 'krb5cc_good'; + } + + # Now Heimdal. Since the keytab contains timestamps, before testing for + # equality we have to substitute out the timestamps. + SKIP: { + skip 'skipping Heimdal unchanging tests for MIT', 11 + if (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'mit'); + my $data = $one->get (@trace); + ok (defined $data, 'Get of unchanging keytab works'); + ok (keytab_valid ($data, 'wallet/one'), ' and the keytab is valid'); + my $second = $one->get (@trace); + ok (defined $second, ' and second retrieval also works'); + $data =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g; + $second =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g; + ok (keytab_valid ($second, 'wallet/one'), ' and the keytab is valid'); + ok (keytab_valid ($data, 'wallet/one'), ' as is the first keytab'); + is ($one->flag_clear ('unchanging', @trace), 1, + 'Clearing the unchanging flag works'); + $data = $one->get (@trace); + ok (defined ($data), ' and getting the keytab works'); + ok (keytab_valid ($data, 'wallet/one'), ' and the keytab is valid'); + $data =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g; + ok ($data ne $second, ' and the new keytab is different'); + is ($one->destroy (@trace), 1, 'Destroying wallet/one works'); + is ($two->destroy (@trace), 1, ' as does destroying wallet/two'); + } + + # Check that history has been updated correctly. + $history .= <<"EOO"; +$date create + by $user from $host +$date set flag unchanging + by $user from $host +$date get + by $user from $host +$date get + by $user from $host +$date clear flag unchanging + by $user from $host +$date get + by $user from $host +$date destroy + by $user from $host +EOO + is ($one->history, $history, 'History is correct to this point'); +} + +# Tests for synchronization support. This code is deactivated at present +# since no synchronization targets are supported, but we want to still test +# the basic stub code. +SKIP: { + skip 'no keytab configuration', 18 unless -f 't/data/test.keytab'; + + # Test setting synchronization attributes, which can also be done without + # configuration. + my $one = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) + }; + ok (defined ($one), 'Creating wallet/one succeeds'); + my $expected = <<"EOO"; + Type: keytab + Name: wallet/one + Created by: $user + Created from: $host + Created on: $date +EOO + is ($one->show, $expected, 'Show output displays no attributes'); + is ($one->attr ('foo', [ 'bar' ], @trace), undef, + 'Setting unknown attribute fails'); + is ($one->error, 'unknown attribute foo', ' with the right error'); + my @targets = $one->attr ('foo'); + is (scalar (@targets), 0, ' and getting an unknown attribute fails'); + is ($one->error, 'unknown attribute foo', ' with the right error'); + is ($one->attr ('sync', [ 'kaserver' ], @trace), undef, + ' and setting an unknown sync target fails'); + is ($one->error, 'unsupported synchronization target kaserver', + ' with the right error'); + is ($one->attr ('sync', [ 'kaserver', 'bar' ], @trace), undef, + ' and setting two targets fails'); + is ($one->error, 'only one synchronization target supported', + ' with the right error'); + + # Create a synchronization manually so that we can test the display and + # removal code. + my $sql = "insert into keytab_sync (ks_name, ks_target) values + ('wallet/one', 'kaserver')"; + $dbh->do ($sql); + @targets = $one->attr ('sync'); + is (scalar (@targets), 1, ' and now one target is set'); + is ($targets[0], 'kaserver', ' and it is correct'); + is ($one->error, undef, ' and there is no error'); + $expected = <<"EOO"; + Type: keytab + Name: wallet/one + Synced with: kaserver + Created by: $user + Created from: $host + Created on: $date +EOO + is ($one->show, $expected, ' and show now displays the attribute'); + $history .= <<"EOO"; +$date create + by $user from $host +EOO + is ($one->history, $history, ' and history is correct for attributes'); + is ($one->attr ('sync', [], @trace), 1, + 'Removing the kaserver sync attribute works'); + is ($one->destroy (@trace),1, ' and then destroying wallet/one works'); + $history .= <<"EOO"; +$date remove kaserver from attribute sync + by $user from $host +$date destroy + by $user from $host +EOO + is ($one->history, $history, ' and history is correct for removal'); +} + +# Tests for enctype restriction. +SKIP: { + skip 'no keytab configuration', 37 unless -f 't/data/test.keytab'; + + # Set up our configuration. + $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; + $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal'); + $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); + $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); + $Wallet::Config::KEYTAB_TMP = '.'; + my $realm = $Wallet::Config::KEYTAB_REALM; + my $principal = $Wallet::Config::KEYTAB_PRINCIPAL; + + # Create an object for testing and determine the enctypes we have to work + # with. + my $one = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) + }; + if (defined ($one)) { + ok (1, 'Creating wallet/one succeeds'); + } else { + is ($@, '', 'Creating wallet/one succeeds'); + } + my $keytab = $one->get (@trace); + ok (defined ($keytab), ' and retrieving the keytab works'); + my @enctypes = grep { $_ ne 'UNKNOWN' } enctypes ($keytab); + $history .= <<"EOO"; +$date create + by $user from $host +$date get + by $user from $host +EOO + is ($one->history, $history, ' and history is still correct'); + + # No enctypes we recognize? + skip 'no recognized enctypes', 34 unless @enctypes; + + # Set those encryption types and make sure we get back a limited keytab. + is ($one->attr ('enctypes', [ @enctypes ], @trace), 1, + 'Setting enctypes works'); + is ($one->error, undef, ' with no error'); + for my $enctype (@enctypes) { + $history .= "$date add $enctype to attribute enctypes\n"; + $history .= " by $user from $host\n"; + } + my @values = $one->attr ('enctypes'); + is ("@values", "@enctypes", ' and we get back the right enctype list'); + my $eshow = join ("\n" . (' ' x 17), @enctypes); + $eshow =~ s/\s+\z/\n/; + my $expected = <<"EOO"; + Type: keytab + Name: wallet/one + Enctypes: $eshow + Created by: $user + Created from: $host + Created on: $date + Downloaded by: $user +Downloaded from: $host + Downloaded on: $date +EOO + is ($one->show, $expected, ' and show now displays the enctype list'); + $keytab = $one->get (@trace); + ok (defined ($keytab), ' and retrieving the keytab still works'); + @values = enctypes ($keytab); + is ("@values", "@enctypes", ' and the keytab has the right keys'); + is ($one->attr ('enctypes', [ 'foo-bar' ], @trace), undef, + 'Setting an unrecognized enctype fails'); + is ($one->error, 'unknown encryption type foo-bar', + ' with the right error message'); + is ($one->show, $expected, ' and we did rollback properly'); + $history .= <<"EOO"; +$date get + by $user from $host +EOO + is ($one->history, $history, 'History is correct to this point'); + + # Now, try testing limiting the enctypes to just one. + SKIP: { + skip 'insufficient recognized enctypes', 14 unless @enctypes > 1; + + is ($one->attr ('enctypes', [ $enctypes[0] ], @trace), 1, + 'Setting a single enctype works'); + for my $enctype (@enctypes) { + next if $enctype eq $enctypes[0]; + $history .= "$date remove $enctype from attribute enctypes\n"; + $history .= " by $user from $host\n"; + } + @values = $one->attr ('enctypes'); + is ("@values", $enctypes[0], ' and we get back the right value'); + $keytab = $one->get (@trace); + ok (defined ($keytab), ' and retrieving the keytab still works'); + if (defined ($keytab)) { + @values = enctypes ($keytab); + is ("@values", $enctypes[0], ' and it has the right enctype'); + } else { + ok (0, ' and it has the right keytab'); + } + is ($one->attr ('enctypes', [ $enctypes[1] ], @trace), 1, + 'Setting a different single enctype works'); + @values = $one->attr ('enctypes'); + is ("@values", $enctypes[1], ' and we get back the right value'); + $keytab = $one->get (@trace); + ok (defined ($keytab), ' and retrieving the keytab still works'); + @values = enctypes ($keytab); + is ("@values", $enctypes[1], ' and it has the right enctype'); + is ($one->attr ('enctypes', [ @enctypes[0..1] ], @trace), 1, + 'Setting two enctypes works'); + @values = $one->attr ('enctypes'); + is ("@values", "@enctypes[0..1]", ' and we get back the right values'); + $keytab = $one->get (@trace); + ok (defined ($keytab), ' and retrieving the keytab still works'); + @values = enctypes ($keytab); + is ("@values", "@enctypes[0..1]", ' and it has the right enctypes'); + + # Check the history trace. Put back all the enctypes for consistent + # status whether or not we skipped this section. + $history .= <<"EOO"; +$date get + by $user from $host +$date remove $enctypes[0] from attribute enctypes + by $user from $host +$date add $enctypes[1] to attribute enctypes + by $user from $host +$date get + by $user from $host +$date add $enctypes[0] to attribute enctypes + by $user from $host +$date get + by $user from $host +EOO + is ($one->attr ('enctypes', [ @enctypes ], @trace), 1, + 'Restoring all enctypes works'); + for my $enctype (@enctypes) { + next if $enctype eq $enctypes[0]; + next if $enctype eq $enctypes[1]; + $history .= "$date add $enctype to attribute enctypes\n"; + $history .= " by $user from $host\n"; + } + is ($one->history, $history, 'History is correct to this point'); + } + + # Test clearing enctypes. + is ($one->attr ('enctypes', [], @trace), 1, 'Clearing enctypes works'); + for my $enctype (@enctypes) { + $history .= "$date remove $enctype from attribute enctypes\n"; + $history .= " by $user from $host\n"; + } + @values = $one->attr ('enctypes'); + ok (@values == 0, ' and now there are no enctypes'); + is ($one->error, undef, ' and no error'); + + # Test deleting enctypes on object destruction. + is ($one->attr ('enctypes', [ $enctypes[0] ], @trace), 1, + 'Setting a single enctype works'); + is ($one->destroy (@trace), 1, ' and destroying the object works'); + $one = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) + }; + ok (defined ($one), ' as does recreating it'); + @values = $one->attr ('enctypes'); + ok (@values == 0, ' and now there are no enctypes'); + is ($one->error, undef, ' and no error'); + + # All done. Clean up and check history. + is ($one->destroy (@trace), 1, 'Destroying wallet/one works'); + $history .= <<"EOO"; +$date add $enctypes[0] to attribute enctypes + by $user from $host +$date destroy + by $user from $host +$date create + by $user from $host +$date destroy + by $user from $host +EOO + is ($one->history, $history, 'History is correct to this point'); +} + +# Clean up. +$admin->destroy; +END { + unlink ('wallet-db', 'krb5cc_temp', 'krb5cc_test', 'test-acl', 'test-pid'); +} diff --git a/perl/t/object/wa-keyring.t b/perl/t/object/wa-keyring.t new file mode 100755 index 0000000..4a3bd48 --- /dev/null +++ b/perl/t/object/wa-keyring.t @@ -0,0 +1,183 @@ +#!/usr/bin/perl +# +# Tests for the WebAuth keyring object implementation. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2013, 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +use strict; +use warnings; + +use Test::More; + +BEGIN { + eval 'use WebAuth 3.06 qw(WA_KEY_AES WA_AES_128)'; + plan skip_all => 'WebAuth 3.06 required for testing wa-keyring' + if $@; +} + +use WebAuth::Key 1.01 (); +use WebAuth::Keyring 1.02 (); + +BEGIN { + plan tests => 68; + use_ok('Wallet::Admin'); + use_ok('Wallet::Config'); + use_ok('Wallet::Object::WAKeyring'); +} + +use lib 't/lib'; +use Util; + +# Some global defaults to use. +my $user = 'admin@EXAMPLE.COM'; +my $host = 'localhost'; +my @trace = ($user, $host, time); + +# Flush all output immediately. +$| = 1; + +# Use Wallet::Admin to set up the database. +system ('rm -rf test-keyrings') == 0 or die "cannot remove test-keyrings\n"; +db_setup; +my $admin = eval { Wallet::Admin->new }; +is ($@, '', 'Database connection succeeded'); +is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); +my $schema = $admin->schema; + +# Create a WebAuth context to use. +my $wa = WebAuth->new; + +# Test error handling in the absence of configuration. +my $object = eval { + Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace) + }; +ok (defined ($object), 'Creating a basic WebAuth keyring object succeeds'); +ok ($object->isa ('Wallet::Object::WAKeyring'), ' and is the right class'); +is ($object->get (@trace), undef, ' and get fails'); +is ($object->error, 'WebAuth keyring support not configured', + ' with the right error'); +is ($object->store (@trace), undef, ' and store fails'); +is ($object->error, 'WebAuth keyring support not configured', + ' with the right error'); +is ($object->destroy (@trace), 1, ' but destroy succeeds'); + +# Set up our configuration. +mkdir 'test-keyrings' or die "cannot create test-keyrings: $!\n"; +$Wallet::Config::WAKEYRING_BUCKET = 'test-keyrings'; + +# Okay, now we can test. First, the basic object without store. +$object = eval { + Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace) + }; +ok (defined ($object), 'Creating a basic WebAuth keyring object succeeds'); +ok ($object->isa ('Wallet::Object::WAKeyring'), ' and is the right class'); +my $data = $object->get (@trace); +ok ($data, ' and get succeeds'); +my $keyring = WebAuth::Keyring->decode ($wa, $data); +ok ($keyring->isa ('WebAuth::Keyring'), ' and resulting keyring decodes'); +my @entries = $keyring->entries; +is (scalar (@entries), 3, ' and has three entries'); +is ($entries[0]->creation, 0, 'First has good creation'); +is ($entries[0]->key->type, WA_KEY_AES, ' and key type'); +is ($entries[0]->key->length, WA_AES_128, ' and key length'); +is ($entries[0]->valid_after, 0, ' and validity'); +ok ((time - $entries[1]->creation) < 2, 'Second has good creation'); +is ($entries[1]->key->type, WA_KEY_AES, ' and key type'); +is ($entries[1]->key->length, WA_AES_128, ' and key length'); +ok (($entries[1]->valid_after - time) <= 60 * 60 * 24, + ' and validity (upper)'); +ok (($entries[1]->valid_after - time) > 60 * 60 * 24 - 2, + ' and validity (lower)'); +ok ((time - $entries[2]->creation) < 2, 'Third has good creation'); +is ($entries[2]->key->type, WA_KEY_AES, ' and key type'); +is ($entries[2]->key->length, WA_AES_128, ' and key length'); +ok (($entries[2]->valid_after - time) <= 2 * 60 * 60 * 24, + ' and validity (upper)'); +ok (($entries[2]->valid_after - time) > 2 * 60 * 60 * 24 - 2, + ' and validity (lower)'); +my $data2 = $object->get (@trace); +is ($data2, $data, 'Getting the object again returns the same data'); +is ($object->error, undef, ' with no error'); +is ($object->destroy (@trace), 1, 'Destroying the object succeeds'); + +# Now store something and be sure that we get something reasonable. +$object = eval { + Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace) + }; +ok (defined ($object), 'Recreating the object succeeds'); +my $key = WebAuth::Key->new ($wa, WA_KEY_AES, WA_AES_128); +$keyring = WebAuth::Keyring->new ($wa, $key); +$data = $keyring->encode; +is ($object->store ($data, @trace), 1, ' and storing data in it succeeds'); +ok (-d 'test-keyrings/09', ' and the hash bucket was created'); +ok (-f 'test-keyrings/09/test', ' and the file exists'); +is (contents ('test-keyrings/09/test'), $data, ' with the right contents'); +$data = $object->get (@trace); +$keyring = WebAuth::Keyring->decode ($wa, $data); +ok ($keyring->isa ('WebAuth::Keyring'), ' and get returns a valid keyring'); +@entries = $keyring->entries; +is (scalar (@entries), 2, ' and has three entries'); +is ($entries[0]->creation, 0, 'First has good creation'); +is ($entries[0]->key->type, WA_KEY_AES, ' and key type'); +is ($entries[0]->key->length, WA_AES_128, ' and key length'); +is ($entries[0]->valid_after, 0, ' and validity'); +is ($entries[0]->key->data, $key->data, ' and matches the original key'); +ok ((time - $entries[1]->creation) < 2, 'Second has good creation'); +is ($entries[1]->key->type, WA_KEY_AES, ' and key type'); +is ($entries[1]->key->length, WA_AES_128, ' and key length'); +ok (($entries[1]->valid_after - time) <= 2 * 60 * 60 * 24, + ' and validity (upper)'); +ok (($entries[1]->valid_after - time) > 2 * 60 * 60 * 24 - 2, + ' and validity (lower)'); + +# Test pruning. Add another old key and a couple of more current keys to the +# current keyring. +$key = WebAuth::Key->new ($wa, WA_KEY_AES, WA_AES_128); +$keyring->add (0, 0, $key); +$key = WebAuth::Key->new ($wa, WA_KEY_AES, WA_AES_128); +$keyring->add (time - 24 * 60 * 60, time - 24 * 60 * 60, $key); +$key = WebAuth::Key->new ($wa, WA_KEY_AES, WA_AES_128); +$keyring->add (time, time, $key); +$data = $keyring->encode; +is ($object->store ($data, @trace), 1, 'Storing modified keyring succeeds'); +$data = $object->get (@trace); +$keyring = WebAuth::Keyring->decode ($wa, $data); +ok ($keyring->isa ('WebAuth::Keyring'), ' and get returns a valid keyring'); +@entries = $keyring->entries; +is (scalar (@entries), 3, ' and has three entries'); +ok ((time - $entries[0]->creation) < 2, 'First has good creation'); +ok (($entries[0]->valid_after - time) <= 2 * 60 * 60 * 24, + ' and validity (upper)'); +ok (($entries[0]->valid_after - time) > 2 * 60 * 60 * 24 - 2, + ' and validity (lower)'); +ok ((time - $entries[1]->creation) < 24 * 60 * 60 + 2, + 'Second has good creation'); +ok ((time - $entries[1]->valid_after) <= 60 * 60 * 24 + 2, + ' and validity'); +ok ((time - $entries[2]->creation) < 2, 'Third has good creation'); +ok ((time - $entries[2]->valid_after) < 2, ' and validity'); +is ($object->destroy (@trace), 1, 'Destroying the object succeeds'); + +# Test error handling in the file store. +system ('rm -r test-keyrings') == 0 or die "cannot remove test-keyrings\n"; +$object = eval { + Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace) + }; +ok (defined ($object), 'Recreating the object succeeds'); +is ($object->get (@trace), undef, ' but retrieving it fails'); +like ($object->error, qr/^cannot create keyring bucket 09: /, + ' with the right error'); +is ($object->store ("foo\n", @trace), undef, ' and store fails'); +like ($object->error, qr/^cannot create keyring bucket 09: /, + ' with the right error'); +is ($object->destroy (@trace), 1, ' but destroying the object succeeds'); + +# Clean up. +$admin->destroy; +END { + unlink ('wallet-db'); +} |