From 1575d5c34a2c6235bbf6a5010f8a8c142fe47079 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 11 Jul 2014 21:39:23 -0700 Subject: Switch to Module::Build for the Perl module The wallet server now requires Perl 5.8 or later (instead of 5.006 in previous versions) and is now built with Module::Build instead of ExtUtils::MakeMaker. This should be transparent to anyone not working with the source code, since Perl 5.8 was released in 2002, but Module::Build is now required to build the wallet server. It is included in some versions of Perl, or can be installed separately from CPAN, distribution packages, or other sources. Also reorganize the test suite to use subdirectories. Change-Id: Id06120ba2bad1ebbfee3d8a48ca2f25869463165 Reviewed-on: https://gerrit.stanford.edu/1530 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/t/object/base.t | 353 +++++++++++++++++++++ perl/t/object/duo.t | 157 +++++++++ perl/t/object/file.t | 150 +++++++++ perl/t/object/keytab.t | 771 +++++++++++++++++++++++++++++++++++++++++++++ perl/t/object/wa-keyring.t | 184 +++++++++++ 5 files changed, 1615 insertions(+) create mode 100755 perl/t/object/base.t create mode 100755 perl/t/object/duo.t create mode 100755 perl/t/object/file.t create mode 100755 perl/t/object/keytab.t create mode 100755 perl/t/object/wa-keyring.t (limited to 'perl/t/object') diff --git a/perl/t/object/base.t b/perl/t/object/base.t new file mode 100755 index 0000000..0432a23 --- /dev/null +++ b/perl/t/object/base.t @@ -0,0 +1,353 @@ +#!/usr/bin/perl -w +# +# Tests for the basic object implementation. +# +# Written by Russ Allbery +# Copyright 2007, 2008, 2011, 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +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->id, ' 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->id, ' 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->id, @trace), 1, + ' and setting it again 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, 1, ' 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), 1, " 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 +# 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..0aecd9d --- /dev/null +++ b/perl/t/object/file.t @@ -0,0 +1,150 @@ +#!/usr/bin/perl -w +# +# Tests for the file object implementation. +# +# Written by Russ Allbery +# Copyright 2008, 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +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. +$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..127762a --- /dev/null +++ b/perl/t/object/keytab.t @@ -0,0 +1,771 @@ +#!/usr/bin/perl -w +# +# Tests for the keytab object implementation. +# +# Written by Russ Allbery +# Copyright 2007, 2008, 2009, 2010, 2013, 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +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 () { + next unless /^ *\d+ /; + my ($string) = /\((.*)\)\s*$/; + next unless $string; + $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 () { + 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; + $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', 31 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', 36 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/; + $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..8d8e1fe --- /dev/null +++ b/perl/t/object/wa-keyring.t @@ -0,0 +1,184 @@ +#!/usr/bin/perl +# +# Tests for the WebAuth keyring object implementation. +# +# Written by Russ Allbery +# 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 POSIX qw(strftime); +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'); +} -- cgit v1.2.3 From 1329e6db944a6fce5578b249de08a8250a920877 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 11 Jul 2014 22:36:11 -0700 Subject: Test for Perl strict and minimum version Fix strictness issues across the whole code base, and ensure that all Perl scripts enable warnings. (Hopefully enabling warnings won't cause problems for the server.) Change-Id: I4dee49f7a6bcbeeee21d74bf61a1fd26514f832c Reviewed-on: https://gerrit.stanford.edu/1532 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- Makefile.am | 8 ++-- README | 34 ++++++++++++----- contrib/wallet-summary | 33 +++++++++-------- contrib/wallet-unknown-hosts | 36 ++++++++++-------- perl/lib/Wallet/ACL.pm | 3 +- perl/lib/Wallet/ACL/Base.pm | 3 +- perl/lib/Wallet/ACL/Krb5.pm | 3 +- perl/lib/Wallet/ACL/Krb5/Regex.pm | 3 +- perl/lib/Wallet/ACL/LDAP/Attribute.pm | 3 +- perl/lib/Wallet/ACL/NetDB.pm | 3 +- perl/lib/Wallet/ACL/NetDB/Root.pm | 3 +- perl/lib/Wallet/Admin.pm | 3 +- perl/lib/Wallet/Config.pm | 1 + perl/lib/Wallet/Database.pm | 3 +- perl/lib/Wallet/Kadmin.pm | 3 +- perl/lib/Wallet/Kadmin/Heimdal.pm | 1 + perl/lib/Wallet/Kadmin/MIT.pm | 3 +- perl/lib/Wallet/Object/Base.pm | 3 +- perl/lib/Wallet/Object/Duo.pm | 1 + perl/lib/Wallet/Object/File.pm | 3 +- perl/lib/Wallet/Object/Keytab.pm | 3 +- perl/lib/Wallet/Object/WAKeyring.pm | 3 +- perl/lib/Wallet/Report.pm | 3 +- perl/lib/Wallet/Server.pm | 3 +- perl/t/data/perl.conf | 7 ++++ perl/t/general/acl.t | 5 ++- perl/t/general/admin.t | 7 +++- perl/t/general/config.t | 7 +++- perl/t/general/init.t | 5 ++- perl/t/general/report.t | 7 +++- perl/t/general/server.t | 7 +++- perl/t/lib/Util.pm | 3 +- perl/t/object/base.t | 5 ++- perl/t/object/file.t | 7 +++- perl/t/object/keytab.t | 11 ++++-- perl/t/style/minimum-version.t | 47 ++++++++++++++++++++++++ perl/t/style/strict.t | 56 ++++++++++++++++++++++++++++ perl/t/util/kadmin.t | 7 +++- perl/t/verifier/basic.t | 5 ++- perl/t/verifier/ldap-attr.t | 5 ++- perl/t/verifier/netdb.t | 7 +++- server/keytab-backend | 1 + server/wallet-backend | 1 + tests/TESTS | 2 + tests/client/full-t.in | 12 +++--- tests/client/prompt-t.in | 14 ++++--- tests/data/fake-kadmin | 7 +++- tests/perl/minimum-version-t | 69 +++++++++++++++++++++++++++++++++++ tests/perl/strict-t | 66 +++++++++++++++++++++++++++++++++ 49 files changed, 437 insertions(+), 98 deletions(-) create mode 100644 perl/t/data/perl.conf create mode 100755 perl/t/style/minimum-version.t create mode 100755 perl/t/style/strict.t create mode 100755 tests/perl/minimum-version-t create mode 100755 tests/perl/strict-t (limited to 'perl/t/object') diff --git a/Makefile.am b/Makefile.am index 19dbe11..8e65151 100644 --- a/Makefile.am +++ b/Makefile.am @@ -66,6 +66,7 @@ PERL_FILES = perl/Build.PL perl/MANIFEST perl/MANIFEST.SKIP \ perl/t/general/server.t perl/t/lib/Util.pm perl/t/object/base.t \ perl/t/object/duo.t perl/t/object/file.t perl/t/object/keytab.t \ perl/t/object/wa-keyring.t perl/t/policy/stanford.t \ + perl/t/style/minimum-version.t perl/t/style/strict.t \ perl/t/util/kadmin.t perl/t/verifier/basic.t \ perl/t/verifier/ldap-attr.t perl/t/verifier/netdb.t @@ -99,9 +100,10 @@ EXTRA_DIST = .gitignore LICENSE autogen client/wallet.pod \ tests/data/fake-keytab-partial-result tests/data/fake-keytab-rekey \ tests/data/fake-keytab-unknown tests/data/fake-srvtab \ tests/data/full.conf tests/data/perl.conf tests/data/wallet.conf \ - tests/docs/pod-spelling-t tests/docs/pod-t tests/server/admin-t \ - tests/server/backend-t tests/server/keytab-t tests/server/report-t \ - tests/tap/kerberos.sh tests/tap/libtap.sh \ + tests/docs/pod-spelling-t tests/docs/pod-t \ + tests/perl/minimum-version-t tests/perl/strict-t \ + tests/server/admin-t tests/server/backend-t tests/server/keytab-t \ + tests/server/report-t tests/tap/kerberos.sh tests/tap/libtap.sh \ tests/tap/perl/Test/RRA.pm tests/tap/perl/Test/RRA/Automake.pm \ tests/tap/perl/Test/RRA/Config.pm tests/tap/remctl.sh \ tests/util/xmalloc-t $(PERL_FILES) diff --git a/README b/README index e72bc80..ef910bd 100644 --- a/README +++ b/README @@ -118,16 +118,30 @@ REQUIREMENTS server. To run the full test suite, all of the above software requirements must - be met. Tests requiring some bit of software that's not installed - should be skipped, but not all the permutations have been checked. The - full test suite also requires the Test::Pod Perl module (available from - CPAN), that remctld be installed and available on the user's path or in - /usr/local/sbin or /usr/sbin, that sqlite3 be installed and available on - the user's path, that test cases can run services on and connect to port - 14373 on 127.0.0.1, and that kinit and either kvno or kgetcred (which - come with Kerberos) be installed and available on the user's path. The - full test suite also requires a local keytab and some additional - configuration. + be met. The full test suite also requires that remctld be installed and + available on the user's path or in /usr/local/sbin or /usr/sbin, that + sqlite3 be installed and available on the user's path, that test cases + can run services on and connect to port 14373 on 127.0.0.1, and that + kinit and either kvno or kgetcred (which come with Kerberos) be + installed and available on the user's path. The full test suite also + requires a local keytab and some additional configuration. + + The following additional Perl modules will be used if present: + + Test::MinimumVersion + Test::Pod + Test::Spelling + Test::Strict + + All are available on CPAN. Those tests will be skipped if the modules + are not available. + + To enable tests that don't detect functionality problems but are used to + sanity-check the release, set the environment variable RELEASE_TESTING + to a true value. To enable tests that may be sensitive to the local + environment or that produce a lot of false positives without uncovering + many problems, set the environment variable AUTHOR_TESTING to a true + value. To bootstrap from a Git checkout, or if you change the Automake files and need to regenerate Makefile.in, you will need Automake 1.11 or diff --git a/contrib/wallet-summary b/contrib/wallet-summary index 55501ad..5cbf6e0 100755 --- a/contrib/wallet-summary +++ b/contrib/wallet-summary @@ -1,7 +1,22 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Summarize keytabs in the wallet database. +############################################################################## +# Modules and declarations +############################################################################## + +require 5.005; + +use strict; +use vars qw($ADDRESS $DUMPFILE @PATTERNS $REPORTS); +use warnings; + +use Getopt::Long qw(GetOptions); +use File::Path qw(mkpath); +use POSIX qw(strftime); +use Wallet::Report (); + ############################################################################## # Site configuration ############################################################################## @@ -29,20 +44,6 @@ $ADDRESS = 'nobody@example.com'; [qr(^webauth/), 'webauth/*', 'WebAuth v3'], [qr(^service/), 'service/*', 'Service principals']); -############################################################################## -# Modules and declarations -############################################################################## - -require 5.005; - -use strict; -use vars qw($ADDRESS $DUMPFILE @PATTERNS $REPORTS); - -use Getopt::Long qw(GetOptions); -use File::Path qw(mkpath); -use POSIX qw(strftime); -use Wallet::Report (); - ############################################################################## # Database queries ############################################################################## @@ -145,7 +146,7 @@ if ($mail) { } # Run the report. -my @principals = read_dump; +my @principals = read_dump (); report_principals (@principals); # If -m was given, take the saved report and mail it as well. diff --git a/contrib/wallet-unknown-hosts b/contrib/wallet-unknown-hosts index 339983d..50b5a04 100755 --- a/contrib/wallet-unknown-hosts +++ b/contrib/wallet-unknown-hosts @@ -1,7 +1,20 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Report host keytabs in wallet for unknown hosts. +############################################################################## +# Modules and declarations +############################################################################## + +require 5.006; + +use strict; +use warnings; + +use DB_File (); +use Wallet::Report (); +use Wallet::Server (); + ############################################################################## # Site configuration ############################################################################## @@ -22,9 +35,10 @@ our $MIN = 3; our $THRESHOLD = time - 30 * 24 * 60 * 60; # Set up a Net::DNS resolver that will be used by local_check_keytab. +my $DNS; BEGIN { use Net::DNS; - our $DNS = Net::DNS::Resolver->new; + $DNS = Net::DNS::Resolver->new; } # Pre-filter. This is called for all host-based keytabs and is the place to @@ -54,18 +68,6 @@ sub local_check_keytab { return; } -############################################################################## -# Modules and declarations -############################################################################## - -require 5.006; - -use strict; - -use DB_File (); -use Wallet::Report (); -use Wallet::Server (); - ############################################################################## # Utility functions ############################################################################## @@ -97,6 +99,7 @@ sub check_host { # Do a scan of all host-based keytabs in wallet and record those that are not # found in DNS or which should not be used according to site configuration. sub check { + my %history; tie %history, 'DB_File', $HISTORY; my @keytabs = list_keytabs; for my $keytab (@keytabs) { @@ -124,6 +127,7 @@ sub check { # list (given as a threshold time in seconds since epoch). sub report { my ($min, $threshold) = @_; + my %history; tie %history, 'DB_File', $HISTORY; for my $keytab (sort keys %history) { my ($count, $time) = split (',', $history{$keytab}); @@ -142,6 +146,7 @@ sub report { sub purge { my ($user, $min, $threshold) = @_; my $wallet = Wallet::Server->new ($user, 'localhost'); + my %history; tie %history, 'DB_File', $HISTORY; for my $keytab (sort keys %history) { my ($count, $time) = split (',', $history{$keytab}); @@ -161,7 +166,7 @@ sub purge { my $command = shift or die "Usage: $0 (check | report | purge)\n"; if ($command eq 'check') { - check; + check (); } elsif ($command eq 'report') { my ($min, $threshold) = @_; $min = $MIN unless defined ($min); @@ -170,6 +175,7 @@ if ($command eq 'check') { report ($min, $threshold); } elsif ($command eq 'purge') { my $user = $ENV{REMOTE_USER} or die "$0: REMOTE_USER must be set\n"; + my ($min, $threshold) = @_; $min = $MIN unless defined ($min); die "$0: minimum count must be at least 1\n" if $min < 1; $threshold = $THRESHOLD unless defined ($threshold); diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm index 808be3c..9507c64 100644 --- a/perl/lib/Wallet/ACL.pm +++ b/perl/lib/Wallet/ACL.pm @@ -1,7 +1,7 @@ # Wallet::ACL -- Implementation of ACLs in the wallet system. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010, 2013 +# Copyright 2007, 2008, 2010, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL; require 5.006; use strict; +use warnings; use vars qw($VERSION); use DBI; diff --git a/perl/lib/Wallet/ACL/Base.pm b/perl/lib/Wallet/ACL/Base.pm index b6e4ce3..a2b07cc 100644 --- a/perl/lib/Wallet/ACL/Base.pm +++ b/perl/lib/Wallet/ACL/Base.pm @@ -1,7 +1,7 @@ # Wallet::ACL::Base -- Parent class for wallet ACL verifiers. # # Written by Russ Allbery -# Copyright 2007, 2010 +# Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL::Base; require 5.006; use strict; +use warnings; use vars qw($VERSION); # This version should be increased on any code change to this module. Always diff --git a/perl/lib/Wallet/ACL/Krb5.pm b/perl/lib/Wallet/ACL/Krb5.pm index ed0b7df..80d32bd 100644 --- a/perl/lib/Wallet/ACL/Krb5.pm +++ b/perl/lib/Wallet/ACL/Krb5.pm @@ -1,7 +1,7 @@ # Wallet::ACL::Krb5 -- Wallet Kerberos v5 principal ACL verifier. # # Written by Russ Allbery -# Copyright 2007, 2010 +# Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL::Krb5; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::ACL::Base; diff --git a/perl/lib/Wallet/ACL/Krb5/Regex.pm b/perl/lib/Wallet/ACL/Krb5/Regex.pm index 30f5527..4934cfc 100644 --- a/perl/lib/Wallet/ACL/Krb5/Regex.pm +++ b/perl/lib/Wallet/ACL/Krb5/Regex.pm @@ -1,7 +1,7 @@ # Wallet::ACL::Krb5::Regex -- Wallet Kerberos v5 principal regex ACL verifier # # Written by Russ Allbery -# Copyright 2007, 2010 +# Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL::Krb5::Regex; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::ACL::Krb5; diff --git a/perl/lib/Wallet/ACL/LDAP/Attribute.pm b/perl/lib/Wallet/ACL/LDAP/Attribute.pm index aea8a72..c27729e 100644 --- a/perl/lib/Wallet/ACL/LDAP/Attribute.pm +++ b/perl/lib/Wallet/ACL/LDAP/Attribute.pm @@ -1,7 +1,7 @@ # Wallet::ACL::LDAP::Attribute -- Wallet LDAP attribute ACL verifier. # # Written by Russ Allbery -# Copyright 2012, 2013 +# Copyright 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL::LDAP::Attribute; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Authen::SASL (); diff --git a/perl/lib/Wallet/ACL/NetDB.pm b/perl/lib/Wallet/ACL/NetDB.pm index b76d4ed..ad2164b 100644 --- a/perl/lib/Wallet/ACL/NetDB.pm +++ b/perl/lib/Wallet/ACL/NetDB.pm @@ -1,7 +1,7 @@ # Wallet::ACL::NetDB -- Wallet NetDB role ACL verifier. # # Written by Russ Allbery -# Copyright 2007, 2010 +# Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL::NetDB; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::ACL::Base; diff --git a/perl/lib/Wallet/ACL/NetDB/Root.pm b/perl/lib/Wallet/ACL/NetDB/Root.pm index 6c95c6e..34163e7 100644 --- a/perl/lib/Wallet/ACL/NetDB/Root.pm +++ b/perl/lib/Wallet/ACL/NetDB/Root.pm @@ -1,7 +1,7 @@ # Wallet::ACL::NetDB::Root -- Wallet NetDB role ACL verifier (root instances). # # Written by Russ Allbery -# Copyright 2007, 2010 +# Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL::NetDB::Root; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::ACL::NetDB; diff --git a/perl/lib/Wallet/Admin.pm b/perl/lib/Wallet/Admin.pm index 3a05284..d39c272 100644 --- a/perl/lib/Wallet/Admin.pm +++ b/perl/lib/Wallet/Admin.pm @@ -1,7 +1,7 @@ # Wallet::Admin -- Wallet system administrative interface. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010, 2011, 2012, 2013 +# Copyright 2008, 2009, 2010, 2011, 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Admin; require 5.006; use strict; +use warnings; use vars qw($VERSION); use Wallet::ACL; diff --git a/perl/lib/Wallet/Config.pm b/perl/lib/Wallet/Config.pm index 5b0ab1c..527658c 100644 --- a/perl/lib/Wallet/Config.pm +++ b/perl/lib/Wallet/Config.pm @@ -10,6 +10,7 @@ package Wallet::Config; require 5.006; use strict; +use warnings; use vars qw($PATH $VERSION); # This version should be increased on any code change to this module. Always diff --git a/perl/lib/Wallet/Database.pm b/perl/lib/Wallet/Database.pm index 031be9e..3a4e130 100644 --- a/perl/lib/Wallet/Database.pm +++ b/perl/lib/Wallet/Database.pm @@ -6,7 +6,7 @@ # like DBIx::Class objects in the rest of the code. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010, 2012, 2013 +# Copyright 2008, 2009, 2010, 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -19,6 +19,7 @@ package Wallet::Database; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::Schema; diff --git a/perl/lib/Wallet/Kadmin.pm b/perl/lib/Wallet/Kadmin.pm index 4ea7920..65a5700 100644 --- a/perl/lib/Wallet/Kadmin.pm +++ b/perl/lib/Wallet/Kadmin.pm @@ -1,7 +1,7 @@ # Wallet::Kadmin -- Kerberos administration API for wallet keytab backend. # # Written by Jon Robertson -# Copyright 2009, 2010 +# Copyright 2009, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Kadmin; require 5.006; use strict; +use warnings; use vars qw($VERSION); use Wallet::Config (); diff --git a/perl/lib/Wallet/Kadmin/Heimdal.pm b/perl/lib/Wallet/Kadmin/Heimdal.pm index 42de8e0..1208801 100644 --- a/perl/lib/Wallet/Kadmin/Heimdal.pm +++ b/perl/lib/Wallet/Kadmin/Heimdal.pm @@ -14,6 +14,7 @@ package Wallet::Kadmin::Heimdal; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Heimdal::Kadm5 qw(KRB5_KDB_DISALLOW_ALL_TIX); diff --git a/perl/lib/Wallet/Kadmin/MIT.pm b/perl/lib/Wallet/Kadmin/MIT.pm index 1ae01bf..ac45265 100644 --- a/perl/lib/Wallet/Kadmin/MIT.pm +++ b/perl/lib/Wallet/Kadmin/MIT.pm @@ -2,7 +2,7 @@ # # Written by Russ Allbery # Pulled into a module by Jon Robertson -# Copyright 2007, 2008, 2009, 2010 +# Copyright 2007, 2008, 2009, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -15,6 +15,7 @@ package Wallet::Kadmin::MIT; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::Config (); diff --git a/perl/lib/Wallet/Object/Base.pm b/perl/lib/Wallet/Object/Base.pm index 8debac9..a009d76 100644 --- a/perl/lib/Wallet/Object/Base.pm +++ b/perl/lib/Wallet/Object/Base.pm @@ -1,7 +1,7 @@ # Wallet::Object::Base -- Parent class for any object stored in the wallet. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010, 2011 +# Copyright 2007, 2008, 2010, 2011, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Object::Base; require 5.006; use strict; +use warnings; use vars qw($VERSION); use DBI; diff --git a/perl/lib/Wallet/Object/Duo.pm b/perl/lib/Wallet/Object/Duo.pm index e5773c8..e3fe2da 100644 --- a/perl/lib/Wallet/Object/Duo.pm +++ b/perl/lib/Wallet/Object/Duo.pm @@ -14,6 +14,7 @@ package Wallet::Object::Duo; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use JSON; diff --git a/perl/lib/Wallet/Object/File.pm b/perl/lib/Wallet/Object/File.pm index 4afef04..1ff1288 100644 --- a/perl/lib/Wallet/Object/File.pm +++ b/perl/lib/Wallet/Object/File.pm @@ -1,7 +1,7 @@ # Wallet::Object::File -- File object implementation for the wallet. # # Written by Russ Allbery -# Copyright 2008, 2010 +# Copyright 2008, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Object::File; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Digest::MD5 qw(md5_hex); diff --git a/perl/lib/Wallet/Object/Keytab.pm b/perl/lib/Wallet/Object/Keytab.pm index 24c3302..975179b 100644 --- a/perl/lib/Wallet/Object/Keytab.pm +++ b/perl/lib/Wallet/Object/Keytab.pm @@ -1,7 +1,7 @@ # Wallet::Object::Keytab -- Keytab object implementation for the wallet. # # Written by Russ Allbery -# Copyright 2007, 2008, 2009, 2010, 2013 +# Copyright 2007, 2008, 2009, 2010, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Object::Keytab; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::Config (); diff --git a/perl/lib/Wallet/Object/WAKeyring.pm b/perl/lib/Wallet/Object/WAKeyring.pm index f8bd0f7..3e80300 100644 --- a/perl/lib/Wallet/Object/WAKeyring.pm +++ b/perl/lib/Wallet/Object/WAKeyring.pm @@ -1,7 +1,7 @@ # Wallet::Object::WAKeyring -- WebAuth keyring object implementation. # # Written by Russ Allbery -# Copyright 2012, 2013 +# Copyright 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Object::WAKeyring; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Digest::MD5 qw(md5_hex); diff --git a/perl/lib/Wallet/Report.pm b/perl/lib/Wallet/Report.pm index 1085546..bf48308 100644 --- a/perl/lib/Wallet/Report.pm +++ b/perl/lib/Wallet/Report.pm @@ -1,7 +1,7 @@ # Wallet::Report -- Wallet system reporting interface. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010, 2013 +# Copyright 2008, 2009, 2010, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Report; require 5.006; use strict; +use warnings; use vars qw($VERSION); use Wallet::ACL; diff --git a/perl/lib/Wallet/Server.pm b/perl/lib/Wallet/Server.pm index 3266928..2765d34 100644 --- a/perl/lib/Wallet/Server.pm +++ b/perl/lib/Wallet/Server.pm @@ -1,7 +1,7 @@ # Wallet::Server -- Wallet system server implementation. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010, 2011, 2013 +# Copyright 2007, 2008, 2010, 2011, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Server; require 5.006; use strict; +use warnings; use vars qw(%MAPPING $VERSION); use Wallet::ACL; diff --git a/perl/t/data/perl.conf b/perl/t/data/perl.conf new file mode 100644 index 0000000..ca05568 --- /dev/null +++ b/perl/t/data/perl.conf @@ -0,0 +1,7 @@ +# Configuration for Perl tests. -*- perl -*- + +# Default minimum version requirement. +$MINIMUM_VERSION = '5.008'; + +# File must end with this line. +1; diff --git a/perl/t/general/acl.t b/perl/t/general/acl.t index e633f46..01b4801 100755 --- a/perl/t/general/acl.t +++ b/perl/t/general/acl.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the wallet ACL API. # @@ -8,6 +8,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use POSIX qw(strftime); use Test::More tests => 101; diff --git a/perl/t/general/admin.t b/perl/t/general/admin.t index 41bc33a..7c62932 100755 --- a/perl/t/general/admin.t +++ b/perl/t/general/admin.t @@ -8,6 +8,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 26; use Wallet::Admin; @@ -44,7 +47,7 @@ is ($admin->register_object ('base', 'Wallet::Object::Base'), 1, 'Registering Wallet::Object::Base works'); is ($admin->register_object ('base', 'Wallet::Object::Base'), undef, ' and cannot be registered twice'); -$server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; +my $server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; is ($@, '', 'Creating a server instance did not die'); is ($server->create ('base', 'service/admin'), 1, ' and creating base:service/admin succeeds'); @@ -83,7 +86,7 @@ SKIP: { is ($retval, 1, ' and performing an upgrade to 0.08 succeeds'); my $sql = "select version from dbix_class_schema_versions order by" . " version DESC"; - $version = $admin->dbh->selectall_arrayref ($sql); + my $version = $admin->dbh->selectall_arrayref ($sql); is (@$version, 2, ' and versions table has correct number of rows'); is (@{ $version->[0] }, 1, ' and correct number of columns'); is ($version->[0][0], '0.08', ' and the schema version is correct'); diff --git a/perl/t/general/config.t b/perl/t/general/config.t index 881f2bd..bc200de 100755 --- a/perl/t/general/config.t +++ b/perl/t/general/config.t @@ -1,13 +1,16 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the wallet server configuration. # # Written by Russ Allbery -# Copyright 2008, 2010 +# Copyright 2008, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 6; # Silence warnings since we're not using use. diff --git a/perl/t/general/init.t b/perl/t/general/init.t index b8ec3c9..58b9a4c 100755 --- a/perl/t/general/init.t +++ b/perl/t/general/init.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for database initialization. # @@ -8,6 +8,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 18; use Wallet::ACL; diff --git a/perl/t/general/report.t b/perl/t/general/report.t index 9563362..8d348ed 100755 --- a/perl/t/general/report.t +++ b/perl/t/general/report.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the wallet reporting interface. # @@ -8,6 +8,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 197; use Wallet::Admin; @@ -39,7 +42,7 @@ is ($acls[0][0], 1, ' and that is ACL ID 1'); is ($acls[0][1], 'ADMIN', ' with the right name'); # Create an object. -$server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; +my $server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; is ($@, '', 'Creating a server instance did not die'); is ($server->create ('base', 'service/admin'), 1, ' and creating base:service/admin succeeds'); diff --git a/perl/t/general/server.t b/perl/t/general/server.t index 9026439..0a527a5 100755 --- a/perl/t/general/server.t +++ b/perl/t/general/server.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the wallet server API. # @@ -8,6 +8,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 382; use POSIX qw(strftime); @@ -33,7 +36,7 @@ is ($@, '', 'Database initialization did not die'); is ($setup->reinitialize ($admin), 1, 'Database initialization succeeded'); # Now test the new method. -$server = eval { Wallet::Server->new (@trace) }; +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; diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm index 9e5b95e..187e483 100644 --- a/perl/t/lib/Util.pm +++ b/perl/t/lib/Util.pm @@ -1,7 +1,7 @@ # Utility class for wallet tests. # # Written by Russ Allbery -# Copyright 2007, 2008 +# Copyright 2007, 2008, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -10,6 +10,7 @@ package Util; require 5.006; use strict; +use warnings; use vars qw(@ISA @EXPORT $VERSION); use Wallet::Config; diff --git a/perl/t/object/base.t b/perl/t/object/base.t index 0432a23..11f18b7 100755 --- a/perl/t/object/base.t +++ b/perl/t/object/base.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the basic object implementation. # @@ -8,6 +8,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use POSIX qw(strftime); use Test::More tests => 137; diff --git a/perl/t/object/file.t b/perl/t/object/file.t index 0aecd9d..201f46d 100755 --- a/perl/t/object/file.t +++ b/perl/t/object/file.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the file object implementation. # @@ -8,6 +8,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use POSIX qw(strftime); use Test::More tests => 56; @@ -39,7 +42,7 @@ my $history = ''; my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); # Test error handling in the absence of configuration. -$object = eval { +my $object = eval { Wallet::Object::File->create ('file', 'test', $schema, @trace) }; ok (defined ($object), 'Creating a basic file object succeeds'); diff --git a/perl/t/object/keytab.t b/perl/t/object/keytab.t index 127762a..0f4a8b8 100755 --- a/perl/t/object/keytab.t +++ b/perl/t/object/keytab.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the keytab object implementation. # @@ -8,6 +8,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use POSIX qw(strftime); use Test::More tests => 141; @@ -117,7 +120,7 @@ sub enctypes { next unless /^ *\d+ /; my ($string) = /\((.*)\)\s*$/; next unless $string; - $enctype = $enctype{lc $string} || 'UNKNOWN'; + my $enctype = $enctype{lc $string} || 'UNKNOWN'; push (@enctypes, $enctype); } close KLIST; @@ -174,7 +177,7 @@ SKIP: { # Test that object creation without KEYTAB_TMP fails. undef $Wallet::Config::KEYTAB_TMP; - $object = eval { + my $object = eval { Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, @trace) }; @@ -634,7 +637,7 @@ EOO is ("@values", "@enctypes", ' and we get back the right enctype list'); my $eshow = join ("\n" . (' ' x 17), @enctypes); $eshow =~ s/\s+\z/\n/; - $expected = <<"EOO"; + my $expected = <<"EOO"; Type: keytab Name: wallet/one Enctypes: $eshow diff --git a/perl/t/style/minimum-version.t b/perl/t/style/minimum-version.t new file mode 100755 index 0000000..e4eeafd --- /dev/null +++ b/perl/t/style/minimum-version.t @@ -0,0 +1,47 @@ +#!/usr/bin/perl +# +# Check that too-new features of Perl are not being used. +# +# The canonical version of this file is maintained in the rra-c-util package, +# which can be found at . +# +# Written by Russ Allbery +# Copyright 2013, 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# Permission is hereby granted, free of charge, to any person obtaining a +# copy of this software and associated documentation files (the "Software"), +# to deal in the Software without restriction, including without limitation +# the rights to use, copy, modify, merge, publish, distribute, sublicense, +# and/or sell copies of the Software, and to permit persons to whom the +# Software is furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +# DEALINGS IN THE SOFTWARE. + +use 5.006; +use strict; +use warnings; + +use lib 't/lib'; + +use Test::More; +use Test::RRA qw(skip_unless_automated use_prereq); +use Test::RRA::Config qw($MINIMUM_VERSION); + +# Skip for normal user installs since this doesn't affect functionality. +skip_unless_automated('Minimum version tests'); + +# Load prerequisite modules. +use_prereq('Test::MinimumVersion'); + +# Check all files in the Perl distribution. +all_minimum_version_ok($MINIMUM_VERSION); diff --git a/perl/t/style/strict.t b/perl/t/style/strict.t new file mode 100755 index 0000000..7137b15 --- /dev/null +++ b/perl/t/style/strict.t @@ -0,0 +1,56 @@ +#!/usr/bin/perl +# +# Test Perl code for strict, warnings, and syntax. +# +# The canonical version of this file is maintained in the rra-c-util package, +# which can be found at . +# +# Written by Russ Allbery +# Copyright 2013, 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# Permission is hereby granted, free of charge, to any person obtaining a +# copy of this software and associated documentation files (the "Software"), +# to deal in the Software without restriction, including without limitation +# the rights to use, copy, modify, merge, publish, distribute, sublicense, +# and/or sell copies of the Software, and to permit persons to whom the +# Software is furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +# DEALINGS IN THE SOFTWARE. + +use 5.006; +use strict; +use warnings; + +use lib 't/lib'; + +use File::Spec; +use Test::RRA qw(skip_unless_automated use_prereq); + +# Skip for normal user installs since this doesn't affect functionality. +skip_unless_automated('Strictness tests'); + +# Load prerequisite modules. +use_prereq('Test::Strict'); + +# Test everything in the distribution directory except the Build and +# Makefile.PL scripts generated by Module::Build. We also want to check use +# warnings. +$Test::Strict::TEST_SKIP = ['Build', 'Makefile.PL']; +$Test::Strict::TEST_WARNINGS = 1; +all_perl_files_ok(File::Spec->curdir); + +# Hack to suppress "used only once" warnings. +END { + $Test::Strict::TEST_SKIP = []; + $Test::Strict::TEST_WARNINGS = 0; +} diff --git a/perl/t/util/kadmin.t b/perl/t/util/kadmin.t index 8eabc6b..2a3d984 100755 --- a/perl/t/util/kadmin.t +++ b/perl/t/util/kadmin.t @@ -1,13 +1,16 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the kadmin object implementation. # # Written by Jon Robertson -# Copyright 2009, 2010, 2012, 2013 +# Copyright 2009, 2010, 2012, 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 => 34; diff --git a/perl/t/verifier/basic.t b/perl/t/verifier/basic.t index 5697ae6..ce44d44 100755 --- a/perl/t/verifier/basic.t +++ b/perl/t/verifier/basic.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the basic wallet ACL verifiers. # @@ -8,6 +8,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 57; use Wallet::ACL::Base; diff --git a/perl/t/verifier/ldap-attr.t b/perl/t/verifier/ldap-attr.t index d8e416b..3c132e2 100755 --- a/perl/t/verifier/ldap-attr.t +++ b/perl/t/verifier/ldap-attr.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the LDAP attribute ACL verifier. # @@ -11,6 +11,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More; use lib 't/lib'; diff --git a/perl/t/verifier/netdb.t b/perl/t/verifier/netdb.t index d8fe561..7048ef9 100755 --- a/perl/t/verifier/netdb.t +++ b/perl/t/verifier/netdb.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the NetDB wallet ACL verifiers. # @@ -12,6 +12,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 5; use Wallet::ACL::NetDB; @@ -35,7 +38,7 @@ SKIP: { $Wallet::Config::NETDB_REMCTL_HOST = $netdb; # Finally, we can test. - $verifier = eval { Wallet::ACL::NetDB->new }; + my $verifier = eval { Wallet::ACL::NetDB->new }; ok (defined $verifier, ' and now creation succeeds'); is ($@, q{}, ' with no errors'); ok ($verifier->isa ('Wallet::ACL::NetDB'), ' and returns the right class'); diff --git a/server/keytab-backend b/server/keytab-backend index cf283bb..bd5a3f9 100755 --- a/server/keytab-backend +++ b/server/keytab-backend @@ -21,6 +21,7 @@ ############################################################################## use strict; +use warnings; use Sys::Syslog qw(openlog syslog); diff --git a/server/wallet-backend b/server/wallet-backend index 0b6a3fa..a97c8ce 100755 --- a/server/wallet-backend +++ b/server/wallet-backend @@ -7,6 +7,7 @@ ############################################################################## use strict; +use warnings; use Getopt::Long qw(GetOptions); use Sys::Syslog qw(openlog syslog); diff --git a/tests/TESTS b/tests/TESTS index 807d944..d947e97 100644 --- a/tests/TESTS +++ b/tests/TESTS @@ -4,6 +4,8 @@ client/prompt client/rekey docs/pod docs/pod-spelling +perl/minimum-version +perl/strict portable/asprintf portable/mkstemp portable/setenv diff --git a/tests/client/full-t.in b/tests/client/full-t.in index 9822b37..4861723 100644 --- a/tests/client/full-t.in +++ b/tests/client/full-t.in @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # End-to-end tests for the wallet client. # @@ -8,12 +8,14 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + # Point to our server configuration. This must be done before Wallet::Config # is loaded, and it's pulled in as a prerequisite for Wallet::Admin. BEGIN { $ENV{WALLET_CONFIG} = "$ENV{SOURCE}/data/wallet.conf" } -BEGIN { our $total = 59 } -use Test::More tests => $total; +use Test::More tests => 59; use lib "$ENV{SOURCE}/../perl/lib"; use Wallet::Admin; @@ -56,10 +58,10 @@ sub wallet { chdir "$ENV{SOURCE}" or die "Cannot chdir to $ENV{SOURCE}: $!\n"; SKIP: { - skip 'no keytab configuration', $total + skip 'no keytab configuration', 59 unless -f "$ENV{BUILD}/config/keytab"; my $remctld = '@REMCTLD@'; - skip 'remctld not found', $total unless $remctld; + skip 'remctld not found', 59 unless $remctld; # Spawn remctld and get local tickets. Don't destroy the user's Kerberos # ticket cache. diff --git a/tests/client/prompt-t.in b/tests/client/prompt-t.in index 8467411..686cc88 100644 --- a/tests/client/prompt-t.in +++ b/tests/client/prompt-t.in @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Password prompting tests for the wallet client. # @@ -8,8 +8,10 @@ # # See LICENSE for licensing terms. -BEGIN { our $total = 5 } -use Test::More tests => $total; +use strict; +use warnings; + +use Test::More tests => 5; use lib "$ENV{SOURCE}/../perl/lib"; use Wallet::Admin; @@ -21,12 +23,12 @@ use Util; chdir "$ENV{SOURCE}" or die "Cannot chdir to $ENV{SOURCE}: $!\n"; SKIP: { - skip 'no password configuration', $total + skip 'no password configuration', 5 unless -f "$ENV{BUILD}/config/password"; my $remctld = '@REMCTLD@'; - skip 'remctld not found', $total unless $remctld; + skip 'remctld not found', 5 unless $remctld; eval { require Expect }; - skip 'Expect module not found', $total if $@; + skip 'Expect module not found', 5 if $@; # Disable sending of wallet's output to our standard output. Do this # twice to avoid Perl warnings. diff --git a/tests/data/fake-kadmin b/tests/data/fake-kadmin index 57f9c97..ff90f88 100755 --- a/tests/data/fake-kadmin +++ b/tests/data/fake-kadmin @@ -1,13 +1,16 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Fake kadmin.local used to test the keytab backend. # # Written by Russ Allbery -# Copyright 2007 +# Copyright 2007, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. +use strict; +use warnings; + unless ($ARGV[0] eq '-q' && @ARGV == 2) { die "invalid arguments\n"; } diff --git a/tests/perl/minimum-version-t b/tests/perl/minimum-version-t new file mode 100755 index 0000000..8c49327 --- /dev/null +++ b/tests/perl/minimum-version-t @@ -0,0 +1,69 @@ +#!/usr/bin/perl +# +# Check that too-new features of Perl are not being used. +# +# This version of the check script supports mapping various directories to +# different version numbers. This allows a newer version of Perl to be +# required for internal tools than for public code. +# +# The canonical version of this file is maintained in the rra-c-util package, +# which can be found at . +# +# Written by Russ Allbery +# Copyright 2012, 2013, 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# Permission is hereby granted, free of charge, to any person obtaining a +# copy of this software and associated documentation files (the "Software"), +# to deal in the Software without restriction, including without limitation +# the rights to use, copy, modify, merge, publish, distribute, sublicense, +# and/or sell copies of the Software, and to permit persons to whom the +# Software is furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +# DEALINGS IN THE SOFTWARE. + +use 5.006; +use strict; +use warnings; + +use lib "$ENV{SOURCE}/tap/perl"; + +use Test::More; +use Test::RRA qw(skip_unless_automated use_prereq); +use Test::RRA::Automake qw(automake_setup perl_dirs); +use Test::RRA::Config qw($MINIMUM_VERSION %MINIMUM_VERSION); + +# Skip for normal user installs since this doesn't affect functionality. +skip_unless_automated('Minimum version tests'); + +# Load prerequisite modules. +use_prereq('Test::MinimumVersion'); + +# Set up Automake testing. +automake_setup(); + +# For each exception case in %MINIMUM_VERSION, check the files that should +# have that minium version. Sort for reproducible test order. Also +# accumulate the list of directories we've already tested. +my @tested; +for my $version (sort keys %MINIMUM_VERSION) { + my $paths_ref = $MINIMUM_VERSION{$version}; + all_minimum_version_ok($version, { paths => $paths_ref, no_plan => 1 }); + push(@tested, @{$paths_ref}); +} + +# Now, check anything that's left against the default minimum version. +my @paths = perl_dirs({ skip => [@tested] }); +all_minimum_version_ok($MINIMUM_VERSION, { paths => \@paths, no_plan => 1 }); + +# Tell the TAP harness that we're done. +done_testing(); diff --git a/tests/perl/strict-t b/tests/perl/strict-t new file mode 100755 index 0000000..2df6d58 --- /dev/null +++ b/tests/perl/strict-t @@ -0,0 +1,66 @@ +#!/usr/bin/perl +# +# Check Perl scripts for strict, warnings, and syntax. +# +# Checks all Perl scripts in the tree for problems uncovered by Test::Strict. +# This includes using strict and warnings for every script and ensuring they +# all pass a syntax check. Currently, test suite coverage is not checked. +# +# The canonical version of this file is maintained in the rra-c-util package, +# which can be found at . +# +# Written by Russ Allbery +# Copyright 2012, 2013, 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# Permission is hereby granted, free of charge, to any person obtaining a +# copy of this software and associated documentation files (the "Software"), +# to deal in the Software without restriction, including without limitation +# the rights to use, copy, modify, merge, publish, distribute, sublicense, +# and/or sell copies of the Software, and to permit persons to whom the +# Software is furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +# DEALINGS IN THE SOFTWARE. + +use 5.006; +use strict; +use warnings; + +use lib "$ENV{SOURCE}/tap/perl"; + +use Test::More; +use Test::RRA qw(skip_unless_automated use_prereq); +use Test::RRA::Automake qw(automake_setup perl_dirs); +use Test::RRA::Config qw(@STRICT_IGNORE @STRICT_PREREQ); + +# Skip for normal user installs since this doesn't affect functionality. +skip_unless_automated('Strictness tests'); + +# Load prerequisite modules. +use_prereq('Test::Strict'); + +# Check whether all prerequisites are available, and skip the test if any of +# them are not. +for my $module (@STRICT_PREREQ) { + use_prereq($module); +} + +# Set up Automake testing. This must be done after loading Test::Strict, +# since it wants to use FindBin to locate this script. +automake_setup(); + +# Run the actual tests. We also want to check warnings. +$Test::Strict::TEST_WARNINGS = 1; +all_perl_files_ok(perl_dirs({ skip => [@STRICT_IGNORE] })); + +# Suppress "used only once" warnings. +END { $Test::Strict::TEST_WARNINGS = 0 } -- cgit v1.2.3 From 284b4a8201ef5cfcf44e9571ab155425b4e6a44f Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 15 Jul 2014 16:49:20 -0700 Subject: Drop use POSIX from several tests that don't use it Change-Id: I61379e8963569d26c9b9c31d1727f3cca4567f8e Reviewed-on: https://gerrit.stanford.edu/1550 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/t/object/wa-keyring.t | 1 - perl/t/util/kadmin.t | 1 - 2 files changed, 2 deletions(-) (limited to 'perl/t/object') diff --git a/perl/t/object/wa-keyring.t b/perl/t/object/wa-keyring.t index 8d8e1fe..4a3bd48 100755 --- a/perl/t/object/wa-keyring.t +++ b/perl/t/object/wa-keyring.t @@ -19,7 +19,6 @@ BEGIN { if $@; } -use POSIX qw(strftime); use WebAuth::Key 1.01 (); use WebAuth::Keyring 1.02 (); diff --git a/perl/t/util/kadmin.t b/perl/t/util/kadmin.t index 2a3d984..db94780 100755 --- a/perl/t/util/kadmin.t +++ b/perl/t/util/kadmin.t @@ -11,7 +11,6 @@ use strict; use warnings; -use POSIX qw(strftime); use Test::More tests => 34; BEGIN { $Wallet::Config::KEYTAB_TMP = '.' } -- cgit v1.2.3 From 5d0038202d82c71119fefa9c5bd0f816ae55991c Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 15 Jul 2014 22:57:31 -0700 Subject: Return the name of the ACL instead of the numeric ID The owner and getacl commands now return the current name of the ACL instead of its numeric ID, matching the documentation of owner. Change-Id: Ic47aad48bd1454ed4bffff7030b0492d74eee4fa Reviewed-on: https://gerrit.stanford.edu/1559 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- NEWS | 3 +++ perl/lib/Wallet/Object/Base.pm | 20 +++++++++++++++++--- perl/lib/Wallet/Server.pm | 8 ++++---- perl/t/object/base.t | 12 ++++++------ 4 files changed, 30 insertions(+), 13 deletions(-) (limited to 'perl/t/object') diff --git a/NEWS b/NEWS index 40efd3a..7108454 100644 --- a/NEWS +++ b/NEWS @@ -12,6 +12,9 @@ wallet 1.1 (unreleased) an existing wallet database, use wallet-admin to register the new object. + The owner and getacl commands now return the current name of the ACL + instead of its numeric ID, matching the documentation of owner. + The date passed to expires can now be any date format understood by Date::Parse, and Date::Parse (part of the TimeDate CPAN distribution) is now a required prerequisite for the wallet server. diff --git a/perl/lib/Wallet/Object/Base.pm b/perl/lib/Wallet/Object/Base.pm index 4939bf5..a6a78bf 100644 --- a/perl/lib/Wallet/Object/Base.pm +++ b/perl/lib/Wallet/Object/Base.pm @@ -26,7 +26,7 @@ use Wallet::ACL; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.07'; +$VERSION = '0.08'; ############################################################################## # Constructors @@ -302,7 +302,14 @@ sub acl { } elsif (defined $id) { return $self->_set_internal ($attr, undef, $user, $host, $time); } else { - return $self->_get_internal ($attr); + my $id = $self->_get_internal ($attr); + return unless defined $id; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; + if ($@) { + $self->error ($@); + return; + } + return $acl->name; } } @@ -380,7 +387,14 @@ sub owner { } elsif (defined $owner) { return $self->_set_internal ('owner', undef, $user, $host, $time); } else { - return $self->_get_internal ('owner'); + my $id = $self->_get_internal ('owner'); + return unless defined $id; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; + if ($@) { + $self->error ($@); + return; + } + return $acl->name; } } diff --git a/perl/lib/Wallet/Server.pm b/perl/lib/Wallet/Server.pm index e278489..95fd4e6 100644 --- a/perl/lib/Wallet/Server.pm +++ b/perl/lib/Wallet/Server.pm @@ -831,7 +831,7 @@ failure to get the error message. Gets or sets the ACL type ACL to ID for the object identified by TYPE and NAME. ACL should be one of C, C, C, C, or C. If ID is not given, returns the current setting of that ACL as -a numeric ACL ID or undef if that ACL isn't set or on failure. To +the name of the ACL or undef if that ACL isn't set or on failure. To distinguish between an ACL that isn't set and a failure to retrieve the ACL, the caller should call error() after an undef return. If error() also returns undef, that ACL wasn't set; otherwise, error() will return @@ -1041,9 +1041,9 @@ owner ACL will not be checked. =item owner(TYPE, NAME [, OWNER]) Gets or sets the owner for the object identified by TYPE and NAME. If -OWNER is not given, returns the current owner as a numeric ACL ID or undef -if no owner is set or on an error. To distinguish between an owner that -isn't set and a failure to retrieve the owner, the caller should call +OWNER is not given, returns the current owner as the name of the ACL or +undef if no owner is set or on an error. To distinguish between an owner +that isn't set and a failure to retrieve the owner, the caller should call error() after an undef return. If error() also returns undef, that ACL wasn't set; otherwise, error() will return the error message. diff --git a/perl/t/object/base.t b/perl/t/object/base.t index 11f18b7..ee9ff4b 100755 --- a/perl/t/object/base.t +++ b/perl/t/object/base.t @@ -70,7 +70,7 @@ if ($object->owner ('ADMIN', @trace)) { } else { is ($object->error, '', ' and setting it to ADMIN works'); } -is ($object->owner, $acl->id, ' at which point it is ADMIN'); +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'); @@ -128,7 +128,7 @@ for my $type (qw/get store show destroy flags/) { } else { is ($object->error, '', ' and setting it to ADMIN (numeric) works'); } - is ($object->acl ($type), $acl->id, ' at which point it is ADMIN'); + 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'); @@ -138,8 +138,8 @@ for my $type (qw/get store show destroy flags/) { is ($object->error, '', ' and clearing it works'); } is ($object->acl ($type), undef, ' at which point it is cleared'); - is ($object->acl ($type, $acl->id, @trace), 1, - ' and setting it again works'); + is ($object->acl ($type, $acl->name, @trace), 1, + ' and setting it again by name works'); } # Flags. @@ -189,7 +189,7 @@ is ($object->error, "cannot store keytab:${princ}: 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, 1, ' but retrieving the owner works'); +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'); @@ -198,7 +198,7 @@ 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), 1, " but retrieving $acl ACL works"); + is ($object->acl ($acl), 'ADMIN', " but retrieving $acl ACL works"); } is ($object->flag_check ('locked'), 1, ' and checking flags works'); @flags = $object->flag_list; -- cgit v1.2.3 From 85b27cf85f783fd54dec54efa36b66196f67c4ff Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 16 Jul 2014 11:56:25 -0700 Subject: Fix test skip numbering for keytab tests Change-Id: I5143d487d6b3623bc2be1724ed766b8709feb506 Reviewed-on: https://gerrit.stanford.edu/1565 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/t/object/keytab.t | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'perl/t/object') diff --git a/perl/t/object/keytab.t b/perl/t/object/keytab.t index 0f4a8b8..69db438 100755 --- a/perl/t/object/keytab.t +++ b/perl/t/object/keytab.t @@ -389,7 +389,7 @@ EOO # 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', 31 unless -f 't/data/test.keytab'; + skip 'no keytab configuration', 32 unless -f 't/data/test.keytab'; # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; @@ -589,7 +589,7 @@ EOO # Tests for enctype restriction. SKIP: { - skip 'no keytab configuration', 36 unless -f 't/data/test.keytab'; + skip 'no keytab configuration', 37 unless -f 't/data/test.keytab'; # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; -- cgit v1.2.3