From 9347a25fdb92bae16a205da218fa153279765fbc Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 21 Jan 2010 22:24:43 -0800 Subject: Added test for Wallet::Kadmin basic function Created perl/t/kadmin.t, which performs tests against the Wallet::Kadmin basic API. We only test that Wallet::Kadmin->new () works for both MIT and Heimdal (though doesn't make a connection), and the MIT valid_principal private method. --- perl/t/kadmin.t | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) create mode 100755 perl/t/kadmin.t (limited to 'perl/t/kadmin.t') diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t new file mode 100755 index 0000000..7423ed1 --- /dev/null +++ b/perl/t/kadmin.t @@ -0,0 +1,53 @@ +#!/usr/bin/perl -w +# +# t/kadmin.t -- Tests for the kadmin object implementation. +# +# Written by Jon Robertson +# Copyright 2009 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use POSIX qw(strftime); +use Test::More tests => 15; + +use Wallet::Admin; +use Wallet::Config; +use Wallet::Kadmin; +use Wallet::Kadmin::Heimdal; +use Wallet::Kadmin::MIT; + +use lib 't/lib'; +use Util; + +# We test a Wallet::Kadmin::* module's actual workings in the keytab.t tests. +# The only things we want to test here are that each module is found, that +# Wallet::Kadmin itself delegates to them, and that the private MIT principal +# validation works as it should. +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 an MIT object. We don't care about anything but correctly +# creating it -- testing operations is for the keytab tests. +$Wallet::Config::KEYTAB_KRBTYPE = 'MIT'; +my $kadmin = Wallet::Kadmin->new (); +ok (defined ($kadmin), 'MIT kadmin object created'); + +# Test creating a Heimdal object. For us to test a working Heimdal object, +# we need a properly configured Heimdal KDC. So instead, we deliberately +# connect without configuration to get the error. That at least tests that +# we can find the Heimdal module and it dies how it should. +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.'); -- cgit v1.2.3 From dad764bc84d371ffc775e66b942ecbbc59f05c8e Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Tue, 26 Jan 2010 14:45:40 -0800 Subject: Added way to clean things during a fork for kadmin The MIT kadmin module currently directly runs the MIT kadmin program. Some data needs to be cleaned during the forks for this. This provides a callback that can be registered and is called during the fork process, currently just to mark database handles inactive. It was added to both the MIT and Heimdal modules, though it's only a stub in the Heimdal module. Heimdal is not forking kadmin, but the stub is there in order to allow the caller to not care which module is being used and just always register the callbacks. --- perl/Wallet/Kadmin/Heimdal.pm | 5 +++++ perl/Wallet/Kadmin/MIT.pm | 12 +++++++----- perl/Wallet/Object/Keytab.pm | 13 ++++++++++++- perl/t/kadmin.t | 11 ++++++++--- 4 files changed, 32 insertions(+), 9 deletions(-) (limited to 'perl/t/kadmin.t') diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index 9c2805b..b0010a5 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -39,6 +39,11 @@ sub error { return $self->{error}; } +# Set a callback to be called for forked kadmin processes. This does nothing +# for Heimdal, as we're not forking anything, but remains for compatibility +# with the MIT kadmin module. +sub fork_callback { } + ############################################################################## # kadmin Interaction ############################################################################## diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index 2e9b0b4..c3ad901 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -39,6 +39,12 @@ sub error { return $self->{error}; } +# Set a callback to be called for forked kadmin processes. +sub fork_callback { + my ($self, $callback) = @_; + $self->{fork_callback} = $callback; +} + ############################################################################## # kadmin Interaction ############################################################################## @@ -73,11 +79,7 @@ sub kadmin { $self->error ("cannot fork: $!"); return; } elsif ($pid == 0) { - # TODO - How should I handle the db handle? - # Don't use die here; it will get trapped as an exception. Also be - # careful about our database handles. (We still lose if there's some - # other database handle open we don't know about.) - #$object->{dbh}->{InactiveDestroy} = 1; + $self->{fork_callback} (); unless (open (STDERR, '>&STDOUT')) { warn "wallet: cannot dup stdout: $!\n"; exit 1; diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 6733cf0..22598f1 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -466,6 +466,11 @@ sub new { my $kadmin = Wallet::Kadmin->new (); $self->{kadmin} = $kadmin; + # Set a callback for things to do after a fork, specifically for the MIT + # kadmin module which forks to kadmin. + my $callback = sub { $self->{dbh}->{InactiveDestroy} = 1 }; + $kadmin->fork_callback ($callback); + $self = $class->SUPER::new ($type, $name, $dbh); $self->{kadmin} = $kadmin; return $self; @@ -484,8 +489,14 @@ sub create { bless $self, $class; my $kadmin = Wallet::Kadmin->new (); $self->{kadmin} = $kadmin; + + # Set a callback for things to do after a fork, specifically for the MIT + # kadmin module which forks to kadmin. + my $callback = sub { $self->{dbh}->{InactiveDestroy} = 1 }; + $kadmin->fork_callback ($callback); + if (not $kadmin->addprinc ($name)) { - die $kadmin->error; + die $kadmin->error, "\n"; } $self = $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time); $self->{kadmin} = $kadmin; diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 7423ed1..8ecc2c1 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -8,7 +8,7 @@ # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 15; +use Test::More tests => 17; use Wallet::Admin; use Wallet::Config; @@ -34,11 +34,16 @@ for my $good (qw{service service/foo bar foo/bar host/example.org "Valid principal name $good"); } -# Test creating an MIT object. We don't care about anything but correctly -# creating it -- testing operations is for the keytab tests. +# 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.'); +my $callback = sub { return 2 }; +$kadmin->fork_callback ($callback); +is ($kadmin->{fork_callback} (), 2, ' and changing it works.'); # Test creating a Heimdal object. For us to test a working Heimdal object, # we need a properly configured Heimdal KDC. So instead, we deliberately -- cgit v1.2.3 From 8d4899825cf723ef6a975306f146a06388ed4547 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Tue, 26 Jan 2010 15:16:36 -0800 Subject: Skip tests in kadmin.t if module requirements are missing Made kadmin.t skip loading the Wallet::Kadmin::Heimdal module if its requirement, Heimdal::Kadm5, is not installed on the system. --- perl/t/kadmin.t | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) (limited to 'perl/t/kadmin.t') diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 8ecc2c1..96b249b 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -13,9 +13,17 @@ use Test::More tests => 17; use Wallet::Admin; use Wallet::Config; use Wallet::Kadmin; -use Wallet::Kadmin::Heimdal; use Wallet::Kadmin::MIT; +# Only load Wallet::Kadmin::Heimdal if a required module is found. +my $heimdal_kadm5 = 0; +eval 'use Heimdal::Kadm5'; +if (!$@) { + print "No error...\n"; + $heimdal_kadm5 = 1; + require Wallet::Kadmin::Heimdal; +} + use lib 't/lib'; use Util; @@ -41,7 +49,7 @@ ok (defined ($kadmin), 'MIT kadmin object created'); my $callback = sub { return 1 }; $kadmin->fork_callback ($callback); is ($kadmin->{fork_callback} (), 1, ' and callback works.'); -my $callback = sub { return 2 }; +$callback = sub { return 2 }; $kadmin->fork_callback ($callback); is ($kadmin->{fork_callback} (), 2, ' and changing it works.'); @@ -49,10 +57,13 @@ is ($kadmin->{fork_callback} (), 2, ' and changing it works.'); # we need a properly configured Heimdal KDC. So instead, we deliberately # connect without configuration to get the error. That at least tests that # we can find the Heimdal module and it dies how it should. -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.'); +SKIP: { + skip 'Heimdal::Kadm5 not installed', 1 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.'); +} -- cgit v1.2.3 From 346660359be7666e8629c14b2d12cebf794f6f26 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Feb 2010 15:47:04 -0800 Subject: Coding style and whitespace fixes Combine a long series of eval blocks into a single block and a single error check. Remove trailing whitespace, and in some cases remove trailing () on method calls where the parens aren't useful. --- perl/Wallet/Admin.pm | 28 +++++++++--------- perl/Wallet/Kadmin.pm | 7 ++--- perl/Wallet/Kadmin/Heimdal.pm | 68 +++++++++++++++---------------------------- perl/Wallet/Object/Keytab.pm | 2 +- perl/t/kadmin.t | 6 ++-- perl/t/keytab.t | 2 +- server/wallet-admin | 6 ++-- 7 files changed, 49 insertions(+), 70 deletions(-) (limited to 'perl/t/kadmin.t') diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index c86cbba..ff87b94 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -477,11 +477,11 @@ actions on the object it returns. =item list_acls(TYPE, SEARCH) -Returns a list of all ACLs matching a search type and string in the -database, or all ACLs if no search information is given. The return value -is a list of references to pairs of ACL ID and name. For example, if -there are two ACLs in the database, one with name "ADMIN" and ID 1 and one -with name "group/admins" and ID 3, list_acls() with no arguments would +Returns a list of all ACLs matching a search type and string in the +database, or all ACLs if no search information is given. The return value +is a list of references to pairs of ACL ID and name. For example, if +there are two ACLs in the database, one with name "ADMIN" and ID 1 and one +with name "group/admins" and ID 3, list_acls() with no arguments would return: ([ 1, 'ADMIN' ], [ 3, 'group/admins' ]) @@ -492,18 +492,18 @@ database with no ACLs by calling error(). error() is guaranteed to return the error message if there was an error and undef if there was no error. There are currently two search types. 'empty' takes no arguments, and will -return only those acls that have no entries within them. 'entry' takes two -arguments -- an entry scheme and an entry identifier -- and will return +return only those acls that have no entries within them. 'entry' takes two +arguments -- an entry scheme and an entry identifier -- and will return any ACLs with an entry that matches the given scheme and contains the given identifier. =item list_objects(TYPE, SEARCH) -Returns a list of all objects matching a search type and string in the -database, or all objects in the database if no search information is -given. The return value is a list of references to pairs of type and -name. For example, if two objects existed in the database, both of type -"keytab" and with values "host/example.com" and "foo", list_objects() +Returns a list of all objects matching a search type and string in the +database, or all objects in the database if no search information is +given. The return value is a list of references to pairs of type and +name. For example, if two objects existed in the database, both of type +"keytab" and with values "host/example.com" and "foo", list_objects() with no arguments would return: ([ 'keytab', 'host/example.com' ], [ 'keytab', 'foo' ]) @@ -516,8 +516,8 @@ if there was no error. There are four types of searches currently. 'type' (with a given type) will return only those entries where the type matches the given type. 'owner', with a given owner, will only return those objects owned by the -given acl name. 'flag', with a given flag name, will only return those -items with a flag set to the given value. 'acl' operates like 'owner', +given acl name. 'flag', with a given flag name, will only return those +items with a flag set to the given value. 'acl' operates like 'owner', but will return only those objects that have the given acl name on any of the possible acl settings, not just owner. diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 501bc37..b3a630e 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -32,15 +32,14 @@ $VERSION = '0.03'; sub new { my ($class) = @_; my ($kadmin); - if (!defined $Wallet::Config::KEYTAB_KRBTYPE - || !$Wallet::Config::KEYTAB_KRBTYPE) { + if (not $Wallet::Config::KEYTAB_KRBTYPE) { die "keytab object implementation not configured\n"; } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { require Wallet::Kadmin::MIT; - $kadmin = Wallet::Kadmin::MIT->new (); + $kadmin = Wallet::Kadmin::MIT->new; } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { require Wallet::Kadmin::Heimdal; - $kadmin = Wallet::Kadmin::Heimdal->new (); + $kadmin = Wallet::Kadmin::Heimdal->new; } else { die "keytab krb server type not set to a valid value\n"; } diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index b0010a5..d046162 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -98,40 +98,27 @@ sub addprinc { my $exists = eval { $self->exists ($principal) }; if ($@) { $self->error ("error adding principal $principal: $@"); - return undef; + return; } return 1 if $exists; # The way Heimdal::Kadm5 works, we create a principal object, create the # actual principal set inactive, then randomize it and activate it. + # # TODO - Paranoia makes me want to set the password to something random # on creation even if it is inactive until after randomized by # module. my $kadmin = $self->{client}; - my $princdata = eval { $kadmin->makePrincipal ($principal) }; - if ($@) { - $self->error ("error adding principal $principal: $@"); - return; - } - - # Disable the principal before creating, until we've randomized the - # password. - my $attrs = eval { $princdata->getAttributes }; - if ($@) { - $self->error ("error adding principal $principal: $@"); - return; + eval { + my $princdata = $kadmin->makePrincipal ($principal); + my $attrs = $princdata->getAttributes; + $attrs |= KRB5_KDB_DISALLOW_ALL_TIX; + $princdata->setAttributes ($attrs); + my $password = 'inactive'; + $kadmin->createPrincipal ($princdata, $password, 0); + $kadmin->randKeyPrincipal ($principal); + $kadmin->enablePrincipal ($principal); } - $attrs |= KRB5_KDB_DISALLOW_ALL_TIX; - eval { $princdata->setAttributes ($attrs) }; - if ($@) { - $self->error ("error adding principal $principal: $@"); - return; - } - - my $password = 'inactive'; - my $test = eval { $kadmin->createPrincipal ($princdata, $password, 0) }; - eval { $kadmin->randKeyPrincipal ($principal) } unless $@; - eval { $kadmin->enablePrincipal ($principal) } unless $@; if ($@) { $self->error ("error adding principal $principal: $@"); return; @@ -156,8 +143,8 @@ sub ktadd { my $kadmin = $self->{client}; eval { $kadmin->randKeyPrincipal ($principal) }; if ($@) { - $self->error ("error creating keytab for $principal: could not " - ."reinit enctypes: $@"); + $self->error ("error creating keytab for $principal: could not" + . " reinit enctypes: $@"); return; } my $princdata = eval { $kadmin->getPrincipal ($principal) }; @@ -165,23 +152,22 @@ sub ktadd { $self->error ("error creating keytab for $principal: $@"); return; } elsif (!$princdata) { - $self->error ("error creating keytab for $principal: principal does " - ."not exist"); + $self->error ("error creating keytab for $principal: principal does" + . " not exist"); return; } # Now actually remove any non-requested enctypes, if we requested any. if (@enctypes) { - my (%wanted); - my $alltypes = $princdata->getKeytypes (); - foreach (@enctypes) { $wanted{$_} = 1 } - foreach my $key (@{$alltypes}) { - my $keytype = ${$key}[0]; + my $alltypes = $princdata->getKeytypes; + my %wanted = map { $_ => 1 } @enctypes; + for my $key (@{ $alltypes }) { + my $keytype = $key->[0]; next if exists $wanted{$keytype}; eval { $princdata->delKeytypes ($keytype) }; if ($@) { - $self->error ("error removing keytype $keytype from the ". - "keytab: $@"); + $self->error ("error removing keytype $keytype from the" + . " keytab: $@"); return; } } @@ -192,12 +178,12 @@ sub ktadd { } } + # Create the keytab. eval { $kadmin->extractKeytab ($princdata, $file) }; if ($@) { $self->error ("error creating keytab for principal: $@"); return; } - return 1; } @@ -226,20 +212,14 @@ sub delprinc { return 1; } -############################################################################## -# Documentation -############################################################################## - -# Create a new MIT kadmin object. Very empty for the moment, but later it -# will probably fill out if we go to using a module rather than calling -# kadmin directly. +# Create a new Heimdal kadmin object. sub new { my ($class) = @_; my $self = { client => undef, }; bless ($self, $class); - $self->{client} = kadmin_client (); + $self->{client} = $self->kadmin_client; return $self; } diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 22598f1..9fece80 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -497,7 +497,7 @@ sub create { if (not $kadmin->addprinc ($name)) { die $kadmin->error, "\n"; - } + } $self = $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time); $self->{kadmin} = $kadmin; return $self; diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 96b249b..18d452e 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -29,7 +29,7 @@ use Util; # We test a Wallet::Kadmin::* module's actual workings in the keytab.t tests. # The only things we want to test here are that each module is found, that -# Wallet::Kadmin itself delegates to them, and that the private MIT principal +# Wallet::Kadmin itself delegates to them, and that the private MIT principal # validation works as it should. for my $bad (qw{service\* = host/foo+bar host/foo/bar /bar bar/ rcmd.foo}) { @@ -44,7 +44,7 @@ for my $good (qw{service service/foo bar foo/bar host/example.org # Test creating an MIT object and seeing if the callback works. $Wallet::Config::KEYTAB_KRBTYPE = 'MIT'; -my $kadmin = Wallet::Kadmin->new (); +my $kadmin = Wallet::Kadmin->new; ok (defined ($kadmin), 'MIT kadmin object created'); my $callback = sub { return 1 }; $kadmin->fork_callback ($callback); @@ -64,6 +64,6 @@ SKIP: { undef $Wallet::Config::KEYTAB_REALM; undef $kadmin; $Wallet::Config::KEYTAB_KRBTYPE = 'Heimdal'; - $kadmin = eval { Wallet::Kadmin->new () }; + $kadmin = eval { Wallet::Kadmin->new }; is ($kadmin, undef, 'Heimdal fails properly.'); } diff --git a/perl/t/keytab.t b/perl/t/keytab.t index ab5b19d..d1d5ba6 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -220,7 +220,7 @@ SKIP: { 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/, + like ($@, qr/^error adding principal wallet\nf/, ' with the right error'); } $object = eval { diff --git a/server/wallet-admin b/server/wallet-admin index 761288d..cd775b6 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -158,7 +158,7 @@ used, the database may also have to be created in advance. =item list (acls | objects) [ [ ... ] ] -Returns a list of ACLs or objects in the database. ACLs will be listed +Returns a list of ACLs or objects in the database. ACLs will be listed in the form: (ACL ID: ) @@ -210,8 +210,8 @@ can be housekept. =item list acls entry -Returns all ACLs containing an entry with given schema and identifier. -The schema is used for an exact search, while the identifier given will +Returns all ACLs containing an entry with given schema and identifier. +The schema is used for an exact search, while the identifier given will match any identifier containing that text, for flexibility. =back -- cgit v1.2.3 From ae9db60c9b9601f66b34b564b80bbcfbe41301e1 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 18 Feb 2010 16:12:10 -0800 Subject: Add a more complete test suite for Wallet::Kadmin --- perl/t/kadmin.t | 93 +++++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 67 insertions(+), 26 deletions(-) (limited to 'perl/t/kadmin.t') diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 18d452e..82e6edf 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -3,12 +3,12 @@ # t/kadmin.t -- Tests for the kadmin object implementation. # # Written by Jon Robertson -# Copyright 2009 Board of Trustees, Leland Stanford Jr. University +# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 17; +use Test::More tests => 33; use Wallet::Admin; use Wallet::Config; @@ -19,7 +19,6 @@ use Wallet::Kadmin::MIT; my $heimdal_kadm5 = 0; eval 'use Heimdal::Kadm5'; if (!$@) { - print "No error...\n"; $heimdal_kadm5 = 1; require Wallet::Kadmin::Heimdal; } @@ -27,43 +26,85 @@ if (!$@) { use lib 't/lib'; use Util; -# We test a Wallet::Kadmin::* module's actual workings in the keytab.t tests. -# The only things we want to test here are that each module is found, that -# Wallet::Kadmin itself delegates to them, and that the private MIT principal -# validation works as it should. -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 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.'); +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.'); +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. For us to test a working Heimdal object, -# we need a properly configured Heimdal KDC. So instead, we deliberately -# connect without configuration to get the error. That at least tests that -# we can find the Heimdal module and it dies how it should. +# 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', 1 unless $heimdal_kadm5; + 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 ($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', 15 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->delprinc ('wallet/one'), 1, 'Deleting wallet/one works'); + is ($kadmin->exists ('wallet/one'), 0, ' and it does not exist'); + + # Create the principal and check that ktadd returns something. We'll + # check the details of the return in the keytab check. + is ($kadmin->addprinc ('wallet/one'), 1, 'Creating wallet/one works'); + is ($kadmin->exists ('wallet/one'), 1, ' and it now exists'); + unlink ('./tmp.keytab'); + is ($kadmin->ktadd ('wallet/one', './tmp.keytab'), 1, + ' and retrieving a keytab works'); + ok (-s './tmp.keytab', ' and the resulting keytab is non-zero'); + is (getcreds ('./tmp.keytab', "wallet/one\@$Wallet::Config::KEYTAB_REALM"), + 1, ' and works for authentication'); + unlink ('./tmp.keytab'); + + # Delete the principal and confirm behavior. + is ($kadmin->delprinc ('wallet/one'), 1, 'Deleting principal works'); + is ($kadmin->exists ('wallet/one'), 0, ' and now it does not exist'); + is ($kadmin->ktadd ('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->delprinc ('wallet/one'), 1, ' and deleting it again works'); } -- cgit v1.2.3 From 2651ef4352c8cc782c4e0f3175257f7bb0c1e495 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 18 Feb 2010 18:03:09 -0800 Subject: Rename functions in Wallet::Kadmin API Now that we support multiple versions of Kerberos, use generic names for the functions in the Wallet::Kadmin interface rather than the commands from the MIT kadmin interface. --- TODO | 4 ---- perl/Wallet/Kadmin.pm | 14 +++++++------- perl/Wallet/Kadmin/Heimdal.pm | 12 ++++++------ perl/Wallet/Kadmin/MIT.pm | 12 ++++++------ perl/Wallet/Object/Keytab.pm | 17 ++++++----------- perl/t/kadmin.t | 14 +++++++------- perl/t/keytab.t | 4 ++-- 7 files changed, 34 insertions(+), 43 deletions(-) (limited to 'perl/t/kadmin.t') diff --git a/TODO b/TODO index bfc7910..4ad1b1e 100644 --- a/TODO +++ b/TODO @@ -2,12 +2,8 @@ Release 0.10: -* Remove stub fork hook from Wallet::Kadmin::MIT. - * Handle unchanging support for Heimdal. -* Fix the Wallet::Kadmin API to use more generic function names. - * Move reporting code from Wallet::Admin to Wallet::Report. * Refactor attribute handling code in Wallet::Object::Keytab, move to diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index a06e1e2..21678ca 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -73,7 +73,7 @@ __END__ ############################################################################## =for stopwords -backend Kadmin keytabs keytab Heimdal API kadmind kadmin KDC ENCTYPES +backend Kadmin keytabs keytab Heimdal API kadmind kadmin KDC ENCTYPE enctypes enctype Allbery =head1 NAME @@ -83,10 +83,10 @@ Wallet::Kadmin - Kerberos administration API for wallet keytab backend =head1 SYNOPSIS my $kadmin = Wallet::Kadmin->new; - $kadmin->addprinc ("host/shell.example.com"); - $kadmin->ktadd ("host/shell.example.com", "aes256-cts-hmac-sha1-96"); + $kadmin->create ("host/foo.example.com"); + $kadmin->keytab ("host/foo.example.com", "aes256-cts-hmac-sha1-96"); my $exists = $kadmin->exists ("host/oldshell.example.com"); - $kadmin->delprinc ("host/oldshell.example.com") if $exists; + $kadmin->destroy ("host/oldshell.example.com") if $exists; =head1 DESCRIPTION @@ -123,14 +123,14 @@ appropriate for the configured Kerberos implementation. =over 4 -=item addprinc(PRINCIPAL) +=item create(PRINCIPAL) Adds a new principal with a given name. The principal is created with a random password, and any other flags set by Wallet::Config. Returns true on success and false on failure. If the principal already exists, return true as we are bringing our expectations in line with reality. -=item delprinc(PRINCIPAL) +=item destroy(PRINCIPAL) Removes a principal with the given name. Returns true on success or false on failure. If the principal does not exist, return true as we are @@ -162,7 +162,7 @@ kadmin command-line client, the sub CALLBACK will be called in the child process before running the program. This can be used to, for example, properly clean up shared database handles. -=item ktadd(PRINCIPAL, FILE, ENCTYPES) +=item keytab(PRINCIPAL, FILE [, ENCTYPE ... ]) A keytab is an on-disk store for the key or keys for a Kerberos principal. Keytabs are used by services to verify incoming authentication from diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index d59b33c..0ac8cd9 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -59,7 +59,7 @@ sub exists { # Create a principal in Kerberos. If there is an error, return undef and set # the error. Return 1 on success or the principal already existing. -sub addprinc { +sub create { my ($self, $principal) = @_; $principal = $self->canonicalize_principal ($principal); my $exists = eval { $self->exists ($principal) }; @@ -97,7 +97,7 @@ sub addprinc { # optionally a list of encryption types to which to limit the keytab. Return # true if successful, false otherwise. If the keytab creation fails, sets the # error. -sub ktadd { +sub keytab { my ($self, $principal, $file, @enctypes) = @_; $principal = $self->canonicalize_principal ($principal); @@ -155,7 +155,7 @@ sub ktadd { # Delete a principal from Kerberos. Return true if successful, false # otherwise. If the deletion fails, sets the error. If the principal doesn't # exist, return success; we're bringing reality in line with our expectations. -sub delprinc { +sub destroy { my ($self, $principal) = @_; $principal = $self->canonicalize_principal ($principal); my $exists = eval { $self->exists ($principal) }; @@ -213,10 +213,10 @@ Wallet::Kadmin::Heimdal - Wallet Kerberos administration API for Heimdal =head1 SYNOPSIS my $kadmin = Wallet::Kadmin::Heimdal->new; - $kadmin->addprinc ("host/shell.example.com"); - $kadmin->ktadd ("host/shell.example.com", "aes256-cts-hmac-sha1-96"); + $kadmin->create ("host/foo.example.com"); + $kadmin->keytab ("host/foo.example.com", "aes256-cts-hmac-sha1-96"); my $exists = $kadmin->exists ("host/oldshell.example.com"); - $kadmin->delprinc ("host/oldshell.example.com") if $exists; + $kadmin->destroy ("host/oldshell.example.com") if $exists; =head1 DESCRIPTION diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index 1ab8b1d..9ab575c 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -116,7 +116,7 @@ sub exists { # Create a principal in Kerberos. Sets the error and returns undef on failure, # and returns 1 on either success or the principal already existing. -sub addprinc { +sub create { my ($self, $principal) = @_; unless ($self->valid_principal ($principal)) { $self->error ("invalid principal name $principal"); @@ -141,7 +141,7 @@ sub addprinc { # optionally a list of encryption types to which to limit the keytab. Return # true if successful, false otherwise. If the keytab creation fails, sets the # error. -sub ktadd { +sub keytab { my ($self, $principal, $file, @enctypes) = @_; unless ($self->valid_principal ($principal)) { $self->error ("invalid principal name: $principal"); @@ -168,7 +168,7 @@ sub ktadd { # Delete a principal from Kerberos. Return true if successful, false # otherwise. If the deletion fails, sets the error. If the principal doesn't # exist, return success; we're bringing reality in line with our expectations. -sub delprinc { +sub destroy { my ($self, $principal) = @_; unless ($self->valid_principal ($principal)) { $self->error ("invalid principal name: $principal"); @@ -219,10 +219,10 @@ Wallet::Kadmin::MIT - Wallet Kerberos administration API for MIT =head1 SYNOPSIS my $kadmin = Wallet::Kadmin::MIT->new; - $kadmin->addprinc ("host/shell.example.com"); - $kadmin->ktadd ("host/shell.example.com", "aes256-cts-hmac-sha1-96"); + $kadmin->create ("host/foo.example.com"); + $kadmin->keytab ("host/foo.example.com", "aes256-cts-hmac-sha1-96"); my $exists = $kadmin->exists ("host/oldshell.example.com"); - $kadmin->delprinc ("host/oldshell.example.com") if $exists; + $kadmin->destroy ("host/oldshell.example.com") if $exists; =head1 DESCRIPTION diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 760280f..66c5e6a 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -289,7 +289,7 @@ sub create { my $callback = sub { $self->{dbh}->{InactiveDestroy} = 1 }; $kadmin->fork_callback ($callback); - if (not $kadmin->addprinc ($name)) { + if (not $kadmin->create ($name)) { die $kadmin->error, "\n"; } $self = $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time); @@ -318,7 +318,7 @@ sub destroy { return; } my $kadmin = $self->{kadmin}; - if (not $kadmin->delprinc ($self->{name})) { + if (not $kadmin->destroy ($self->{name})) { $self->error ($kadmin->error); return; } @@ -350,7 +350,7 @@ sub get { unlink $file; my @enctypes = $self->attr ('enctypes'); my $kadmin = $self->{kadmin}; - if (not $kadmin->ktadd ($self->{name}, $file, @enctypes)) { + if (not $kadmin->keytab ($self->{name}, $file, @enctypes)) { $self->error ($kadmin->error); return; } @@ -520,19 +520,14 @@ used. =item KEYTAB_TMP/keytab. -The keytab is created in this file using C and then read into -memory. KEYTAB_TMP is set in the wallet configuration, and is the -process ID of the current process. The file is unlinked after being read. +The keytab is created in this file and then read into memory. KEYTAB_TMP +is set in the wallet configuration, and is the process ID of the +current process. The file is unlinked after being read. =back =head1 LIMITATIONS -Currently, when used with MIT Kerberos, this implementation calls an -external B program rather than using a native Perl module and -therefore requires B be installed and parses its output. It may -miss some error conditions if the output of B ever changes. - Only one Kerberos realm is supported for a given wallet implementation and all keytab objects stored must be in that realm. Keytab names in the wallet database do not have realm information. diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 82e6edf..9c49995 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -83,15 +83,15 @@ SKIP: { $kadmin = eval { Wallet::Kadmin->new }; ok (defined $kadmin, 'Creating Wallet::Kadmin object succeeds'); is ($@, '', ' and there is no error'); - is ($kadmin->delprinc ('wallet/one'), 1, 'Deleting wallet/one works'); + 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 ktadd returns something. We'll + # Create the principal and check that keytab returns something. We'll # check the details of the return in the keytab check. - is ($kadmin->addprinc ('wallet/one'), 1, 'Creating wallet/one works'); + is ($kadmin->create ('wallet/one'), 1, 'Creating wallet/one works'); is ($kadmin->exists ('wallet/one'), 1, ' and it now exists'); unlink ('./tmp.keytab'); - is ($kadmin->ktadd ('wallet/one', './tmp.keytab'), 1, + is ($kadmin->keytab ('wallet/one', './tmp.keytab'), 1, ' and retrieving a keytab works'); ok (-s './tmp.keytab', ' and the resulting keytab is non-zero'); is (getcreds ('./tmp.keytab', "wallet/one\@$Wallet::Config::KEYTAB_REALM"), @@ -99,12 +99,12 @@ SKIP: { unlink ('./tmp.keytab'); # Delete the principal and confirm behavior. - is ($kadmin->delprinc ('wallet/one'), 1, 'Deleting principal works'); + is ($kadmin->destroy ('wallet/one'), 1, 'Deleting principal works'); is ($kadmin->exists ('wallet/one'), 0, ' and now it does not exist'); - is ($kadmin->ktadd ('wallet/one', './tmp.keytab'), undef, + is ($kadmin->keytab ('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->delprinc ('wallet/one'), 1, ' and deleting it again works'); + is ($kadmin->destroy ('wallet/one'), 1, ' and deleting it again works'); } diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 39be547..a14b63e 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -59,7 +59,7 @@ sub system_quiet { sub create { my ($principal) = @_; my $kadmin = Wallet::Kadmin->new; - return $kadmin->addprinc ($principal); + return $kadmin->create ($principal); } # Destroy a principal out of Kerberos. Only usable once the configuration has @@ -67,7 +67,7 @@ sub create { sub destroy { my ($principal) = @_; my $kadmin = Wallet::Kadmin->new; - return $kadmin->delprinc ($principal); + return $kadmin->destroy ($principal); } # Check whether a principal exists. MIT uses kvno and Heimdal uses kgetcred. -- cgit v1.2.3 From a24d3ac3c7e8cb68fe2268f337a4edb599d5f881 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 18 Feb 2010 21:31:10 -0800 Subject: Support unchanging keytabs with Heimdal without remctl Heimdal supports retrieving a keytab containing the existing keys over the kadmin protocol. Move the support for using remctl to retrieve an existing keytab into Wallet::Kadmin::MIT and provide two separate methods in the Wallet::Kadmin interface: one which rekeys and one which doesn't. Implement the non-rekeying interface for Heimdal. Expand the test suite for the unchanging keytabs to include tests for the Heimdal method. --- TODO | 2 - perl/Wallet/Config.pm | 21 +++++-- perl/Wallet/Kadmin.pm | 43 ++++++++------ perl/Wallet/Kadmin/Heimdal.pm | 74 +++++++++++++++++++++--- perl/Wallet/Kadmin/MIT.pm | 68 +++++++++++++++++++--- perl/Wallet/Object/Keytab.pm | 49 +--------------- perl/t/kadmin.t | 4 +- perl/t/keytab.t | 127 ++++++++++++++++++++++++++++-------------- 8 files changed, 257 insertions(+), 131 deletions(-) (limited to 'perl/t/kadmin.t') diff --git a/TODO b/TODO index 92bd025..662ea47 100644 --- a/TODO +++ b/TODO @@ -2,8 +2,6 @@ Release 0.10: -* Handle unchanging support for Heimdal. - * Move reporting code from Wallet::Admin to Wallet::Report. * Check whether we can just drop the realm restriction on keytabs and diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index c59d3e3..396bf7d 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -26,7 +26,8 @@ Wallet::Config - Configuration handling for the wallet server =for stopwords DBI DSN SQLite subdirectories KEYTAB keytab kadmind KDC add-ons kadmin DNS SRV kadmin keytabs remctl backend lowercased NETDB ACL NetDB unscoped -usernames rekey hostnames Allbery wallet-backend keytab-backend +usernames rekey hostnames Allbery wallet-backend keytab-backend Heimdal +rekeys =head1 SYNOPSIS @@ -313,11 +314,19 @@ our $KEYTAB_TMP; =head2 Retrieving Existing Keytabs -The keytab object backend optionally supports retrieving existing keys, -and hence keytabs, for Kerberos principals by contacting the KDC via -remctl and talking to B. This is enabled by setting the -C flag on keytab objects. To configure that support, set the -following variables. +Heimdal provides the choice, over the network protocol, of either +downloading the existing keys for a principal or generating new random +keys. MIT Kerberos does not; downloading a keytab over the kadmin +protocol always rekeys the principal. + +For MIT Kerberos, the keytab object backend therefore optionally supports +retrieving existing keys, and hence keytabs, for Kerberos principals by +contacting the KDC via remctl and talking to B. This is +enabled by setting the C flag on keytab objects. To configure +that support, set the following variables. + +This is not required for Heimdal; for Heimdal, setting the C +flag is all that's needed. =over 4 diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 3ca531e..f3c2895 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -83,10 +83,12 @@ Wallet::Kadmin - Kerberos administration API for wallet keytab backend =head1 SYNOPSIS my $kadmin = Wallet::Kadmin->new; - $kadmin->create ("host/foo.example.com"); - $kadmin->keytab ("host/foo.example.com", "aes256-cts-hmac-sha1-96"); - my $exists = $kadmin->exists ("host/oldshell.example.com"); - $kadmin->destroy ("host/oldshell.example.com") if $exists; + $kadmin->create ('host/foo.example.com'); + $kadmin->keytab_rekey ('host/foo.example.com', 'keytab', + 'aes256-cts-hmac-sha1-96'); + my $data = $kadmin->keytab ('host/foo.example.com'); + my $exists = $kadmin->exists ('host/oldshell.example.com'); + $kadmin->destroy ('host/oldshell.example.com') if $exists; =head1 DESCRIPTION @@ -162,19 +164,26 @@ kadmin command-line client, the sub CALLBACK will be called in the child process before running the program. This can be used to, for example, properly clean up shared database handles. -=item keytab(PRINCIPAL, FILE [, ENCTYPE ... ]) - -A keytab is an on-disk store for the key or keys for a Kerberos principal. -Keytabs are used by services to verify incoming authentication from -clients or by automated processes that need to authenticate to Kerberos. -To create a keytab, the principal has to be created in Kerberos and then a -keytab is generated and stored in a file on disk. - -ktadd() creates a new keytab for the given principal, storing it in the -given file and limited to the enctypes supplied. The enctype values must -be enctype strings recognized by the Kerberos implementation (strings like -C or C). Returns true on success -and false on failure. +=item keytab(PRINCIPAL) + +keytab() creates a keytab for the given principal, storing it in the given +file. A keytab is an on-disk store for the key or keys for a Kerberos +principal. Keytabs are used by services to verify incoming authentication +from clients or by automated processes that need to authenticate to +Kerberos. To create a keytab, the principal has to have previously been +created in the Kerberos KDC. Returns the keytab as binary data on success +and undef on failure. + +=item keytab_rekey(PRINCIPAL, FILE [, ENCTYPE ...]) + +Like keytab(), but randomizes the key for the principal before generating +the keytab and writes it to the given file. This will invalidate any +existing keytabs for that principal. This method can also limit the +encryption types of the keys for that principal via the optional ENCTYPE +arguments. The enctype values must be enctype strings recognized by the +Kerberos implementation (strings like C or +C). If none are given, the KDC defaults will be used. +Returns true on success and false on failure. =back diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index 0ac8cd9..e066006 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -39,6 +39,23 @@ sub canonicalize_principal { return $principal; } +# Read the entirety of a possibly binary file and return the contents. If +# reading the file fails, set the error message and return undef. +sub slurp_file { + my ($self, $file) = @_; + unless (open (TMPFILE, '<', $file)) { + $self->error ("cannot open temporary file $file: $!"); + return; + } + local $/; + my $data = ; + unless (close TMPFILE) { + $self->error ("cannot read temporary file $file: $!"); + return; + } + return $data; +} + ############################################################################## # Public interfaces ############################################################################## @@ -93,11 +110,38 @@ sub create { return 1; } -# Create a keytab from a principal. Takes the principal, the file, and -# optionally a list of encryption types to which to limit the keytab. Return -# true if successful, false otherwise. If the keytab creation fails, sets the -# error. +# Create a keytab for a principal. Returns the keytab as binary data or undef +# on failure, setting the error. sub keytab { + my ($self, $principal) = @_; + $principal = $self->canonicalize_principal ($principal); + my $kadmin = $self->{client}; + my $file = $Wallet::Config::KEYTAB_TMP . "/keytab.$$"; + unlink $file; + my $princdata = eval { $kadmin->getPrincipal ($principal) }; + if ($@) { + $self->error ("error creating keytab for $principal: $@"); + return; + } elsif (!$princdata) { + $self->error ("error creating keytab for $principal: principal does" + . " not exist"); + return; + } + eval { $kadmin->extractKeytab ($princdata, $file) }; + if ($@) { + $self->error ("error creating keytab for principal: $@"); + return; + } + my $data = $self->slurp_file ($file); + unlink $file; + return $data; +} + +# Create a keytab for a principal, randomizing the keys for that principal at +# the same time. Takes the principal, the file, and optionally a list of +# encryption types to which to limit the keytab. Return true if successful, +# false otherwise. If the keytab creation fails, sets the error. +sub keytab_rekey { my ($self, $principal, $file, @enctypes) = @_; $principal = $self->canonicalize_principal ($principal); @@ -213,10 +257,12 @@ Wallet::Kadmin::Heimdal - Wallet Kerberos administration API for Heimdal =head1 SYNOPSIS my $kadmin = Wallet::Kadmin::Heimdal->new; - $kadmin->create ("host/foo.example.com"); - $kadmin->keytab ("host/foo.example.com", "aes256-cts-hmac-sha1-96"); - my $exists = $kadmin->exists ("host/oldshell.example.com"); - $kadmin->destroy ("host/oldshell.example.com") if $exists; + $kadmin->create ('host/foo.example.com'); + $kadmin->keytab_rekey ('host/foo.example.com', 'keytab', + 'aes256-cts-hmac-sha1-96'); + my $data = $kadmin->keytab ('host/foo.example.com'); + my $exists = $kadmin->exists ('host/oldshell.example.com'); + $kadmin->destroy ('host/oldshell.example.com') if $exists; =head1 DESCRIPTION @@ -228,6 +274,18 @@ To use this object, several configuration parameters must be set. See Wallet::Config(3) for details on those configuration parameters and information about how to set wallet configuration. +=head1 FILES + +=over 4 + +=item KEYTAB_TMP/keytab. + +The keytab is created in this file and then read into memory. KEYTAB_TMP +is set in the wallet configuration, and is the process ID of the +current process. The file is unlinked after being read. + +=back + =head1 SEE ALSO kadmin(8), Wallet::Config(3), Wallet::Kadmin(3), diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index 9ab575c..1c6d2c1 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -137,11 +137,52 @@ sub create { return 1; } -# Create a keytab from a principal. Takes the principal, the file, and -# optionally a list of encryption types to which to limit the keytab. Return -# true if successful, false otherwise. If the keytab creation fails, sets the -# error. +# Retrieve an existing keytab from the KDC via a remctl call. The KDC needs +# to be running the keytab-backend script and support the keytab retrieve +# remctl command. In addition, the user must have configured us with the path +# to a ticket cache and the host to which to connect with remctl. Returns the +# keytab on success and undef on failure. sub keytab { + my ($self, $principal) = @_; + my $host = $Wallet::Config::KEYTAB_REMCTL_HOST; + unless ($host and $Wallet::Config::KEYTAB_REMCTL_CACHE) { + $self->error ('keytab unchanging support not configured'); + return; + } + eval { require Net::Remctl }; + if ($@) { + $self->error ("keytab unchanging support not available: $@"); + return; + } + if ($principal !~ /\@/ && $Wallet::Config::KEYTAB_REALM) { + $principal .= '@' . $Wallet::Config::KEYTAB_REALM; + } + local $ENV{KRB5CCNAME} = $Wallet::Config::KEYTAB_REMCTL_CACHE; + my $port = $Wallet::Config::KEYTAB_REMCTL_PORT || 0; + my $remctl_princ = $Wallet::Config::KEYTAB_REMCTL_PRINCIPAL || ''; + my @command = ('keytab', 'retrieve', $principal); + my $result = Net::Remctl::remctl ($host, $port, $remctl_princ, @command); + if ($result->error) { + $self->error ("cannot retrieve keytab for $principal: ", + $result->error); + return; + } elsif ($result->status != 0) { + my $error = $result->stderr; + $error =~ s/\s+$//; + $error =~ s/\n/ /g; + $self->error ("cannot retrieve keytab for $principal: $error"); + return; + } else { + return $result->stdout; + } +} + +# Create a keytab for a principal, randomizing the keys for that principal +# in the process. Takes the principal, the file, and optionally a list of +# encryption types to which to limit the keytab. Return true if +# successful, false otherwise. If the keytab creation fails, sets the +# error. +sub keytab_rekey { my ($self, $principal, $file, @enctypes) = @_; unless ($self->valid_principal ($principal)) { $self->error ("invalid principal name: $principal"); @@ -210,7 +251,7 @@ __END__ ############################################################################## =for stopwords -keytabs keytab kadmin KDC API Allbery +rekeying rekeys remctl backend keytabs keytab kadmin KDC API Allbery =head1 NAME @@ -219,10 +260,12 @@ Wallet::Kadmin::MIT - Wallet Kerberos administration API for MIT =head1 SYNOPSIS my $kadmin = Wallet::Kadmin::MIT->new; - $kadmin->create ("host/foo.example.com"); - $kadmin->keytab ("host/foo.example.com", "aes256-cts-hmac-sha1-96"); - my $exists = $kadmin->exists ("host/oldshell.example.com"); - $kadmin->destroy ("host/oldshell.example.com") if $exists; + $kadmin->create ('host/foo.example.com'); + $kadmin->keytab_rekey ('host/foo.example.com', 'keytab', + 'aes256-cts-hmac-sha1-96'); + my $data = $kadmin->keytab ('host/foo.example.com'); + my $exists = $kadmin->exists ('host/oldshell.example.com'); + $kadmin->destroy ('host/oldshell.example.com') if $exists; =head1 DESCRIPTION @@ -231,6 +274,13 @@ providing an interface to create and delete principals and create keytabs. It provides the API documented in Wallet::Kadmin(3) for an MIT Kerberos KDC. +MIT Kerberos does not provide any method via the kadmin network protocol +to retrieve a keytab for a principal without rekeying it, so the keytab() +method (as opposed to keytab_rekey(), which rekeys the principal) is +implemented using a remctl backend. For that method (used for unchanging +keytab objects) to work, the necessary wallet configuration and remctl +interface on the KDC must be set up. + To use this object, several configuration parameters must be set. See Wallet::Config(3) for details on those configuration parameters and information about how to set wallet configuration. diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 44ee003..5c66967 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -179,49 +179,6 @@ sub sync_list { return @targets; } -############################################################################## -# Keytab retrieval -############################################################################## - -# Retrieve an existing keytab from the KDC via a remctl call. The KDC needs -# to be running the keytab-backend script and support the keytab retrieve -# remctl command. In addition, the user must have configured us with the path -# to a ticket cache and the host to which to connect with remctl. Returns the -# keytab on success and undef on failure. -sub keytab_retrieve { - my ($self, $keytab) = @_; - my $host = $Wallet::Config::KEYTAB_REMCTL_HOST; - unless ($host and $Wallet::Config::KEYTAB_REMCTL_CACHE) { - $self->error ('keytab unchanging support not configured'); - return; - } - eval { require Net::Remctl }; - if ($@) { - $self->error ("keytab unchanging support not available: $@"); - return; - } - if ($Wallet::Config::KEYTAB_REALM) { - $keytab .= '@' . $Wallet::Config::KEYTAB_REALM; - } - local $ENV{KRB5CCNAME} = $Wallet::Config::KEYTAB_REMCTL_CACHE; - my $port = $Wallet::Config::KEYTAB_REMCTL_PORT || 0; - my $principal = $Wallet::Config::KEYTAB_REMCTL_PRINCIPAL || ''; - my @command = ('keytab', 'retrieve', $keytab); - my $result = Net::Remctl::remctl ($host, $port, $principal, @command); - if ($result->error) { - $self->error ("cannot retrieve keytab for $keytab: ", $result->error); - return; - } elsif ($result->status != 0) { - my $error = $result->stderr; - $error =~ s/\s+$//; - $error =~ s/\n/ /g; - $self->error ("cannot retrieve keytab for $keytab: $error"); - return; - } else { - return $result->stdout; - } -} - ############################################################################## # Core methods ############################################################################## @@ -365,8 +322,9 @@ sub get { $self->error ("cannot get $id: object is locked"); return; } + my $kadmin = $self->{kadmin}; if ($self->flag_check ('unchanging')) { - my $result = $self->keytab_retrieve ($self->{name}); + my $result = $kadmin->keytab ($self->{name}); if (defined $result) { $self->log_action ('get', $user, $host, $time); } @@ -379,8 +337,7 @@ sub get { my $file = $Wallet::Config::KEYTAB_TMP . "/keytab.$$"; unlink $file; my @enctypes = $self->attr ('enctypes'); - my $kadmin = $self->{kadmin}; - if (not $kadmin->keytab ($self->{name}, $file, @enctypes)) { + if (not $kadmin->keytab_rekey ($self->{name}, $file, @enctypes)) { $self->error ($kadmin->error); return; } diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 9c49995..a29cae3 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -91,7 +91,7 @@ SKIP: { is ($kadmin->create ('wallet/one'), 1, 'Creating wallet/one works'); is ($kadmin->exists ('wallet/one'), 1, ' and it now exists'); unlink ('./tmp.keytab'); - is ($kadmin->keytab ('wallet/one', './tmp.keytab'), 1, + is ($kadmin->keytab_rekey ('wallet/one', './tmp.keytab'), 1, ' and retrieving a keytab works'); ok (-s './tmp.keytab', ' and the resulting keytab is non-zero'); is (getcreds ('./tmp.keytab', "wallet/one\@$Wallet::Config::KEYTAB_REALM"), @@ -101,7 +101,7 @@ SKIP: { # 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 ('wallet/one', './tmp.keytab'), undef, + 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%, diff --git a/perl/t/keytab.t b/perl/t/keytab.t index a14b63e..a702c0f 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -9,7 +9,7 @@ # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 125; +use Test::More tests => 135; use Wallet::Admin; use Wallet::Config; @@ -378,12 +378,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', 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'; @@ -406,41 +401,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 (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 (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 (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"; @@ -450,6 +489,12 @@ $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 -- cgit v1.2.3 From 93eb5f8fe8d05398dd6fb364680e40eb8dae23e4 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 18 Feb 2010 22:06:17 -0800 Subject: Refactor Wallet::Kadmin keytab_rekey to return keytab Change the API for keytab_rekey to match keytab, returning the keytab as data instead of writing it to a file. This simplifies the wallet object implementation and moves the logic for reading the temporary file into Wallet::Kadmin and its child classes. (Eventually, there may be a kadmin backend that doesn't require using a temporary file.) Setting KEYTAB_TMP is now required to instantiate either the ::MIT or ::Heimdal Wallet::Kadmin classes. --- perl/Wallet/Kadmin.pm | 54 ++++++++++++++++++++++++++++++++++++------- perl/Wallet/Kadmin/Heimdal.pm | 41 +++++++++++--------------------- perl/Wallet/Kadmin/MIT.pm | 39 +++++++++++++++++++++---------- perl/Wallet/Object/Keytab.pm | 42 ++++++++------------------------- perl/t/kadmin.t | 15 ++++++------ perl/t/keytab.t | 42 +++++++++++++-------------------- perl/t/lib/Util.pm | 21 +++++++++++++++-- 7 files changed, 137 insertions(+), 117 deletions(-) (limited to 'perl/t/kadmin.t') diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index f3c2895..074dd1e 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -22,6 +22,33 @@ use Wallet::Config (); # that it will sort properly. $VERSION = '0.03'; +############################################################################## +# Utility functions for child classes +############################################################################## + +# Read the entirety of a possibly binary file and return the contents, +# deleting the file after reading it. If reading the file fails, set the +# error message and return undef. +sub read_keytab { + my ($self, $file) = @_; + local *TMPFILE; + unless (open (TMPFILE, '<', $file)) { + $self->error ("cannot open temporary file $file: $!"); + return; + } + local $/; + undef $!; + my $data = ; + if ($!) { + $self->error ("cannot read temporary file $file: $!"); + unlink $file; + return; + } + close TMPFILE; + unlink $file; + return $data; +} + ############################################################################## # Public methods ############################################################################## @@ -84,9 +111,9 @@ Wallet::Kadmin - Kerberos administration API for wallet keytab backend my $kadmin = Wallet::Kadmin->new; $kadmin->create ('host/foo.example.com'); - $kadmin->keytab_rekey ('host/foo.example.com', 'keytab', - 'aes256-cts-hmac-sha1-96'); - my $data = $kadmin->keytab ('host/foo.example.com'); + my $data = $kadmin->keytab_rekey ('host/foo.example.com', + 'aes256-cts-hmac-sha1-96'); + $data = $kadmin->keytab ('host/foo.example.com'); my $exists = $kadmin->exists ('host/oldshell.example.com'); $kadmin->destroy ('host/oldshell.example.com') if $exists; @@ -101,9 +128,8 @@ interact with that implementation's kadmin interface. The class uses Wallet::Config to find which type of kadmin interface is in use and then returns an object to use for interacting with that interface. -To use this object, several configuration parameters must be set. See -Wallet::Config(3) for details on those configuration parameters and -information about how to set wallet configuration. +See L for details on how to +configure this module. =head1 CLASS METHODS @@ -174,7 +200,7 @@ Kerberos. To create a keytab, the principal has to have previously been created in the Kerberos KDC. Returns the keytab as binary data on success and undef on failure. -=item keytab_rekey(PRINCIPAL, FILE [, ENCTYPE ...]) +=item keytab_rekey(PRINCIPAL [, ENCTYPE ...]) Like keytab(), but randomizes the key for the principal before generating the keytab and writes it to the given file. This will invalidate any @@ -183,7 +209,19 @@ encryption types of the keys for that principal via the optional ENCTYPE arguments. The enctype values must be enctype strings recognized by the Kerberos implementation (strings like C or C). If none are given, the KDC defaults will be used. -Returns true on success and false on failure. +Returns the keytab as binary data on success and undef on failure. + +=back + +The following methods are utility methods to aid with child class +implementation and should only be called by child classes. + +=over 4 + +=item read_keytab(FILE) + +Reads the contents of the keytab stored in FILE into memory and returns it +as binary data. On failure, returns undef and sets the object error. =back diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index e066006..d1eecda 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -39,23 +39,6 @@ sub canonicalize_principal { return $principal; } -# Read the entirety of a possibly binary file and return the contents. If -# reading the file fails, set the error message and return undef. -sub slurp_file { - my ($self, $file) = @_; - unless (open (TMPFILE, '<', $file)) { - $self->error ("cannot open temporary file $file: $!"); - return; - } - local $/; - my $data = ; - unless (close TMPFILE) { - $self->error ("cannot read temporary file $file: $!"); - return; - } - return $data; -} - ############################################################################## # Public interfaces ############################################################################## @@ -132,17 +115,15 @@ sub keytab { $self->error ("error creating keytab for principal: $@"); return; } - my $data = $self->slurp_file ($file); - unlink $file; - return $data; + return $self->read_keytab ($file); } # Create a keytab for a principal, randomizing the keys for that principal at -# the same time. Takes the principal, the file, and optionally a list of -# encryption types to which to limit the keytab. Return true if successful, -# false otherwise. If the keytab creation fails, sets the error. +# the same time. Takes the principal and an optional list of encryption types +# to which to limit the keytab. Return the keytab data on success and undef +# on failure. If the keytab creation fails, sets the error. sub keytab_rekey { - my ($self, $principal, $file, @enctypes) = @_; + my ($self, $principal, @enctypes) = @_; $principal = $self->canonicalize_principal ($principal); # The way Heimdal works, you can only remove enctypes from a principal, @@ -188,12 +169,14 @@ sub keytab_rekey { } # Create the keytab. + my $file = $Wallet::Config::KEYTAB_TMP . "/keytab.$$"; + unlink $file; eval { $kadmin->extractKeytab ($princdata, $file) }; if ($@) { $self->error ("error creating keytab for principal: $@"); return; } - return 1; + return $self->read_keytab ($file); } # Delete a principal from Kerberos. Return true if successful, false @@ -227,6 +210,9 @@ sub new { and defined ($Wallet::Config::KEYTAB_REALM)) { die "keytab object implementation not configured\n"; } + unless (defined ($Wallet::Config::KEYTAB_TMP)) { + die "KEYTAB_TMP configuration variable not set\n"; + } my @options = (RaiseError => 1, Principal => $Wallet::Config::KEYTAB_PRINCIPAL, Realm => $Wallet::Config::KEYTAB_REALM, @@ -270,9 +256,8 @@ Wallet::Kadmin::Heimdal implements the Wallet::Kadmin API for Heimdal, providing an interface to create and delete principals and create keytabs. It provides the API documented in Wallet::Kadmin(3) for a Heimdal KDC. -To use this object, several configuration parameters must be set. See -Wallet::Config(3) for details on those configuration parameters and -information about how to set wallet configuration. +To use this class, several configuration parameters must be set. See +L for details. =head1 FILES diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index 1c6d2c1..434e93d 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -178,12 +178,11 @@ sub keytab { } # Create a keytab for a principal, randomizing the keys for that principal -# in the process. Takes the principal, the file, and optionally a list of -# encryption types to which to limit the keytab. Return true if -# successful, false otherwise. If the keytab creation fails, sets the -# error. +# in the process. Takes the principal and an optional list of encryption +# types to which to limit the keytab. Return the keytab data on success +# and undef otherwise. If the keytab creation fails, sets the error. sub keytab_rekey { - my ($self, $principal, $file, @enctypes) = @_; + my ($self, $principal, @enctypes) = @_; unless ($self->valid_principal ($principal)) { $self->error ("invalid principal name: $principal"); return; @@ -191,6 +190,8 @@ sub keytab_rekey { if ($Wallet::Config::KEYTAB_REALM) { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; } + my $file = $Wallet::Config::KEYTAB_TMP . "/keytab.$$"; + unlink $file; my $command = "ktadd -q -k $file"; if (@enctypes) { @enctypes = map { /:/ ? $_ : "$_:normal" } @enctypes; @@ -203,7 +204,7 @@ sub keytab_rekey { $self->error ("error creating keytab for $principal: $1"); return; } - return 1; + return $self->read_keytab ($file); } # Delete a principal from Kerberos. Return true if successful, false @@ -238,6 +239,9 @@ sub destroy { # kadmin directly. sub new { my ($class) = @_; + unless (defined ($Wallet::Config::KEYTAB_TMP)) { + die "KEYTAB_TMP configuration variable not set\n"; + } my $self = {}; bless ($self, $class); return $self; @@ -261,9 +265,9 @@ Wallet::Kadmin::MIT - Wallet Kerberos administration API for MIT my $kadmin = Wallet::Kadmin::MIT->new; $kadmin->create ('host/foo.example.com'); - $kadmin->keytab_rekey ('host/foo.example.com', 'keytab', - 'aes256-cts-hmac-sha1-96'); - my $data = $kadmin->keytab ('host/foo.example.com'); + my $data = $kadmin->keytab_rekey ('host/foo.example.com', + 'aes256-cts-hmac-sha1-96'); + $data = $kadmin->keytab ('host/foo.example.com'); my $exists = $kadmin->exists ('host/oldshell.example.com'); $kadmin->destroy ('host/oldshell.example.com') if $exists; @@ -281,9 +285,20 @@ implemented using a remctl backend. For that method (used for unchanging keytab objects) to work, the necessary wallet configuration and remctl interface on the KDC must be set up. -To use this object, several configuration parameters must be set. See -Wallet::Config(3) for details on those configuration parameters and -information about how to set wallet configuration. +To use this class, several configuration parameters must be set. See +L for details. + +=head1 FILES + +=over 4 + +=item KEYTAB_TMP/keytab. + +The keytab is created in this file and then read into memory. KEYTAB_TMP +is set in the wallet configuration, and is the process ID of the +current process. The file is unlinked after being read. + +=back =head1 LIMITATIONS diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 5c66967..edb26b3 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -323,43 +323,19 @@ sub get { return; } my $kadmin = $self->{kadmin}; + my $result; if ($self->flag_check ('unchanging')) { - my $result = $kadmin->keytab ($self->{name}); - if (defined $result) { - $self->log_action ('get', $user, $host, $time); - } - return $result; - } - unless (defined ($Wallet::Config::KEYTAB_TMP)) { - $self->error ('KEYTAB_TMP configuration variable not set'); - return; + $result = $kadmin->keytab ($self->{name}); + } else { + my @enctypes = $self->attr ('enctypes'); + $result = $kadmin->keytab_rekey ($self->{name}, @enctypes); } - my $file = $Wallet::Config::KEYTAB_TMP . "/keytab.$$"; - unlink $file; - my @enctypes = $self->attr ('enctypes'); - if (not $kadmin->keytab_rekey ($self->{name}, $file, @enctypes)) { + if (defined $result) { + $self->log_action ('get', $user, $host, $time); + } else { $self->error ($kadmin->error); - return; - } - local *KEYTAB; - unless (open (KEYTAB, '<', $file)) { - my $princ = $self->{name}; - $self->error ("error opening keytab for principal $princ: $!"); - return; - } - local $/; - undef $!; - my $data = ; - if ($!) { - my $princ = $self->{name}; - $self->error ("error reading keytab for principal $princ: $!"); - unlink $file; - return; } - close KEYTAB; - unlink $file; - $self->log_action ('get', $user, $host, $time); - return $data; + return $result; } 1; diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index a29cae3..b9ac769 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -8,7 +8,9 @@ # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 33; +use Test::More tests => 32; + +BEGIN { $Wallet::Config::KEYTAB_TMP = '.' } use Wallet::Admin; use Wallet::Config; @@ -90,13 +92,10 @@ SKIP: { # 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'); - unlink ('./tmp.keytab'); - is ($kadmin->keytab_rekey ('wallet/one', './tmp.keytab'), 1, - ' and retrieving a keytab works'); - ok (-s './tmp.keytab', ' and the resulting keytab is non-zero'); - is (getcreds ('./tmp.keytab', "wallet/one\@$Wallet::Config::KEYTAB_REALM"), - 1, ' and works for authentication'); - unlink ('./tmp.keytab'); + 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'); diff --git a/perl/t/keytab.t b/perl/t/keytab.t index a702c0f..4e253eb 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -11,6 +11,8 @@ use POSIX qw(strftime); use Test::More tests => 135; +BEGIN { $Wallet::Config::KEYTAB_TMP = '.' } + use Wallet::Admin; use Wallet::Config; use Wallet::Kadmin; @@ -89,21 +91,6 @@ sub created { } } -# 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'; - } - 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 @@ -168,7 +155,6 @@ SKIP: { $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; # Clean up the principals we're going to use. @@ -178,6 +164,16 @@ 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) @@ -244,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. @@ -261,12 +257,6 @@ 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 = '.'; SKIP: { skip 'no kadmin program test for Heimdal', 2 if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal'; @@ -447,7 +437,7 @@ SKIP: { 'Clearing the unchanging flag works'); my $data = $object->get (@trace); ok (defined ($data), ' and getting the keytab works'); - ok (valid ($data, 'wallet/one'), ' and the keytab is valid'); + 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", @@ -464,7 +454,7 @@ SKIP: { if (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'mit'); my $data = $one->get (@trace); ok (defined $data, 'Get of unchanging keytab works'); - ok (valid ($data, 'wallet/one'), ' and the keytab is valid'); + 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; @@ -474,7 +464,7 @@ SKIP: { 'Clearing the unchanging flag works'); $data = $one->get (@trace); ok (defined ($data), ' and getting the keytab works'); - ok (valid ($data, 'wallet/one'), ' and the keytab is valid'); + 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'); diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm index ac0f530..ab88b39 100644 --- a/perl/t/lib/Util.pm +++ b/perl/t/lib/Util.pm @@ -20,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 @@ -66,7 +67,7 @@ sub db_setup { } ############################################################################## -# Local ticket cache +# Kerberos utility functions ############################################################################## # Given a keytab file and a principal, try authenticating with kinit. @@ -85,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 ############################################################################## -- cgit v1.2.3 From c4234b72a39b25122dbba769e028d1d105a4132e Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sat, 20 Feb 2010 23:19:50 -0800 Subject: Fix some test numbers in the Perl tests --- perl/t/kadmin.t | 2 +- perl/t/keytab.t | 9 ++++----- 2 files changed, 5 insertions(+), 6 deletions(-) (limited to 'perl/t/kadmin.t') diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index b9ac769..bbcb15a 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -72,7 +72,7 @@ SKIP: { # 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', 15 unless -f 't/data/test.keytab'; + skip 'no keytab configuration', 14 unless -f 't/data/test.keytab'; # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 4e253eb..046da9c 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -148,7 +148,7 @@ my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); # 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'; @@ -495,7 +495,7 @@ EOO # 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 setting synchronization attributes, which can also be done without # configuration. @@ -563,9 +563,7 @@ EOO # Tests for enctype restriction. SKIP: { - unless (-f 't/data/test.keytab') { - skip 'no keytab configuration', 36; - } + skip 'no keytab configuration', 36 unless -f 't/data/test.keytab'; # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; @@ -648,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) { -- cgit v1.2.3 From d04d26c6e447727cd43bd2182182117ec7302dc7 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 21 Feb 2010 20:58:27 -0800 Subject: Fix test suite skip numbering in the kadmin test --- perl/t/kadmin.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'perl/t/kadmin.t') diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index bbcb15a..6365ce5 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -56,7 +56,7 @@ for my $good (qw{service service/foo bar foo/bar host/example.org # 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; + skip 'Heimdal::Kadm5 not installed', 2 unless $heimdal_kadm5; undef $Wallet::Config::KEYTAB_PRINCIPAL; undef $Wallet::Config::KEYTAB_FILE; undef $Wallet::Config::KEYTAB_REALM; -- cgit v1.2.3 From 69289862465a3bfb3488c1b3a674b6b06c9911ee Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 3 Mar 2010 19:49:46 -0800 Subject: Remove file names from test file headers Coding style update. Don't prefix the file short description with the file name; it's not needed. --- perl/t/acl.t | 2 +- perl/t/admin.t | 2 +- perl/t/config.t | 2 +- perl/t/data/keytab-fake | 2 +- perl/t/data/netdb-fake | 2 +- perl/t/file.t | 2 +- perl/t/init.t | 2 +- perl/t/kadmin.t | 2 +- perl/t/keytab.t | 2 +- perl/t/lib/Util.pm | 4 ++-- perl/t/object.t | 2 +- perl/t/pod-spelling.t | 3 +-- perl/t/report.t | 2 +- perl/t/schema.t | 2 +- perl/t/server.t | 2 +- perl/t/verifier-netdb.t | 10 +++++----- perl/t/verifier.t | 6 +++--- tests/data/fake-kadmin | 3 ++- tests/data/wallet.conf | 2 +- 19 files changed, 27 insertions(+), 27 deletions(-) (limited to 'perl/t/kadmin.t') diff --git a/perl/t/acl.t b/perl/t/acl.t index 95aa763..f169eb5 100755 --- a/perl/t/acl.t +++ b/perl/t/acl.t @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# t/api.t -- Tests for the wallet ACL API. +# Tests for the wallet ACL API. # # Written by Russ Allbery # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/t/admin.t b/perl/t/admin.t index e22088e..074dbc6 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# t/admin.t -- Tests for wallet administrative interface. +# Tests for wallet administrative interface. # # Written by Russ Allbery # Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/t/config.t b/perl/t/config.t index 1377cb8..6b9f226 100755 --- a/perl/t/config.t +++ b/perl/t/config.t @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# t/config.t -- Tests for the wallet server configuration. +# Tests for the wallet server configuration. # # Written by Russ Allbery # Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/t/data/keytab-fake b/perl/t/data/keytab-fake index 0ecf264..f4f0fb3 100755 --- a/perl/t/data/keytab-fake +++ b/perl/t/data/keytab-fake @@ -1,6 +1,6 @@ #!/bin/sh # -# keytab-fake -- Fake keytab-backend implementation. +# Fake keytab-backend implementation. # # This keytab-fake script is meant to be run by remctld during testing of # the keytab object implementation. It returns a fixed string for diff --git a/perl/t/data/netdb-fake b/perl/t/data/netdb-fake index ae5be18..9624102 100755 --- a/perl/t/data/netdb-fake +++ b/perl/t/data/netdb-fake @@ -1,6 +1,6 @@ #!/bin/sh # -# netdb-fake -- Fake NetDB remctl interface. +# Fake NetDB remctl interface. # # This netdb-fake script is meant to be run by remctld during testing of # the NetDB ACL verifier. It returns known roles or errors for different diff --git a/perl/t/file.t b/perl/t/file.t index 7ab5d75..a821c4f 100755 --- a/perl/t/file.t +++ b/perl/t/file.t @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# t/file.t -- Tests for the file object implementation. +# Tests for the file object implementation. # # Written by Russ Allbery # Copyright 2008 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/t/init.t b/perl/t/init.t index d0fae9f..213aedf 100755 --- a/perl/t/init.t +++ b/perl/t/init.t @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# t/init.t -- Tests for database initialization. +# Tests for database initialization. # # Written by Russ Allbery # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 6365ce5..0b52528 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# t/kadmin.t -- Tests for the kadmin object implementation. +# Tests for the kadmin object implementation. # # Written by Jon Robertson # Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 046da9c..b16cea5 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# t/keytab.t -- Tests for the keytab object implementation. +# Tests for the keytab object implementation. # # Written by Russ Allbery # Copyright 2007, 2008, 2009, 2010 diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm index ab88b39..44a4d21 100644 --- a/perl/t/lib/Util.pm +++ b/perl/t/lib/Util.pm @@ -1,4 +1,4 @@ -# Util -- Utility class for wallet tests. +# Utility class for wallet tests. # # Written by Russ Allbery # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University @@ -16,7 +16,7 @@ use Wallet::Config; # 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.02'; +$VERSION = '0.03'; use Exporter (); @ISA = qw(Exporter); diff --git a/perl/t/object.t b/perl/t/object.t index 46e67e5..3949786 100755 --- a/perl/t/object.t +++ b/perl/t/object.t @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# t/object.t -- Tests for the basic object implementation. +# Tests for the basic object implementation. # # Written by Russ Allbery # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/t/pod-spelling.t b/perl/t/pod-spelling.t index d3ab858..6d9f7b0 100755 --- a/perl/t/pod-spelling.t +++ b/perl/t/pod-spelling.t @@ -9,8 +9,7 @@ # # Copyright 2008, 2009 Russ Allbery # -# This program is free software; you may redistribute it and/or modify it -# under the same terms as Perl itself. +# See LICENSE for licensing terms. use strict; use Test::More; diff --git a/perl/t/report.t b/perl/t/report.t index a18b995..a37681a 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# t/report.t -- Tests for the wallet reporting interface. +# Tests for the wallet reporting interface. # # Written by Russ Allbery # Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/t/schema.t b/perl/t/schema.t index 559ece4..7f0aea4 100755 --- a/perl/t/schema.t +++ b/perl/t/schema.t @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# t/schema.t -- Tests for the wallet schema class. +# Tests for the wallet schema class. # # Written by Russ Allbery # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/t/server.t b/perl/t/server.t index 090387b..7b30053 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# t/server.t -- Tests for the wallet server API. +# Tests for the wallet server API. # # Written by Russ Allbery # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/t/verifier-netdb.t b/perl/t/verifier-netdb.t index dcbbdd8..6bd4e73 100755 --- a/perl/t/verifier-netdb.t +++ b/perl/t/verifier-netdb.t @@ -1,15 +1,15 @@ #!/usr/bin/perl -w # -# t/verifier-netdb.t -- Tests for the NetDB wallet ACL verifiers. +# Tests for the NetDB wallet ACL verifiers. +# +# This test can only be run by someone local to Stanford with appropriate +# access to the NetDB role server and will be skipped in all other +# environments. # # Written by Russ Allbery # Copyright 2008 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. -# -# This test can only be run by someone local to Stanford with appropriate -# access to the NetDB role server and will be skipped in all other -# environments. use Test::More tests => 4; diff --git a/perl/t/verifier.t b/perl/t/verifier.t index 3243d9c..74d7ba8 100755 --- a/perl/t/verifier.t +++ b/perl/t/verifier.t @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# t/verifier.t -- Tests for the basic wallet ACL verifiers. +# Tests for the basic wallet ACL verifiers. # # Written by Russ Allbery # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University @@ -39,8 +39,8 @@ is ($verifier->error, 'no principal specified', ' and right error'); is ($verifier->check ('rra@stanford.edu', ''), undef, 'Empty ACL'); is ($verifier->error, 'malformed krb5 ACL', ' and right error'); -# Tests for unchanging support. Skip these if we don't have a keytab or if we -# can't find remctld. +# Tests for the NetDB verifiers. Skip these if we don't have a keytab or if +# we can't find remctld. SKIP: { skip 'no keytab configuration', 34 unless -f 't/data/test.keytab'; my @path = (split (':', $ENV{PATH}), '/usr/local/sbin', '/usr/sbin'); diff --git a/tests/data/fake-kadmin b/tests/data/fake-kadmin index 61906a4..4c0ceac 100755 --- a/tests/data/fake-kadmin +++ b/tests/data/fake-kadmin @@ -1,9 +1,10 @@ #!/usr/bin/perl -w # -# fake-kadmin -- Fake kadmin.local used to test the keytab backend. +# Fake kadmin.local used to test the keytab backend. # # Written by Russ Allbery # Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# # See LICENSE for licensing terms. unless ($ARGV[0] eq '-q' && @ARGV == 2) { diff --git a/tests/data/wallet.conf b/tests/data/wallet.conf index 0a232dd..877a16f 100644 --- a/tests/data/wallet.conf +++ b/tests/data/wallet.conf @@ -1,4 +1,4 @@ -# wallet.conf -- Test wallet server configuration. -*- perl -*- +# Test wallet server configuration. -*- perl -*- # Always test with SQLite. $DB_DRIVER = 'SQLite'; -- cgit v1.2.3 From 2948d66c4c074651820004856284faf7d018a3ee Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 5 Mar 2010 14:18:10 -0800 Subject: Don't clobber the user ticket cache in the kadmin test --- perl/t/kadmin.t | 3 +++ 1 file changed, 3 insertions(+) (limited to 'perl/t/kadmin.t') diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 0b52528..e5fb2fa 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -81,6 +81,9 @@ SKIP: { $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); $Wallet::Config::KEYTAB_TMP = '.'; + # Don't destroy the user's Kerberos ticket cache. + $ENV{KRB5CCNAME} = 'krb5cc_test'; + # 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'); -- cgit v1.2.3 From e6bbf534bd4195a0330a7cad02f996677a19d4d2 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 18 May 2010 16:48:54 -0700 Subject: Clean up the ticket cache from the kadmin test --- perl/t/kadmin.t | 2 ++ 1 file changed, 2 insertions(+) (limited to 'perl/t/kadmin.t') diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index e5fb2fa..a1f2876 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -109,4 +109,6 @@ SKIP: { 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'); + + unlink 'krb5cc_test'; } -- cgit v1.2.3 From e5345b50c36e3b07b9e8ec5202ed0f60bc8e2010 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 30 Aug 2012 14:44:44 -0700 Subject: Display the error message on the first kadmin test failure --- perl/t/kadmin.t | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'perl/t/kadmin.t') diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index a1f2876..778bc45 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -3,12 +3,13 @@ # Tests for the kadmin object implementation. # # Written by Jon Robertson -# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2009, 2010, 2012 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 32; +use Test::More tests => 33; BEGIN { $Wallet::Config::KEYTAB_TMP = '.' } @@ -94,6 +95,7 @@ SKIP: { # 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->error, undef, ' with no error message'); 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'); -- cgit v1.2.3 From d2b811335137ad10ca9489582f31d2d5c595f7f7 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 4 Nov 2012 09:30:58 -0800 Subject: Minor improvement to the Wallet::Kadmin test suite --- perl/t/kadmin.t | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'perl/t/kadmin.t') diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 778bc45..cefd80d 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -9,7 +9,7 @@ # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 33; +use Test::More tests => 34; BEGIN { $Wallet::Config::KEYTAB_TMP = '.' } @@ -73,7 +73,7 @@ SKIP: { # 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'; + skip 'no keytab configuration', 15 unless -f 't/data/test.keytab'; # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; @@ -91,6 +91,7 @@ SKIP: { 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'); + is ($kadmin->error, undef, ' with no error message'); # Create the principal and check that keytab returns something. We'll # check the details of the return in the keytab check. -- cgit v1.2.3 From e44a0417cde0235c2fc368e86acea3d257816958 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 27 Mar 2013 15:02:23 -0700 Subject: Fix test skip counts for some of the Perl tests Change-Id: Ic0f33bf01936a093a645bedd5adfa771fd4e3574 Reviewed-on: https://gerrit.stanford.edu/983 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/t/kadmin.t | 4 ++-- perl/t/keytab.t | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) (limited to 'perl/t/kadmin.t') diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index cefd80d..8eabc6b 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -3,7 +3,7 @@ # Tests for the kadmin object implementation. # # Written by Jon Robertson -# Copyright 2009, 2010, 2012 +# Copyright 2009, 2010, 2012, 2013 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -73,7 +73,7 @@ SKIP: { # 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', 15 unless -f 't/data/test.keytab'; + skip 'no keytab configuration', 16 unless -f 't/data/test.keytab'; # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 3ced592..f89b2c6 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -3,7 +3,7 @@ # Tests for the keytab object implementation. # # Written by Russ Allbery -# Copyright 2007, 2008, 2009, 2010 +# Copyright 2007, 2008, 2009, 2010, 2013 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -386,7 +386,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', 27 unless -f 't/data/test.keytab'; + skip 'no keytab configuration', 31 unless -f 't/data/test.keytab'; # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; -- cgit v1.2.3