diff options
Diffstat (limited to 'perl/t')
| -rwxr-xr-x | perl/t/acl.t | 1 | ||||
| -rwxr-xr-x | perl/t/admin.t | 49 | ||||
| -rwxr-xr-x | perl/t/config.t | 7 | ||||
| -rw-r--r-- | perl/t/data/README | 1 | ||||
| -rwxr-xr-x | perl/t/data/keytab-fake | 1 | ||||
| -rw-r--r-- | perl/t/data/keytab.conf | 2 | ||||
| -rwxr-xr-x | perl/t/data/netdb-fake | 1 | ||||
| -rw-r--r-- | perl/t/data/netdb.conf | 2 | ||||
| -rwxr-xr-x | perl/t/file.t | 1 | ||||
| -rwxr-xr-x | perl/t/init.t | 1 | ||||
| -rwxr-xr-x | perl/t/kadmin.t | 109 | ||||
| -rwxr-xr-x | perl/t/keytab.t | 532 | ||||
| -rw-r--r-- | perl/t/lib/Util.pm | 22 | ||||
| -rwxr-xr-x | perl/t/object.t | 37 | ||||
| -rwxr-xr-x | perl/t/pod-spelling.t | 75 | ||||
| -rwxr-xr-x | perl/t/pod.t | 15 | ||||
| -rwxr-xr-x | perl/t/report.t | 171 | ||||
| -rwxr-xr-x | perl/t/schema.t | 3 | ||||
| -rwxr-xr-x | perl/t/server.t | 35 | ||||
| -rwxr-xr-x | perl/t/verifier-netdb.t | 1 | ||||
| -rwxr-xr-x | perl/t/verifier.t | 1 |
21 files changed, 648 insertions, 419 deletions
diff --git a/perl/t/acl.t b/perl/t/acl.t index e46b7f8..95aa763 100755 --- a/perl/t/acl.t +++ b/perl/t/acl.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/api.t -- Tests for the wallet ACL API. # diff --git a/perl/t/admin.t b/perl/t/admin.t index 4b8302d..e22088e 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -1,16 +1,16 @@ #!/usr/bin/perl -w -# $Id$ # # t/admin.t -- Tests for wallet administrative interface. # # Written by Russ Allbery <rra@stanford.edu> -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. -use Test::More tests => 29; +use Test::More tests => 16; use Wallet::Admin; +use Wallet::Report; use Wallet::Schema; use Wallet::Server; @@ -26,10 +26,11 @@ is ($admin->initialize ('admin@EXAMPLE.COM'), 1, ' and initialization succeeds'); # We have an empty database, so we should see no objects and one ACL. -my @objects = $admin->list_objects; +my $report = Wallet::Report->new; +my @objects = $report->objects; is (scalar (@objects), 0, 'No objects in the database'); -is ($admin->error, undef, ' and no error'); -my @acls = $admin->list_acls; +is ($report->error, undef, ' and no error'); +my @acls = $report->acls; is (scalar (@acls), 1, 'One ACL in the database'); is ($acls[0][0], 1, ' and that is ACL ID 1'); is ($acls[0][1], 'ADMIN', ' with the right name'); @@ -37,42 +38,20 @@ is ($acls[0][1], 'ADMIN', ' with the right name'); # Register a base object so that we can create a simple object. is ($admin->register_object ('base', 'Wallet::Object::Base'), 1, 'Registering Wallet::Object::Base works'); - -# Create an object. +is ($admin->register_object ('base', 'Wallet::Object::Base'), undef, + ' and cannot be registered twice'); $server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; is ($@, '', 'Creating a server instance did not die'); is ($server->create ('base', 'service/admin'), 1, ' and creating base:service/admin succeeds'); -# Now, we should see one object. -@objects = $admin->list_objects; -is (scalar (@objects), 1, ' and now there is one object'); -is ($objects[0][0], 'base', ' with the right type'); -is ($objects[0][1], 'service/admin', ' and the right name'); - -# Test registering a new ACL type. We don't have a good way of really using -# this right now. +# Test registering a new ACL type. is ($admin->register_verifier ('base', 'Wallet::ACL::Base'), 1, 'Registering Wallet::ACL::Base works'); - -# Create another ACL. -is ($server->acl_create ('first'), 1, 'ACL creation succeeds'); -@acls = $admin->list_acls; -is (scalar (@acls), 2, ' and now there are two ACLs'); -is ($acls[0][0], 1, ' and the first ID is correct'); -is ($acls[0][1], 'ADMIN', ' and the first name is correct'); -is ($acls[1][0], 2, ' and the second ID is correct'); -is ($acls[1][1], 'first', ' and the second name is correct'); - -# Delete that ACL and create another. -is ($server->acl_create ('second'), 1, 'Second ACL creation succeeds'); -is ($server->acl_destroy ('first'), 1, ' and deletion of the first succeeds'); -@acls = $admin->list_acls; -is (scalar (@acls), 2, ' and there are still two ACLs'); -is ($acls[0][0], 1, ' and the first ID is still the same'); -is ($acls[0][1], 'ADMIN', ' and the first name is still the same'); -is ($acls[1][0], 3, ' but the second ID has changed'); -is ($acls[1][1], 'second', ' and the second name is correct'); +is ($admin->register_verifier ('base', 'Wallet::ACL::Base'), undef, + ' and cannot be registered twice'); +is ($server->acl_add ('ADMIN', 'base', 'foo'), 1, + ' and adding a base ACL now works'); # Clean up. is ($admin->destroy, 1, 'Destruction succeeds'); diff --git a/perl/t/config.t b/perl/t/config.t index 0d159dc..1377cb8 100755 --- a/perl/t/config.t +++ b/perl/t/config.t @@ -1,14 +1,13 @@ #!/usr/bin/perl -w -# $Id$ # # t/config.t -- Tests for the wallet server configuration. # # Written by Russ Allbery <rra@stanford.edu> -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. -use Test::More tests => 7; +use Test::More tests => 6; # Silence warnings since we're not using use. package Wallet::Config; @@ -26,8 +25,6 @@ is ($Wallet::Config::KEYTAB_FLAGS, '-clearpolicy', ' and KEYTAB_FLAGS is correct'); is ($Wallet::Config::KEYTAB_KADMIN, 'kadmin', ' and KEYTAB_KADMIN is correct'); -is ($Wallet::Config::KEYTAB_AFS_KASETKEY, 'kasetkey', - ' and KEYTAB_AFS_KASETKEY is correct'); is ($Wallet::Config::DB_DRIVER, undef, ' and DB_DRIVER is unset'); # Create a configuration file with a single setting. diff --git a/perl/t/data/README b/perl/t/data/README index 4abbaeb..d250d33 100644 --- a/perl/t/data/README +++ b/perl/t/data/README @@ -21,6 +21,7 @@ following files: test.keytab Keytab for an authorized user test.principal Principal of the authorized user test.realm Kerberos realm in which to do testing + test.krbtype Type of Kerberos server (Heimdal or MIT) This realm will also need to be configured in your local krb5.conf, including the admin_server for the realm. diff --git a/perl/t/data/keytab-fake b/perl/t/data/keytab-fake index df21294..0ecf264 100755 --- a/perl/t/data/keytab-fake +++ b/perl/t/data/keytab-fake @@ -1,5 +1,4 @@ #!/bin/sh -# $Id$ # # keytab-fake -- Fake keytab-backend implementation. # diff --git a/perl/t/data/keytab.conf b/perl/t/data/keytab.conf index eb105e2..484443f 100644 --- a/perl/t/data/keytab.conf +++ b/perl/t/data/keytab.conf @@ -1,5 +1,3 @@ -# $Id$ -# # This is the remctl configuration used for testing the keytab backend's # ability to retrieve existing keytabs through remctl. Currently the only # supported and used command is keytab retrieve. The ACL is written on diff --git a/perl/t/data/netdb-fake b/perl/t/data/netdb-fake index 56744a7..ae5be18 100755 --- a/perl/t/data/netdb-fake +++ b/perl/t/data/netdb-fake @@ -1,5 +1,4 @@ #!/bin/sh -# $Id$ # # netdb-fake -- Fake NetDB remctl interface. # diff --git a/perl/t/data/netdb.conf b/perl/t/data/netdb.conf index e7908ed..f08bfaa 100644 --- a/perl/t/data/netdb.conf +++ b/perl/t/data/netdb.conf @@ -1,5 +1,3 @@ -# $Id$ -# # This is the remctl configuration used for testing the NetDB ACL verifier. # The ACL is written on the fly by the test program. diff --git a/perl/t/file.t b/perl/t/file.t index 8eaa0f1..7ab5d75 100755 --- a/perl/t/file.t +++ b/perl/t/file.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/file.t -- Tests for the file object implementation. # diff --git a/perl/t/init.t b/perl/t/init.t index 70085c9..d0fae9f 100755 --- a/perl/t/init.t +++ b/perl/t/init.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/init.t -- Tests for database initialization. # diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t new file mode 100755 index 0000000..bbcb15a --- /dev/null +++ b/perl/t/kadmin.t @@ -0,0 +1,109 @@ +#!/usr/bin/perl -w +# +# t/kadmin.t -- Tests for the kadmin object implementation. +# +# Written by Jon Robertson <jonrober@stanford.edu> +# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use POSIX qw(strftime); +use Test::More tests => 32; + +BEGIN { $Wallet::Config::KEYTAB_TMP = '.' } + +use Wallet::Admin; +use Wallet::Config; +use Wallet::Kadmin; +use Wallet::Kadmin::MIT; + +# Only load Wallet::Kadmin::Heimdal if a required module is found. +my $heimdal_kadm5 = 0; +eval 'use Heimdal::Kadm5'; +if (!$@) { + $heimdal_kadm5 = 1; + require Wallet::Kadmin::Heimdal; +} + +use lib 't/lib'; +use Util; + +# Test creating an MIT object and seeing if the callback works. +$Wallet::Config::KEYTAB_KRBTYPE = 'MIT'; +my $kadmin = Wallet::Kadmin->new; +ok (defined ($kadmin), 'MIT kadmin object created'); +my $callback = sub { return 1 }; +$kadmin->fork_callback ($callback); +is ($kadmin->{fork_callback} (), 1, ' and callback works'); +$callback = sub { return 2 }; +$kadmin->fork_callback ($callback); +is ($kadmin->{fork_callback} (), 2, ' and changing it works'); + +# Check principal validation in the Wallet::Kadmin::MIT module. This is +# specific to that module, since Heimdal doesn't require passing the principal +# through the kadmin client. +for my $bad (qw{service\* = host/foo+bar host/foo/bar /bar bar/ rcmd.foo}) { + ok (! Wallet::Kadmin::MIT->valid_principal ($bad), + "Invalid principal name $bad"); +} +for my $good (qw{service service/foo bar foo/bar host/example.org + aservice/foo}) { + ok (Wallet::Kadmin::MIT->valid_principal ($good), + "Valid principal name $good"); +} + +# Test creating a Heimdal object. We deliberately connect without +# configuration to get the error. That tests that we can find the Heimdal +# module and it dies how it should. +SKIP: { + skip 'Heimdal::Kadm5 not installed', 3 unless $heimdal_kadm5; + undef $Wallet::Config::KEYTAB_PRINCIPAL; + undef $Wallet::Config::KEYTAB_FILE; + undef $Wallet::Config::KEYTAB_REALM; + undef $kadmin; + $Wallet::Config::KEYTAB_KRBTYPE = 'Heimdal'; + $kadmin = eval { Wallet::Kadmin->new }; + is ($kadmin, undef, 'Heimdal fails properly'); + is ($@, "keytab object implementation not configured\n", + ' with the right error'); +} + +# Now, check the generic API. We can run this test no matter which +# implementation is configured. This retests some things that are also tested +# by the keytab test, but specifically through the Wallet::Kadmin API. +SKIP: { + skip 'no keytab configuration', 14 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 = '.'; + + # Create the object and clean up the principal we're going to use. + $kadmin = eval { Wallet::Kadmin->new }; + ok (defined $kadmin, 'Creating Wallet::Kadmin object succeeds'); + is ($@, '', ' and there is no error'); + is ($kadmin->destroy ('wallet/one'), 1, 'Deleting wallet/one works'); + is ($kadmin->exists ('wallet/one'), 0, ' and it does not exist'); + + # Create the principal and check that keytab returns something. We'll + # check the details of the return in the keytab check. + is ($kadmin->create ('wallet/one'), 1, 'Creating wallet/one works'); + is ($kadmin->exists ('wallet/one'), 1, ' and it now exists'); + my $data = $kadmin->keytab_rekey ('wallet/one'); + ok (defined ($data), ' and retrieving a keytab works'); + is (keytab_valid ($data, 'wallet/one'), 1, + ' and works for authentication'); + + # Delete the principal and confirm behavior. + is ($kadmin->destroy ('wallet/one'), 1, 'Deleting principal works'); + is ($kadmin->exists ('wallet/one'), 0, ' and now it does not exist'); + is ($kadmin->keytab_rekey ('wallet/one', './tmp.keytab'), undef, + ' and retrieving the keytab does not work'); + ok (! -f './tmp.keytab', ' and no file was created'); + like ($kadmin->error, qr%^error creating keytab for wallet/one%, + ' and the right error message is set'); + is ($kadmin->destroy ('wallet/one'), 1, ' and deleting it again works'); +} diff --git a/perl/t/keytab.t b/perl/t/keytab.t index c1348d4..046da9c 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -1,18 +1,21 @@ #!/usr/bin/perl -w -# $Id$ # # t/keytab.t -- Tests for the keytab object implementation. # # Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2009, 2010 +# Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 223; +use Test::More tests => 135; + +BEGIN { $Wallet::Config::KEYTAB_TMP = '.' } use Wallet::Admin; use Wallet::Config; +use Wallet::Kadmin; use Wallet::Object::Keytab; use lib 't/lib'; @@ -25,7 +28,7 @@ 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', + '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. @@ -57,60 +60,51 @@ sub system_quiet { # been set up. sub create { my ($principal) = @_; - my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', - '-t', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - '-q', "addprinc -clearpolicy -randkey $principal"); - system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args); + 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 @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', - '-t', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - '-q', "delprinc -force $principal"); - system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args); + my $kadmin = Wallet::Kadmin->new; + return $kadmin->destroy ($principal); } -# Check whether a principal exists. +# 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); - return (system_quiet ('kvno', $principal) == 0); -} - -# Given keytab data and the principal, write it to a file and try -# authenticating using kinit. -sub valid { - my ($keytab, $principal) = @_; - open (KEYTAB, '>', 'keytab') or die "cannot create keytab: $!\n"; - print KEYTAB $keytab; - close KEYTAB; - $principal .= '@' . $Wallet::Config::KEYTAB_REALM; - my $result = getcreds ('keytab', $principal); - if ($result) { - unlink 'keytab'; + 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; } - return $result; } # 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. +# 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; open (KLIST, '-|', 'klist', '-ke', 'keytab') or die "cannot run klist: $!\n"; - my @enctypes; local $_; while (<KLIST>) { next unless /^ *\d+ /; @@ -120,26 +114,24 @@ sub enctypes { push (@enctypes, $enctype); } close KLIST; - unlink 'keytab'; - return sort @enctypes; -} -# Given a Wallet::Object::Keytab object, the keytab data, the Kerberos v5 -# principal, and the Kerberos v4 principal, write the keytab to a file, -# generate a srvtab, and try authenticating using k4start. -sub valid_srvtab { - my ($object, $keytab, $k5, $k4) = @_; - open (KEYTAB, '>', 'keytab') or die "cannot create keytab: $!\n"; - print KEYTAB $keytab; - close KEYTAB; - unless ($object->kaserver_srvtab ('keytab', $k5, 'srvtab', $k4)) { - warn "cannot write srvtab: ", $object->error, "\n"; - return 0; + # 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 = (); + 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; } - $ENV{KRBTKFILE} = 'krb4cc_temp'; - system ("k4start -f srvtab $k4 2>&1 >/dev/null </dev/null"); - unlink 'keytab', 'srvtab', 'krb4cc_temp'; - return ($? == 0) ? 1 : 0; + unlink 'keytab'; + return sort @enctypes; } # Use Wallet::Admin to set up the database. @@ -154,27 +146,15 @@ my $dbh = $admin->dbh; my $history = ''; my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); -# Do some white-box testing of the principal validation regex. -for my $bad (qw{service\* = host/foo+bar host/foo/bar /bar bar/ - rcmd.foo}) { - ok (! Wallet::Object::Keytab->valid_principal ($bad), - "Invalid principal name $bad"); -} -for my $good (qw{service service/foo bar foo/bar host/example.org - aservice/foo}) { - ok (Wallet::Object::Keytab->valid_principal ($good), - "Valid principal name $good"); -} - # Basic keytab creation and manipulation tests. SKIP: { - skip 'no keytab configuration', 49 unless -f 't/data/test.keytab'; + 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_TMP = '.'; + $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); my $realm = $Wallet::Config::KEYTAB_REALM; # Clean up the principals we're going to use. @@ -184,17 +164,36 @@ SKIP: { # 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', $dbh, @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", $dbh, @trace) }; is ($object, undef, 'Creating malformed principal fails'); - is ($@, "invalid principal name wallet\nf\n", ' with the right error'); + 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', '', $dbh, @trace) }; is ($object, undef, 'Creating empty principal fails'); - is ($@, "invalid principal name \n", ' with the right error'); + 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', $dbh, @trace) }; @@ -209,9 +208,14 @@ SKIP: { $object = eval { Wallet::Object::Keytab->create ('keytab', 'wallet/two', $dbh, @trace) }; - ok (defined ($object), 'Creating an existing principal succeeds'); + 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, $dbh, @trace) }; @@ -236,7 +240,7 @@ SKIP: { is ($object->error, '', ' and getting the keytab works'); } ok (! -f "./keytab.$$", ' and the temporary file was cleaned up'); - ok (valid ($data, 'wallet/one'), ' and the keytab is valid'); + 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. @@ -253,18 +257,16 @@ EOO is ($object->show, $expected, 'Show output is correct'); # Test error handling on keytab retrieval. - undef $Wallet::Config::KEYTAB_TMP; - $data = $object->get (@trace); - is ($data, undef, 'Getting a keytab without a tmp directory fails'); - is ($object->error, 'KEYTAB_TMP configuration variable not set', - ' with the right error'); - $Wallet::Config::KEYTAB_TMP = '.'; - $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'; + 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'); @@ -279,12 +281,16 @@ EOO }; ok (defined ($object), 'Creating good principal succeeds'); ok (created ('wallet/one'), ' and the principal was created'); - $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'; + 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", @@ -342,30 +348,33 @@ EOO is ($@, "keytab object implementation not configured\n", ' with the right error'); $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); - $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; + undef $Wallet::Config::KEYTAB_KRBTYPE; $object = eval { Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) }; - is ($object, undef, 'Cope with a failure to run kadmin'); - like ($@, qr{^cannot run /some/nonexistent/file: }, - ' with the right error'); - $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; + 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', $dbh, @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', 17 unless -f 't/data/test.keytab'; - my @path = (split (':', $ENV{PATH}), '/usr/local/sbin', '/usr/sbin'); - my ($remctld) = grep { -x $_ } map { "$_/remctld" } @path; - skip 'remctld not found', 17 unless $remctld; - eval { require Net::Remctl }; - skip 'Net::Remctl not available', 17 if $@; + skip 'no keytab configuration', 27 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; @@ -382,41 +391,85 @@ SKIP: { ok (defined ($two), 'Creating wallet/two succeeds'); is ($two->flag_set ('unchanging', @trace), 1, ' and setting unchanging'); - # 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'; + # Finally we can test. First the MIT Kerberos tests. + SKIP: { + skip 'skipping MIT unchanging tests for Heimdal', 12 + 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', 12 unless $remctld; + eval { require Net::Remctl }; + skip 'Net::Remctl not available', 12 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 = $object->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; + } - # Finally we can test. - 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 ($two->get (@trace), undef, ' but get for wallet/two does not'); - 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; + # 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', 10 + 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; + is ($data, $second, ' and the keytab matches'); + 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"; @@ -426,61 +479,30 @@ $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 kaserver synchronization support. +# 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', 106 unless -f 't/data/test.keytab'; + skip 'no keytab configuration', 18 unless -f 't/data/test.keytab'; - # Test the principal mapping. We can do this without having a kaserver - # configuration. We only need a basic keytab object configuration. Do - # this as white-box testing since we don't want to fill the test realm - # with a bunch of random principals. + # Test setting synchronization attributes, which can also be done without + # configuration. my $one = eval { Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) }; ok (defined ($one), 'Creating wallet/one succeeds'); - my %princs = - (foo => 'foo', - host => 'host', - rcmd => 'rcmd', - 'rcmd.foo' => 'rcmd.foo', - 'host/foo.example.org' => 'rcmd.foo', - 'ident/foo.example.org' => 'ident.foo', - 'imap/foo.example.org' => 'imap.foo', - 'pop/foo.example.org' => 'pop.foo', - 'smtp/foo.example.org' => 'smtp.foo', - 'service/foo' => 'service.foo', - 'foo/bar' => 'foo.bar'); - for my $princ (sort keys %princs) { - my $result = $princs{$princ}; - is ($one->kaserver_name ($princ), $result, "Name mapping: $princ"); - is ($one->kaserver_name ("$princ\@EXAMPLE.ORG"), $result, - ' with K5 realm'); - $Wallet::Config::KEYTAB_AFS_REALM = 'AFS.EXAMPLE.ORG'; - is ($one->kaserver_name ($princ), "$result\@AFS.EXAMPLE.ORG", - ' with K4 realm'); - is ($one->kaserver_name ("$princ\@EXAMPLE.ORG"), - "$result\@AFS.EXAMPLE.ORG", ' with K5 and K4 realm'); - undef $Wallet::Config::KEYTAB_AFS_REALM; - } - for my $princ (qw{service/foo/bar foo/bar/baz}) { - is ($one->kaserver_name ($princ), undef, "Name mapping: $princ"); - is ($one->kaserver_name ("$princ\@EXAMPLE.ORG"), undef, - ' with K5 realm'); - $Wallet::Config::KEYTAB_AFS_REALM = 'AFS.EXAMPLE.ORG'; - is ($one->kaserver_name ($princ), undef, ' with K4 realm'); - is ($one->kaserver_name ("$princ\@EXAMPLE.ORG"), undef, - ' with K5 and K4 realm'); - undef $Wallet::Config::KEYTAB_AFS_REALM; - } - - # Test setting synchronization attributes, which can also be done without - # configuration. my $expected = <<"EOO"; Type: keytab Name: wallet/one @@ -495,16 +517,20 @@ EOO 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', [ 'foo' ], @trace), undef, + is ($one->attr ('sync', [ 'kaserver' ], @trace), undef, ' and setting an unknown sync target fails'); - is ($one->error, 'unsupported synchronization target foo', + 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'); - is ($one->attr ('sync', [ 'kaserver' ], @trace), 1, - ' but setting only kaserver works'); + + # 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'); @@ -521,15 +547,10 @@ EOO $history .= <<"EOO"; $date create by $user from $host -$date add kaserver to attribute sync - by $user from $host EOO is ($one->history, $history, ' and history is correct for attributes'); - is ($one->destroy (@trace), undef, 'Destroying wallet/one fails'); - is ($one->error, 'kaserver synchronization not configured', - ' because kaserver support is not configured'); is ($one->attr ('sync', [], @trace), 1, - ' but removing the kaserver sync attribute works'); + '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 @@ -537,135 +558,7 @@ $date remove kaserver from attribute sync $date destroy by $user from $host EOO - - # Set up our configuration. - skip 'no AFS kaserver configuration', 34 unless -f 't/data/test.srvtab'; - skip 'no kaserver support', 34 unless -x '../kasetkey/kasetkey'; - $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_TMP = '.'; - $Wallet::Config::KEYTAB_AFS_KASETKEY = '../kasetkey/kasetkey'; - my $realm = $Wallet::Config::KEYTAB_REALM; - my $k5 = "wallet/one\@$realm"; - - # Recreate and reconfigure the object. - $one = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) - }; - ok (defined ($one), 'Creating wallet/one succeeds'); - is ($one->attr ('sync', [ 'kaserver' ], @trace), 1, - ' and setting the kaserver sync attribute works'); - - # Finally, we can test. - is ($one->get (@trace), undef, 'Get without configuration fails'); - is ($one->error, 'kaserver synchronization not configured', - ' with the right error'); - $Wallet::Config::KEYTAB_AFS_ADMIN = contents ('t/data/test.admin'); - my $k4_realm = $Wallet::Config::KEYTAB_AFS_ADMIN; - $k4_realm =~ s/^[^\@]+\@//; - $Wallet::Config::KEYTAB_AFS_REALM = $k4_realm; - my $k4 = "wallet.one\@$k4_realm"; - is ($one->get (@trace), undef, ' and still fails with just admin'); - is ($one->error, 'kaserver synchronization not configured', - ' with the right error'); - $Wallet::Config::KEYTAB_AFS_SRVTAB = 't/data/test.srvtab'; - my $keytab = $one->get (@trace); - if (defined ($keytab)) { - ok (1, ' and now get works'); - } else { - is ($one->error, '', ' and now get works'); - } - ok (valid_srvtab ($one, $keytab, $k5, $k4), ' and the srvtab is valid'); - ok (! -f "./srvtab.$$", ' and the temporary file was cleaned up'); - - # Now remove the sync attribute and make sure things aren't synced. - is ($one->attr ('sync', [], @trace), 1, 'Clearing sync works'); - @targets = $one->attr ('sync'); - is (scalar (@targets), 0, ' and now there is no attribute'); - is ($one->error, undef, ' and no error'); - my $new_keytab = $one->get (@trace); - ok (defined ($new_keytab), ' and get still works'); - ok (! valid_srvtab ($one, $new_keytab, $k5, $k4), - ' but the srvtab does not'); - ok (valid_srvtab ($one, $keytab, $k5, $k4), ' and the old one does'); - is ($one->destroy (@trace), 1, ' and destroying wallet/one works'); - ok (valid_srvtab ($one, $keytab, $k5, $k4), - ' and the principal is still there'); - - # Test KEYTAB_AFS_DESTROY. - $one = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) - }; - ok (defined ($one), 'Creating wallet/one succeeds'); - $Wallet::Config::KEYTAB_AFS_DESTROY = 1; - $new_keytab = $one->get (@trace); - ok (defined ($new_keytab), ' and get works'); - ok (! valid_srvtab ($one, $new_keytab, $k5, $k4), - ' but the srvtab does not'); - ok (! valid_srvtab ($one, $keytab, $k5, $k4), - ' and now neither does the old one'); - $Wallet::Config::KEYTAB_AFS_DESTROY = 0; - - # Put it back and make sure it works again. - is ($one->attr ('sync', [ 'kaserver' ], @trace), 1, 'Setting sync works'); - $keytab = $one->get (@trace); - ok (defined ($keytab), ' and get works'); - ok (valid_srvtab ($one, $keytab, $k5, $k4), ' and the srvtab is valid'); - $Wallet::Config::KEYTAB_AFS_KASETKEY = '/path/to/nonexistent/file'; - $new_keytab = $one->get (@trace); - ok (! defined ($new_keytab), - ' but it fails if we mess up the kasetkey path'); - like ($one->error, qr{^cannot synchronize key with kaserver: }, - ' with the right error message'); - ok (! -f "keytab.$$", ' and the temporary file was cleaned up'); - $Wallet::Config::KEYTAB_AFS_KASETKEY = '../kasetkey/kasetkey'; - - # Destroy the principal and recreate it and make sure we cleaned up. - is ($one->destroy (@trace), 1, 'Destroying wallet/one works'); - ok (! valid_srvtab ($one, $keytab, $k5, $k4), - ' and the principal is gone'); - $one = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) - }; - ok (defined ($one), ' and recreating it succeeds'); - @targets = $one->attr ('sync'); - is (scalar (@targets), 0, ' and now there is no attribute'); - is ($one->error, undef, ' and no error'); - - # Now destroy it for good. - is ($one->destroy (@trace), 1, 'Destroying wallet/one works'); - - # Check that history is still correct. - $history .= <<"EOO"; -$date create - by $user from $host -$date add kaserver to attribute sync - by $user from $host -$date get - by $user from $host -$date remove kaserver from attribute sync - by $user from $host -$date get - by $user from $host -$date destroy - by $user from $host -$date create - by $user from $host -$date get - by $user from $host -$date add kaserver to attribute sync - by $user from $host -$date get - 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'); + is ($one->history, $history, ' and history is correct for removal'); } # Tests for enctype restriction. @@ -676,6 +569,7 @@ SKIP: { $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; @@ -742,8 +636,7 @@ EOO 'Setting an unrecognized enctype fails'); is ($one->error, 'unknown encryption type foo-bar', ' with the right error message'); - @values = enctypes ($keytab); - is ("@values", "@enctypes", ' and we did rollback properly'); + is ($one->show, $expected, ' and we did rollback properly'); $history .= <<"EOO"; $date get by $user from $host @@ -753,6 +646,7 @@ EOO # 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) { @@ -764,8 +658,12 @@ EOO is ("@values", $enctypes[0], ' 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[0], ' and it has the right enctype'); + 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'); diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm index a1bacbd..ab88b39 100644 --- a/perl/t/lib/Util.pm +++ b/perl/t/lib/Util.pm @@ -1,5 +1,4 @@ # Util -- Utility class for wallet tests. -# $Id$ # # Written by Russ Allbery <rra@stanford.edu> # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University @@ -21,7 +20,8 @@ $VERSION = '0.02'; use Exporter (); @ISA = qw(Exporter); -@EXPORT = qw(contents db_setup getcreds remctld_spawn remctld_stop); +@EXPORT = qw(contents db_setup getcreds keytab_valid remctld_spawn + remctld_stop); ############################################################################## # General utility functions @@ -67,7 +67,7 @@ sub db_setup { } ############################################################################## -# Local ticket cache +# Kerberos utility functions ############################################################################## # Given a keytab file and a principal, try authenticating with kinit. @@ -86,6 +86,22 @@ sub getcreds { return 0; } +# Given keytab data and the principal, write it to a file and try +# authenticating using kinit. +sub keytab_valid { + my ($keytab, $principal) = @_; + open (KEYTAB, '>', 'keytab') or die "cannot create keytab: $!\n"; + print KEYTAB $keytab; + close KEYTAB; + $principal .= '@' . $Wallet::Config::KEYTAB_REALM + unless $principal =~ /\@/; + my $result = getcreds ('keytab', $principal); + if ($result) { + unlink 'keytab'; + } + return $result; +} + ############################################################################## # remctld handling ############################################################################## diff --git a/perl/t/object.t b/perl/t/object.t index 94fe22b..46e67e5 100755 --- a/perl/t/object.t +++ b/perl/t/object.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/object.t -- Tests for the basic object implementation. # @@ -256,11 +255,11 @@ ok (defined ($object), 'Recreating the object succeeds'); $output = <<"EOO"; $date create by $user from $host -$date set owner to 1 +$date set owner to ADMIN (1) by $user from $host -$date unset owner (was 1) +$date unset owner (was ADMIN (1)) by $user from $host -$date set owner to 1 +$date set owner to ADMIN (1) by $user from $host $date set expires to $now by $user from $host @@ -268,35 +267,35 @@ $date unset expires (was $now) by $user from $host $date set expires to $now by $user from $host -$date set acl_get to 1 +$date set acl_get to ADMIN (1) by $user from $host -$date unset acl_get (was 1) +$date unset acl_get (was ADMIN (1)) by $user from $host -$date set acl_get to 1 +$date set acl_get to ADMIN (1) by $user from $host -$date set acl_store to 1 +$date set acl_store to ADMIN (1) by $user from $host -$date unset acl_store (was 1) +$date unset acl_store (was ADMIN (1)) by $user from $host -$date set acl_store to 1 +$date set acl_store to ADMIN (1) by $user from $host -$date set acl_show to 1 +$date set acl_show to ADMIN (1) by $user from $host -$date unset acl_show (was 1) +$date unset acl_show (was ADMIN (1)) by $user from $host -$date set acl_show to 1 +$date set acl_show to ADMIN (1) by $user from $host -$date set acl_destroy to 1 +$date set acl_destroy to ADMIN (1) by $user from $host -$date unset acl_destroy (was 1) +$date unset acl_destroy (was ADMIN (1)) by $user from $host -$date set acl_destroy to 1 +$date set acl_destroy to ADMIN (1) by $user from $host -$date set acl_flags to 1 +$date set acl_flags to ADMIN (1) by $user from $host -$date unset acl_flags (was 1) +$date unset acl_flags (was ADMIN (1)) by $user from $host -$date set acl_flags to 1 +$date set acl_flags to ADMIN (1) by $user from $host $date set flag locked by $user from $host diff --git a/perl/t/pod-spelling.t b/perl/t/pod-spelling.t new file mode 100755 index 0000000..d3ab858 --- /dev/null +++ b/perl/t/pod-spelling.t @@ -0,0 +1,75 @@ +#!/usr/bin/perl -w +# +# Check for spelling errors in POD documentation +# +# Checks all POD files in the tree for spelling problems using Pod::Spell and +# either aspell or ispell. aspell is preferred. This test is disabled unless +# RRA_MAINTAINER_TESTS is set, since spelling dictionaries vary too much +# between environments. +# +# Copyright 2008, 2009 Russ Allbery <rra@stanford.edu> +# +# This program is free software; you may redistribute it and/or modify it +# under the same terms as Perl itself. + +use strict; +use Test::More; + +# Skip all spelling tests unless the maintainer environment variable is set. +plan skip_all => 'Spelling tests only run for maintainer' + unless $ENV{RRA_MAINTAINER_TESTS}; + +# Load required Perl modules. +eval 'use Test::Pod 1.00'; +plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@; +eval 'use Pod::Spell'; +plan skip_all => 'Pod::Spell required to test POD spelling' if $@; + +# Locate a spell-checker. hunspell is not currently supported due to its lack +# of support for contractions (at least in the version in Debian). +my @spell; +my %options = (aspell => [ qw(-d en_US --home-dir=./ list) ], + ispell => [ qw(-d american -l -p /dev/null) ]); +SEARCH: for my $program (qw/aspell ispell/) { + for my $dir (split ':', $ENV{PATH}) { + if (-x "$dir/$program") { + @spell = ("$dir/$program", @{ $options{$program} }); + } + last SEARCH if @spell; + } +} +plan skip_all => 'aspell or ispell required to test POD spelling' + unless @spell; + +# Prerequisites are satisfied, so we're going to do some testing. Figure out +# what POD files we have and from that develop our plan. +$| = 1; +my @pod = all_pod_files (); +plan tests => scalar @pod; + +# Finally, do the checks. +for my $pod (@pod) { + my $child = open (CHILD, '-|'); + if (not defined $child) { + die "Cannot fork: $!\n"; + } elsif ($child == 0) { + my $pid = open (SPELL, '|-', @spell) or die "Cannot run @spell: $!\n"; + open (POD, '<', $pod) or die "Cannot open $pod: $!\n"; + my $parser = Pod::Spell->new; + $parser->parse_from_filehandle (\*POD, \*SPELL); + close POD; + close SPELL; + exit ($? >> 8); + } else { + my @words = <CHILD>; + close CHILD; + SKIP: { + skip "@spell failed for $pod", 1 unless $? == 0; + for (@words) { + s/^\s+//; + s/\s+$//; + } + is ("@words", '', $pod); + } + } +} diff --git a/perl/t/pod.t b/perl/t/pod.t index da4d0d3..c467b82 100755 --- a/perl/t/pod.t +++ b/perl/t/pod.t @@ -1,17 +1,14 @@ -#!/usr/bin/perl -# $Id$ +#!/usr/bin/perl -w # -# t/pod.t -- Test POD formatting for the wallet Perl modules. +# Test POD formatting for the wallet Perl modules. # # Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. +use strict; +use Test::More; eval 'use Test::Pod 1.00'; -if ($@) { - print "1..1\n"; - print "ok 1 # skip - Test::Pod 1.00 required for testing POD\n"; - exit; -} +plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@; all_pod_files_ok (); diff --git a/perl/t/report.t b/perl/t/report.t new file mode 100755 index 0000000..a18b995 --- /dev/null +++ b/perl/t/report.t @@ -0,0 +1,171 @@ +#!/usr/bin/perl -w +# +# t/report.t -- Tests for the wallet reporting interface. +# +# Written by Russ Allbery <rra@stanford.edu> +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use Test::More tests => 83; + +use Wallet::Admin; +use Wallet::Report; +use Wallet::Server; + +use lib 't/lib'; +use Util; + +# Use Wallet::Admin to set up the database. +db_setup; +my $admin = eval { Wallet::Admin->new }; +is ($@, '', 'Wallet::Admin creation did not die'); +is ($admin->reinitialize ('admin@EXAMPLE.COM'), 1, + 'Database initialization succeeded'); +$admin->register_object ('base', 'Wallet::Object::Base'); +$admin->register_verifier ('base', 'Wallet::ACL::Base'); + +# We have an empty database, so we should see no objects and one ACL. +my $report = eval { Wallet::Report->new }; +is ($@, '', 'Wallet::Report creation did not die'); +ok ($report->isa ('Wallet::Report'), ' and returned the right class'); +my @objects = $report->objects; +is (scalar (@objects), 0, 'No objects in the database'); +is ($report->error, undef, ' and no error'); +my @acls = $report->acls; +is (scalar (@acls), 1, 'One ACL in the database'); +is ($acls[0][0], 1, ' and that is ACL ID 1'); +is ($acls[0][1], 'ADMIN', ' with the right name'); + +# Create an object. +$server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; +is ($@, '', 'Creating a server instance did not die'); +is ($server->create ('base', 'service/admin'), 1, + ' and creating base:service/admin succeeds'); + +# Now, we should see one object. +@objects = $report->objects; +is (scalar (@objects), 1, ' and now there is one object'); +is ($objects[0][0], 'base', ' with the right type'); +is ($objects[0][1], 'service/admin', ' and the right name'); + +# Create another ACL. +is ($server->acl_create ('first'), 1, 'ACL creation succeeds'); +@acls = $report->acls; +is (scalar (@acls), 2, ' and now there are two ACLs'); +is ($acls[0][0], 1, ' and the first ID is correct'); +is ($acls[0][1], 'ADMIN', ' and the first name is correct'); +is ($acls[1][0], 2, ' and the second ID is correct'); +is ($acls[1][1], 'first', ' and the second name is correct'); + +# Delete that ACL and create another. +is ($server->acl_create ('second'), 1, 'Second ACL creation succeeds'); +is ($server->acl_destroy ('first'), 1, ' and deletion of the first succeeds'); +@acls = $report->acls; +is (scalar (@acls), 2, ' and there are still two ACLs'); +is ($acls[0][0], 1, ' and the first ID is still the same'); +is ($acls[0][1], 'ADMIN', ' and the first name is still the same'); +is ($acls[1][0], 3, ' but the second ID has changed'); +is ($acls[1][1], 'second', ' and the second name is correct'); + +# Currently, we have no owners, so we should get an empty owner report. +my @lines = $report->owners ('%', '%'); +is (scalar (@lines), 0, 'Owner report is currently empty'); +is ($report->error, undef, ' and there is no error'); + +# Set an owner and make sure we now see something in the report. +is ($server->owner ('base', 'service/admin', 'ADMIN'), 1, + 'Setting an owner works'); +@lines = $report->owners ('%', '%'); +is (scalar (@lines), 1, ' and now there is one owner in the report'); +is ($lines[0][0], 'krb5', ' with the right scheme'); +is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); +@lines = $report->owners ('keytab', '%'); +is (scalar (@lines), 0, 'Owners of keytabs is empty'); +is ($report->error, undef, ' with no error'); +@lines = $report->owners ('base', 'foo/%'); +is (scalar (@lines), 0, 'Owners of base foo/* objects is empty'); +is ($report->error, undef, ' with no error'); + +# Create a second object with the same owner. +is ($server->create ('base', 'service/foo'), 1, + 'Creating base:service/foo succeeds'); +is ($server->owner ('base', 'service/foo', 'ADMIN'), 1, + ' and setting the owner to the same value works'); +@lines = $report->owners ('base', 'service/%'); +is (scalar (@lines), 1, ' and there is still owner in the report'); +is ($lines[0][0], 'krb5', ' with the right scheme'); +is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); + +# Change the owner of the second object to an empty ACL. +is ($server->owner ('base', 'service/foo', 'second'), 1, + ' and changing the owner to an empty ACL works'); +@lines = $report->owners ('base', '%'); +is (scalar (@lines), 1, ' and there is still owner in the report'); +is ($lines[0][0], 'krb5', ' with the right scheme'); +is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); + +# Add a few things to the second ACL to see what happens. +is ($server->acl_add ('second', 'base', 'foo'), 1, + 'Adding an ACL line to the new ACL works'); +is ($server->acl_add ('second', 'base', 'bar'), 1, + ' and adding another ACL line to the new ACL works'); +@lines = $report->owners ('base', '%'); +is (scalar (@lines), 3, ' and now there are three owners in the report'); +is ($lines[0][0], 'base', ' first has the right scheme'); +is ($lines[0][1], 'bar', ' and the right identifier'); +is ($lines[1][0], 'base', ' second has the right scheme'); +is ($lines[1][1], 'foo', ' and the right identifier'); +is ($lines[2][0], 'krb5', ' third has the right scheme'); +is ($lines[2][1], 'admin@EXAMPLE.COM', ' and the right identifier'); + +# Test ownership and other ACL values. Change one keytab to be not owned by +# ADMIN, but have group permission on it. We'll need a third object neither +# owned by ADMIN or with any permissions from it. +is ($server->create ('base', 'service/null'), 1, + 'Creating base:service/null succeeds'); +is ($server->acl ('base', 'service/foo', 'get', 'ADMIN'), 1, + 'Changing the get ACL for the search also does'); +@lines = $report->objects ('owner', 'ADMIN'); +is (scalar (@lines), 1, 'Searching for objects owned by ADMIN finds one'); +is ($lines[0][0], 'base', ' and it has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +@lines = $report->objects ('owner', 'null'); +is (scalar (@lines), 1, 'Searching for objects with no set ownerfinds one'); +is ($lines[0][0], 'base', ' and it has the right type'); +is ($lines[0][1], 'service/null', ' and the right name'); +@lines = $report->objects ('acl', 'ADMIN'); +is (scalar (@lines), 2, 'ADMIN has any rights at all on two objects'); +is ($lines[0][0], 'base', ' and the first has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +is ($lines[1][0], 'base', ' and the second has the right type'); +is ($lines[1][1], 'service/foo', ' and the right name'); + +# Listing objects of a specific type. +@lines = $report->objects ('type', 'base'); +is (scalar (@lines), 3, 'Searching for all objects of type base finds three'); +is ($lines[0][0], 'base', ' and the first has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +is ($lines[1][0], 'base', ' and the second has the right type'); +is ($lines[1][1], 'service/foo', ' and the right name'); +is ($lines[2][0], 'base', ' and the third has the right type'); +is ($lines[2][1], 'service/null', ' and the right name'); +@lines = $report->objects ('type', 'keytab'); +is (scalar (@lines), 0, 'Searching for all objects of type keytab finds none'); + +# Test setting a flag, searching for objects with it, and then clearing it. +is ($server->flag_set ('base', 'service/admin', 'unchanging'), 1, + 'Setting a flag works'); +@lines = $report->objects ('flag', 'unchanging'); +is (scalar (@lines), 1, 'Searching for all objects with that flag finds one'); +is ($lines[0][0], 'base', ' and it has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1, + 'Clearing the flag works'); +@lines = $report->objects ('flag', 'unchanging'); +is (scalar (@lines), 0, ' and now there are no objects in the report'); +is ($report->error, undef, ' with no error'); + +# Clean up. +$admin->destroy; +unlink 'wallet-db'; diff --git a/perl/t/schema.t b/perl/t/schema.t index c7e9133..559ece4 100755 --- a/perl/t/schema.t +++ b/perl/t/schema.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/schema.t -- Tests for the wallet schema class. # @@ -22,7 +21,7 @@ ok (defined $schema, 'Wallet::Schema creation'); ok ($schema->isa ('Wallet::Schema'), ' and class verification'); my @sql = $schema->sql; ok (@sql > 0, 'sql() returns something'); -is (scalar (@sql), 29, ' and returns the right number of statements'); +is (scalar (@sql), 28, ' and returns the right number of statements'); # Connect to a database and test create. db_setup; diff --git a/perl/t/server.t b/perl/t/server.t index 08edd56..090387b 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/server.t -- Tests for the wallet server API. # @@ -398,31 +397,31 @@ DATE set expires to $now by $admin from $host DATE unset expires (was $now) by $admin from $host -DATE set acl_get to 1 +DATE set acl_get to ADMIN (1) by $admin from $host -DATE unset acl_get (was 1) +DATE unset acl_get (was ADMIN (1)) by $admin from $host -DATE set acl_store to 1 +DATE set acl_store to ADMIN (1) by $admin from $host -DATE unset acl_store (was 1) +DATE unset acl_store (was ADMIN (1)) by $admin from $host -DATE set owner to 1 +DATE set owner to ADMIN (1) by $admin from $host -DATE set acl_get to 5 +DATE set acl_get to empty (5) by $admin from $host -DATE set acl_store to 5 +DATE set acl_store to empty (5) by $admin from $host -DATE unset acl_store (was 5) +DATE unset acl_store (was empty (5)) by $admin from $host -DATE unset owner (was 1) +DATE unset owner (was ADMIN (1)) by $admin from $host -DATE set owner to 1 +DATE set owner to ADMIN (1) by $admin from $host DATE set flag locked by $admin from $host DATE clear flag locked by $admin from $host -DATE unset owner (was 1) +DATE unset owner (was ADMIN (1)) by $admin from $host DATE set flag unchanging by $admin from $host @@ -528,7 +527,7 @@ is ($show, $expected, ' and show an object we own'); $history = <<"EOO"; DATE create by $admin from $host -DATE set owner to 2 +DATE set owner to user1 (2) by $admin from $host EOO $seen = $server->history ('base', 'service/user1'); @@ -609,13 +608,13 @@ is ($show, $expected, ' and show an object we jointly own'); $history = <<"EOO"; DATE create by $admin from $host -DATE set owner to 4 +DATE set owner to both (4) by $admin from $host -DATE set acl_show to 2 +DATE set acl_show to user1 (2) by $admin from $host -DATE set acl_destroy to 3 +DATE set acl_destroy to user2 (3) by $admin from $host -DATE set acl_flags to 2 +DATE set acl_flags to user1 (2) by $admin from $host DATE set flag unchanging by $user1 from $host @@ -680,7 +679,7 @@ is ($show, $expected, ' and show an object we own'); $history = <<"EOO"; DATE create by $admin from $host -DATE set owner to 3 +DATE set owner to user2 (3) by $admin from $host EOO $seen = $server->history ('base', 'service/user2'); diff --git a/perl/t/verifier-netdb.t b/perl/t/verifier-netdb.t index 6a77e3c..dcbbdd8 100755 --- a/perl/t/verifier-netdb.t +++ b/perl/t/verifier-netdb.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/verifier-netdb.t -- Tests for the NetDB wallet ACL verifiers. # diff --git a/perl/t/verifier.t b/perl/t/verifier.t index 96e641d..3243d9c 100755 --- a/perl/t/verifier.t +++ b/perl/t/verifier.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/verifier.t -- Tests for the basic wallet ACL verifiers. # |