diff options
Diffstat (limited to 'perl/t/keytab.t')
| -rwxr-xr-x | perl/t/keytab.t | 771 |
1 files changed, 0 insertions, 771 deletions
diff --git a/perl/t/keytab.t b/perl/t/keytab.t deleted file mode 100755 index 127762a..0000000 --- a/perl/t/keytab.t +++ /dev/null @@ -1,771 +0,0 @@ -#!/usr/bin/perl -w -# -# Tests for the keytab object implementation. -# -# Written by Russ Allbery <eagle@eyrie.org> -# Copyright 2007, 2008, 2009, 2010, 2013, 2014 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -use POSIX qw(strftime); -use Test::More tests => 141; - -BEGIN { $Wallet::Config::KEYTAB_TMP = '.' } - -use DBI; -use Wallet::Admin; -use Wallet::Config; -use Wallet::Kadmin; -use Wallet::Object::Keytab; - -use lib 't/lib'; -use Util; - -# Mapping of klist -ke encryption type names to the strings that Kerberos uses -# internally. It's very annoying to have to maintain this, and it probably -# breaks with Heimdal. -my %enctype = - ('triple des cbc mode with hmac/sha1' => 'des3-cbc-sha1', - 'des cbc mode with crc-32' => 'des-cbc-crc', - 'des cbc mode with rsa-md5' => 'des-cbc-md5', - 'aes-256 cts mode with 96-bit sha-1 hmac' => 'aes256-cts-hmac-sha1-96', - 'arcfour with hmac/md5' => 'rc4-hmac'); - -# Some global defaults to use. -my $user = 'admin@EXAMPLE.COM'; -my $host = 'localhost'; -my @trace = ($user, $host, time); - -# Flush all output immediately. -$| = 1; - -# Run a command and throw away the output, returning the exit status. -sub system_quiet { - my ($command, @args) = @_; - my $pid = fork; - if (not defined $pid) { - die "cannot fork: $!\n"; - } elsif ($pid == 0) { - open (STDIN, '<', '/dev/null') or die "cannot reopen stdin: $!\n"; - open (STDOUT, '>', '/dev/null') or die "cannot reopen stdout: $!\n"; - open (STDERR, '>', '/dev/null') or die "cannot reopen stderr: $!\n"; - exec ($command, @args) or die "cannot exec $command: $!\n"; - } else { - waitpid ($pid, 0); - return $?; - } -} - -# Create a principal out of Kerberos. Only usable once the configuration has -# been set up. -sub create { - my ($principal) = @_; - my $kadmin = Wallet::Kadmin->new; - return $kadmin->create ($principal); -} - -# Destroy a principal out of Kerberos. Only usable once the configuration has -# been set up. -sub destroy { - my ($principal) = @_; - my $kadmin = Wallet::Kadmin->new; - return $kadmin->destroy ($principal); -} - -# Check whether a principal exists. MIT uses kvno and Heimdal uses kgetcred. -# Note that the Kerberos type may be different than our local userspace, so -# don't use the Kerberos type to decide here. Instead, check for which -# program is available on the path. -sub created { - my ($principal) = @_; - $principal .= '@' . $Wallet::Config::KEYTAB_REALM; - local $ENV{KRB5CCNAME} = 'krb5cc_temp'; - getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL); - if (grep { -x "$_/kvno" } split (':', $ENV{PATH})) { - return (system_quiet ('kvno', $principal) == 0); - } elsif (grep { -x "$_/kgetcred" } split (':', $ENV{PATH})) { - return (system_quiet ('kgetcred', $principal) == 0); - } else { - warn "# No kvno or kgetcred found\n"; - return; - } -} - -# Given keytab data, write it to a file and try to determine the enctypes of -# the keys present in that file. Returns the enctypes as a list, with UNKNOWN -# for encryption types that weren't recognized. This is an ugly way of doing -# this for MIT. Heimdal is much more straightforward, but MIT ktutil doesn't -# have the needed abilities. -sub enctypes { - my ($keytab) = @_; - open (KEYTAB, '>', 'keytab') or die "cannot create keytab: $!\n"; - print KEYTAB $keytab; - close KEYTAB; - - my @enctypes; - my $pid = open (KLIST, '-|'); - if (not defined $pid) { - die "cannot fork: $!\n"; - } elsif ($pid == 0) { - open (STDERR, '>', '/dev/null') or die "cannot reopen stderr: $!\n"; - exec ('klist', '-ke', 'keytab') - or die "cannot run klist: $!\n"; - } - local $_; - while (<KLIST>) { - next unless /^ *\d+ /; - my ($string) = /\((.*)\)\s*$/; - next unless $string; - $enctype = $enctype{lc $string} || 'UNKNOWN'; - push (@enctypes, $enctype); - } - close KLIST; - - # If that failed, we may have a Heimdal user space instead, so try ktutil. - # If we try this directly, it will just hang with MIT ktutil. - if ($? != 0 || !@enctypes) { - @enctypes = (); - open (KTUTIL, '-|', 'ktutil', '-k', 'keytab', 'list') - or die "cannot run ktutil: $!\n"; - local $_; - while (<KTUTIL>) { - next unless /^ *\d+ /; - my ($string) = /^\s*\d+\s+(\S+)/; - next unless $string; - push (@enctypes, $string); - } - close KTUTIL; - } - unlink 'keytab'; - return sort @enctypes; -} - -# Use Wallet::Admin to set up the database. -unlink ('krb5cc_temp', 'krb5cc_test', 'test-acl', 'test-pid'); -db_setup; -my $admin = eval { Wallet::Admin->new }; -is ($@, '', 'Database connection succeeded'); -is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); -my $schema = $admin->schema; -my $dbh = $admin->dbh; - -# Use this to accumulate the history traces so that we can check history. -my $history = ''; -my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); - -# Basic keytab creation and manipulation tests. -SKIP: { - skip 'no keytab configuration', 52 unless -f 't/data/test.keytab'; - - # Set up our configuration. - $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; - $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal'); - $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); - $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); - my $realm = $Wallet::Config::KEYTAB_REALM; - - # Clean up the principals we're going to use. - destroy ('wallet/one'); - destroy ('wallet/two'); - - # Don't destroy the user's Kerberos ticket cache. - $ENV{KRB5CCNAME} = 'krb5cc_test'; - - # Test that object creation without KEYTAB_TMP fails. - undef $Wallet::Config::KEYTAB_TMP; - $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'); -} |