From 574a9c0456c182831b3d01a4d7ee0c737b91b107 Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Tue, 9 Jun 2009 14:39:39 -0700
Subject: Remove Subversion Id strings

---
 perl/t/keytab.t | 1 -
 1 file changed, 1 deletion(-)

(limited to 'perl/t/keytab.t')

diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index c1348d4..1803e53 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 #
 # t/keytab.t -- Tests for the keytab object implementation.
 #
-- 
cgit v1.2.3


From e0f69c0b3f41684079762f843c37888d1017d576 Mon Sep 17 00:00:00 2001
From: Jon Robertson <jonrober@stanford.edu>
Date: Thu, 17 Dec 2009 11:26:28 -0800
Subject: Added keytab testing cases for Heimdal KDC

Added cases to handle the Wallet::Object::Keytab module using a Heimdal
KDC as well as an MIT KDC.  In most cases this is transparent, but some
tests are skipped for Heimdal, and the commands run to test that the
created principals and keytabs are correct are different for Heimdal.
The code now branches based on the value of
$Wallet::Config::KEYTAB_KRBTYPE.
---
 perl/t/data/README |   1 +
 perl/t/keytab.t    | 139 ++++++++++++++++++++++++++++++++++++-----------------
 2 files changed, 95 insertions(+), 45 deletions(-)

(limited to 'perl/t/keytab.t')

diff --git a/perl/t/data/README b/perl/t/data/README
index 4abbaeb..d250d33 100644
--- a/perl/t/data/README
+++ b/perl/t/data/README
@@ -21,6 +21,7 @@ following files:
     test.keytab         Keytab for an authorized user
     test.principal      Principal of the authorized user
     test.realm          Kerberos realm in which to do testing
+    test.krbtype        Type of Kerberos server (Heimdal or MIT)
 
 This realm will also need to be configured in your local krb5.conf,
 including the admin_server for the realm.
diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index 1803e53..8a11ad4 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -8,7 +8,7 @@
 # See LICENSE for licensing terms.
 
 use POSIX qw(strftime);
-use Test::More tests => 223;
+use Test::More tests => 225;
 
 use Wallet::Admin;
 use Wallet::Config;
@@ -56,10 +56,17 @@ sub system_quiet {
 # been set up.
 sub create {
     my ($principal) = @_;
-    my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k',
-                '-t', $Wallet::Config::KEYTAB_FILE,
-                '-r', $Wallet::Config::KEYTAB_REALM,
-                '-q', "addprinc -clearpolicy -randkey $principal");
+    if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
+	my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k',
+		    '-t', $Wallet::Config::KEYTAB_FILE,
+		    '-r', $Wallet::Config::KEYTAB_REALM,
+		    '-q', "addprinc -clearpolicy -randkey $principal");
+    } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
+	@args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL,
+		 '-K', $Wallet::Config::KEYTAB_FILE,
+		 '-r', $Wallet::Config::KEYTAB_REALM,
+		 'add', $principal);
+    }
     system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args);
 }
 
@@ -67,20 +74,37 @@ sub create {
 # been set up.
 sub destroy {
     my ($principal) = @_;
-    my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k',
-                '-t', $Wallet::Config::KEYTAB_FILE,
-                '-r', $Wallet::Config::KEYTAB_REALM,
-                '-q', "delprinc -force $principal");
+    my (@args);
+    if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
+	@args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k',
+		 '-t', $Wallet::Config::KEYTAB_FILE,
+		 '-r', $Wallet::Config::KEYTAB_REALM,
+		 '-q', "delprinc -force $principal");
+    } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
+	@args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL,
+		 '-K', $Wallet::Config::KEYTAB_FILE,
+		 '-r', $Wallet::Config::KEYTAB_REALM,
+		 'delete', $principal);
+    }
     system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args);
 }
 
-# Check whether a principal exists.
+# Check whether a principal exists.  kvno works for MIT, but isn't in the
+# Heimdal dist.
 sub created {
     my ($principal) = @_;
     $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
-    local $ENV{KRB5CCNAME} = 'krb5cc_temp';
-    getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL);
-    return (system_quiet ('kvno', $principal) == 0);
+    if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
+	local $ENV{KRB5CCNAME} = 'krb5cc_temp';
+	getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL);
+	return (system_quiet ('kvno', $principal) == 0);
+    } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
+	@args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL,
+		 '-K', $Wallet::Config::KEYTAB_FILE,
+		 '-r', $Wallet::Config::KEYTAB_REALM,
+		 'get', $principal);
+	return (system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args) == 0);
+    }
 }
 
 # Given keytab data and the principal, write it to a file and try
@@ -101,24 +125,41 @@ sub valid {
 # Given keytab data, write it to a file and try to determine the enctypes of
 # the keys present in that file.  Returns the enctypes as a list, with UNKNOWN
 # for encryption types that weren't recognized.  This is an ugly way of doing
-# this.
+# this for MIT.  Heimdal is much more straightforward, but MIT ktutil doesn't
+# have the needed abilities.
 sub enctypes {
     my ($keytab) = @_;
     open (KEYTAB, '>', 'keytab') or die "cannot create keytab: $!\n";
     print KEYTAB $keytab;
     close KEYTAB;
-    open (KLIST, '-|', 'klist', '-ke', 'keytab')
-        or die "cannot run klist: $!\n";
+
     my @enctypes;
-    local $_;
-    while (<KLIST>) {
-        next unless /^ *\d+ /;
-        my ($string) = /\((.*)\)\s*$/;
-        next unless $string;
-        $enctype = $enctype{lc $string} || 'UNKNOWN';
-        push (@enctypes, $enctype);
+    if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
+	open (KLIST, '-|', 'klist', '-ke', 'keytab')
+	    or die "cannot run klist: $!\n";
+	local $_;
+	while (<KLIST>) {
+	    next unless /^ *\d+ /;
+	    my ($string) = /\((.*)\)\s*$/;
+	    next unless $string;
+	    $enctype = $enctype{lc $string} || 'UNKNOWN';
+	    push (@enctypes, $enctype);
+	}
+	close KLIST;
+    } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
+	open (KTUTIL, '-|', 'ktutil', '-k', 'keytab', 'list')
+	    or die "cannot run ktutil: $!\n";
+	local $_;
+	while (<KTUTIL>) {
+	    next unless /^ *\d+ /;
+	    my ($string) = /^\s*\d+\s+(\S+)/;
+	    next unless $string;
+	    #$enctype = $enctype{lc $string} || 'UNKNOWN';
+	    #push (@enctypes, $enctype);
+	    push (@enctypes, $string);
+	}
+	close KTUTIL;
     }
-    close KLIST;
     unlink 'keytab';
     return sort @enctypes;
 }
@@ -173,6 +214,7 @@ SKIP: {
     $Wallet::Config::KEYTAB_FILE      = 't/data/test.keytab';
     $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal');
     $Wallet::Config::KEYTAB_REALM     = contents ('t/data/test.realm');
+    $Wallet::Config::KEYTAB_KRBTYPE   = contents ('t/data/test.krbtype');
     $Wallet::Config::KEYTAB_TMP       = '.';
     my $realm = $Wallet::Config::KEYTAB_REALM;
 
@@ -258,12 +300,17 @@ EOO
     is ($object->error, 'KEYTAB_TMP configuration variable not set',
         ' with the right error');
     $Wallet::Config::KEYTAB_TMP = '.';
-    $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file';
-    $data = $object->get (@trace);
-    is ($data, undef, 'Cope with a failure to run kadmin');
-    like ($object->error, qr{^cannot run /some/nonexistent/file: },
-          ' with the right error');
-    $Wallet::Config::KEYTAB_KADMIN = 'kadmin';
+    SKIP: {
+	skip ' no kadmin program test for Heimdal', 2
+	    if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal';
+
+	$Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file';
+	$data = $object->get (@trace);
+	is ($data, undef, 'Cope with a failure to run kadmin');
+	like ($object->error, qr{^cannot run /some/nonexistent/file: },
+	      ' with the right error');
+	$Wallet::Config::KEYTAB_KADMIN = 'kadmin';
+    }
     destroy ('wallet/one');
     $data = $object->get (@trace);
     is ($data, undef, 'Getting a keytab for a nonexistent principal fails');
@@ -278,12 +325,19 @@ EOO
       };
     ok (defined ($object), 'Creating good principal succeeds');
     ok (created ('wallet/one'), ' and the principal was created');
-    $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file';
-    is ($object->destroy (@trace), undef,
-        ' and destroying it with bad kadmin fails');
-    like ($object->error, qr{^cannot run /some/nonexistent/file: },
-          ' with the right error');
-    $Wallet::Config::KEYTAB_KADMIN = 'kadmin';
+
+    SKIP: {
+	skip ' no kadmin program test for Heimdal', 2
+	    if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal';
+
+	$Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file';
+	is ($object->destroy (@trace), undef,
+	    ' and destroying it with bad kadmin fails');
+	like ($object->error, qr{^cannot run /some/nonexistent/file: },
+	      ' with the right error');
+	$Wallet::Config::KEYTAB_KADMIN = 'kadmin';
+    }
+
     is ($object->flag_set ('locked', @trace), 1, ' and setting locked works');
     is ($object->destroy (@trace), undef, ' and destroying it fails');
     is ($object->error, "cannot destroy keytab:wallet/one: object is locked",
@@ -341,14 +395,6 @@ EOO
     is ($@, "keytab object implementation not configured\n",
         ' with the right error');
     $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm');
-    $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file';
-    $object = eval {
-        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
-      };
-    is ($object, undef, 'Cope with a failure to run kadmin');
-    like ($@, qr{^cannot run /some/nonexistent/file: },
-          ' with the right error');
-    $Wallet::Config::KEYTAB_KADMIN = 'kadmin';
 }
 
 # Tests for unchanging support.  Skip these if we don't have a keytab or if we
@@ -669,7 +715,8 @@ EOO
 
 # Tests for enctype restriction.
 SKIP: {
-    skip 'no keytab configuration', 36 unless -f 't/data/test.keytab';
+    skip 'no keytab configuration', 36 unless (-f 't/data/test.keytab' 
+        && $Wallet::Config::KEYTAB_KRBTYPE eq 'MIT');
 
     # Set up our configuration.
     $Wallet::Config::KEYTAB_FILE      = 't/data/test.keytab';
@@ -765,6 +812,7 @@ EOO
         ok (defined ($keytab), ' and retrieving the keytab still works');
         @values = enctypes ($keytab);
         is ("@values", $enctypes[0], ' and it has the right enctype');
+        ok (defined ($one), ' and recreating it succeeds');
         is ($one->attr ('enctypes', [ $enctypes[1] ], @trace), 1,
             'Setting a different single enctype works');
         @values = $one->attr ('enctypes');
@@ -773,6 +821,7 @@ EOO
         ok (defined ($keytab), ' and retrieving the keytab still works');
         @values = enctypes ($keytab);
         is ("@values", $enctypes[1], ' and it has the right enctype');
+        ok (defined ($one), ' and recreating it succeeds');
         is ($one->attr ('enctypes', [ @enctypes[0..1] ], @trace), 1,
             'Setting two enctypes works');
         @values = $one->attr ('enctypes');
-- 
cgit v1.2.3


From fc1dd4f5988c4ae932e26e92f0e7935e0fcaf2eb Mon Sep 17 00:00:00 2001
From: Jon Robertson <jonrober@stanford.edu>
Date: Thu, 17 Dec 2009 11:26:28 -0800
Subject: Added keytab testing cases for Heimdal KDC

Added cases to handle the Wallet::Object::Keytab module using a Heimdal
KDC as well as an MIT KDC.  In most cases this is transparent, but some
tests are skipped for Heimdal, and the commands run to test that the
created principals and keytabs are correct are different for Heimdal.
The code now branches based on the value of
$Wallet::Config::KEYTAB_KRBTYPE.
---
 perl/t/keytab.t | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

(limited to 'perl/t/keytab.t')

diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index 8a11ad4..5c9ee68 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -8,7 +8,7 @@
 # See LICENSE for licensing terms.
 
 use POSIX qw(strftime);
-use Test::More tests => 225;
+use Test::More tests => 221;
 
 use Wallet::Admin;
 use Wallet::Config;
@@ -154,8 +154,6 @@ sub enctypes {
 	    next unless /^ *\d+ /;
 	    my ($string) = /^\s*\d+\s+(\S+)/;
 	    next unless $string;
-	    #$enctype = $enctype{lc $string} || 'UNKNOWN';
-	    #push (@enctypes, $enctype);
 	    push (@enctypes, $string);
 	}
 	close KTUTIL;
-- 
cgit v1.2.3


From d684049761db4eb88cd936c530196ea89a524c07 Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Tue, 19 Jan 2010 22:48:01 -0800
Subject: Coding style fixes for Perl wallet code

Strip trailing whitespace, convert tabs to spaces, add newlines to
exceptions, and remove a few stray blank lines and a few other minor
coding style oddities.  Make the SQL style consistent.
---
 perl/Wallet/Admin.pm          | 105 +++++++++++++++----------------
 perl/Wallet/Kadmin.pm         |  10 +--
 perl/Wallet/Kadmin/Heimdal.pm | 102 ++++++++++++++----------------
 perl/Wallet/Kadmin/MIT.pm     |  32 +++++-----
 perl/Wallet/Object/Base.pm    |  12 ++--
 perl/Wallet/Object/Keytab.pm  |  13 ++--
 perl/t/admin.t                |   4 +-
 perl/t/keytab.t               | 140 ++++++++++++++++++++----------------------
 8 files changed, 198 insertions(+), 220 deletions(-)

(limited to 'perl/t/keytab.t')

diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm
index 0e437ec..701c813 100644
--- a/perl/Wallet/Admin.pm
+++ b/perl/Wallet/Admin.pm
@@ -114,23 +114,22 @@ sub destroy {
 # Reporting
 ##############################################################################
 
-# Given an ACL name, translate it to the ID for that ACL and return it.  
+# Given an ACL name, translate it to the ID for that ACL and return it.
 # Often this is unneeded and could be done with a join, but by doing it in a
-# separate step, we can give an error for the specific case of someone 
+# separate step, we can give an error for the specific case of someone
 # searching for a non-existant ACL.
 sub acl_name_to_id {
     my ($self, $acl) = @_;
     my ($id);
     eval {
-	my $sql = 'select ac_id from acls where ac_name=?';
-	my $sth = $self->{dbh}->prepare ($sql);
-	$sth->execute ($acl);
-	while (defined (my $row = $sth->fetchrow_hashref)) {
-	    $id = $row->{'ac_id'};
-	}
-	$self->{dbh}->commit;
+        my $sql = 'select ac_id from acls where ac_name = ?';
+        my $sth = $self->{dbh}->prepare ($sql);
+        $sth->execute ($acl);
+        while (defined (my $row = $sth->fetchrow_hashref)) {
+            $id = $row->{ac_id};
+        }
+        $self->{dbh}->commit;
     };
-    
     if (!defined $id || $id !~ /^\d+$/) {
         $self->error ("could not find the acl $acl");
         return '';
@@ -155,7 +154,7 @@ sub list_objects_type {
     return ($sql, $type);
 }
 
-# Return the SQL statement and search field required to find all objects 
+# Return the SQL statement and search field required to find all objects
 # owned by a given ACL.  If the requested owner is 'null', then we ignore
 # this and do a different search for IS NULL.  If the requested owner does
 # not actually match any ACLs, set an error and return the empty string.
@@ -163,15 +162,15 @@ sub list_objects_owner {
     my ($self, $owner) = @_;
     my ($sth);
     if ($owner =~ /^null$/i) {
-	my $sql = 'select ob_type, ob_name from objects where ob_owner is null
+        my $sql = 'select ob_type, ob_name from objects where ob_owner is null
             order by objects.ob_type, objects.ob_name';
-	return ($sql);
+        return ($sql);
     } else {
-	my $id = $self->acl_name_to_id ($owner);
-	return '' unless $id;
-	my $sql = 'select ob_type, ob_name from objects where ob_owner=?
+        my $id = $self->acl_name_to_id ($owner);
+        return '' unless $id;
+        my $sql = 'select ob_type, ob_name from objects where ob_owner = ?
             order by objects.ob_type, objects.ob_name';
-	return ($sql, $id);
+        return ($sql, $id);
     }
 }
 
@@ -180,26 +179,24 @@ sub list_objects_owner {
 sub list_objects_flag {
     my ($self, $flag) = @_;
     my $sql = 'select ob_type, ob_name from objects left join flags on
-        (objects.ob_type=flags.fl_type AND objects.ob_name=flags.fl_name)
-        where flags.fl_flag=? order by objects.ob_type, objects.ob_name';
+        (objects.ob_type = flags.fl_type and objects.ob_name = flags.fl_name)
+        where flags.fl_flag = ? order by objects.ob_type, objects.ob_name';
     return ($sql, $flag);
 }
 
-# Return the SQL statement and search field required to find all objects 
+# Return the SQL statement and search field required to find all objects
 # that a given ACL has any permissions on.  This expands from
 # list_objects_owner in that it will also match any records that have the ACL
 # set for get, store, show, destroy, or flags.  If the requested owner does
 # not actually match any ACLs, set an error and return the empty string.
 sub list_objects_acl {
     my ($self, $acl) = @_;
-
     my $id = $self->acl_name_to_id ($acl);
     return '' unless $id;
-
-    my $sql = 'select ob_type, ob_name from objects where
-        ob_owner=? or ob_acl_get=? or ob_acl_store=? or ob_acl_show=? or
-        ob_acl_destroy=? or ob_acl_flags=? 
-        order by objects.ob_type, objects.ob_name';
+    my $sql = 'select ob_type, ob_name from objects where ob_owner = ? or
+        ob_acl_get = ? or ob_acl_store = ? or ob_acl_show = ? or
+        ob_acl_destroy = ? or ob_acl_flags = ? order by objects.ob_type,
+        objects.ob_name';
     return ($sql, $id, $id, $id, $id, $id, $id);
 }
 
@@ -217,29 +214,29 @@ sub list_objects {
     my $sql = '';
     my @search = ();
     if (!defined $type || $type eq '') {
-	($sql) = $self->list_objects_all ();
+        ($sql) = $self->list_objects_all ();
     } else {
-	if (@args != 1) {
-	    $self->error ("object searches require an argument to search");
-	} elsif ($type eq 'type') {
-	    ($sql, @search) = $self->list_objects_type (@args);
-	} elsif ($type eq 'owner') {
-	    ($sql, @search) = $self->list_objects_owner (@args);
-	} elsif ($type eq 'flag') {
-	    ($sql, @search) = $self->list_objects_flag (@args);
-	} elsif ($type eq 'acl') {
-	    ($sql, @search) = $self->list_objects_acl (@args);
-	} else {
-	    $self->error ("do not know search type: $type");
-	}
-	return unless $sql;
+        if (@args != 1) {
+            $self->error ("object searches require an argument to search");
+        } elsif ($type eq 'type') {
+            ($sql, @search) = $self->list_objects_type (@args);
+        } elsif ($type eq 'owner') {
+            ($sql, @search) = $self->list_objects_owner (@args);
+        } elsif ($type eq 'flag') {
+            ($sql, @search) = $self->list_objects_flag (@args);
+        } elsif ($type eq 'acl') {
+            ($sql, @search) = $self->list_objects_acl (@args);
+        } else {
+            $self->error ("do not know search type: $type");
+        }
+        return unless $sql;
     }
 
     my @objects;
     eval {
         my $object;
-	my $sth = $self->{dbh}->prepare ($sql);
-	$sth->execute (@search);
+        my $sth = $self->{dbh}->prepare ($sql);
+        $sth->execute (@search);
         while (defined ($object = $sth->fetchrow_arrayref)) {
             push (@objects, [ @$object ]);
         }
@@ -265,19 +262,19 @@ sub list_acls_all {
 # the db.
 sub list_acls_empty {
     my ($self) = @_;
-    my $sql = 'select ac_id, ac_name from acls left join acl_entries '
-	.'on (acls.ac_id=acl_entries.ae_id) where ae_id is null;';
+    my $sql = 'select ac_id, ac_name from acls left join acl_entries
+        on (acls.ac_id = acl_entries.ae_id) where ae_id is null';
     return ($sql);
 }
 
 # Returns the SQL statement and the field required to search the ACLs and
-# return only those entries which contain a entries with identifiers 
+# return only those entries which contain a entries with identifiers
 # matching a particular given string.
 sub list_acls_entry {
     my ($self, $type, $identifier) = @_;
-    my $sql = 'select distinct ac_id, ac_name from acl_entries 
-        left join acls on (ae_id=ac_id) where ae_scheme=? and 
-        ae_identifier like ? order by ac_id';
+    my $sql = 'select distinct ac_id, ac_name from acl_entries left join acls
+        on (ae_id = ac_id) where ae_scheme = ? and ae_identifier like ? order
+        by ac_id';
     $identifier = '%'.$identifier.'%';
     return ($sql, $type, $identifier);
 }
@@ -299,11 +296,11 @@ sub list_acls {
         ($sql) = $self->list_acls_all ();
     } else {
         if ($type eq 'entry') {
-	    if (@args == 0) {
-		$self->error ("acl searches require an argument to search");
-	    } else {
-		($sql, @search) = $self->list_acls_entry (@args);
-	    }
+            if (@args == 0) {
+                $self->error ("acl searches require an argument to search");
+            } else {
+                ($sql, @search) = $self->list_acls_entry (@args);
+            }
         } elsif ($type eq 'empty') {
             ($sql) = $self->list_acls_empty ();
         } else {
diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm
index 33c84a1..200136c 100644
--- a/perl/Wallet/Kadmin.pm
+++ b/perl/Wallet/Kadmin.pm
@@ -27,8 +27,8 @@ $VERSION = '0.02';
 ##############################################################################
 
 # Validate a principal with a submodule's validator.  We can also do this via
-# creating an object with new and then running valid_principal from that, 
-# but there are times we might wish to run it without going through the 
+# creating an object with new and then running valid_principal from that,
+# but there are times we might wish to run it without going through the
 # object creation.
 sub valid_principal {
     my ($class, $principal) = @_;
@@ -48,10 +48,10 @@ sub new {
     my ($class) = @_;
     my ($kadmin);
     if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
-	require Wallet::Kadmin::MIT;
+        require Wallet::Kadmin::MIT;
         $kadmin = Wallet::Kadmin::MIT->new ();
     } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
-	require Wallet::Kadmin::Heimdal;
+        require Wallet::Kadmin::Heimdal;
         $kadmin = Wallet::Kadmin::Heimdal->new ();
     } else {
         die "keytab krb server type not set to a valid value\n";
@@ -82,7 +82,7 @@ Wallet::Kadmin - Kadmin module wrapper for wallet keytabs
 =head1 DESCRIPTION
 
 Wallet::Kadmin is a wrapper to modules that provide an interface for keytab
-integration with the wallet.  Each module is meant to interface with a 
+integration with the wallet.  Each module is meant to interface with a
 specific type of Kerberos implementation, such as MIT Kerberos or Heimdal
 Kerberos, and provide a standndard set of API calls used to interact with
 that implementation's kadmind.
diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm
index e4d175b..a8859bf 100644
--- a/perl/Wallet/Kadmin/Heimdal.pm
+++ b/perl/Wallet/Kadmin/Heimdal.pm
@@ -15,8 +15,7 @@ require 5.006;
 use strict;
 use vars qw($VERSION);
 
-use Heimdal::Kadm5 qw (KRB5_KDB_DISALLOW_ALL_TIX);
-
+use Heimdal::Kadm5 qw(KRB5_KDB_DISALLOW_ALL_TIX);
 use Wallet::Config ();
 
 # This version should be increased on any code change to this module.  Always
@@ -37,7 +36,7 @@ sub valid_principal {
     return scalar ($principal =~ m,^[\w-]+(/[\w_.-]+)?\z,);
 }
 
-# Create a Heimdal::Kadm5 client object and return it.  It should load 
+# Create a Heimdal::Kadm5 client object and return it.  It should load
 # configuration from Wallet::Config.
 sub kadmin_client {
     unless (defined ($Wallet::Config::KEYTAB_PRINCIPAL)
@@ -45,15 +44,13 @@ sub kadmin_client {
             and defined ($Wallet::Config::KEYTAB_REALM)) {
         die "keytab object implementation not configured\n";
     }
-
     my $server = $Wallet::Config::KEYTAB_HOST || 'localhost';
-    my $client = Heimdal::Kadm5::Client->new(
-        RaiseErrors => 1,
-        Server      => $server,
-        Principal   => $Wallet::Config::KEYTAB_PRINCIPAL,
-        Realm       => $Wallet::Config::KEYTAB_REALM,
-        Keytab      => $Wallet::Config::KEYTAB_FILE,
-        );
+    my @options = (RaiseErrors => 1,
+                   Server      => $server,
+                   Principal   => $Wallet::Config::KEYTAB_PRINCIPAL,
+                   Realm       => $Wallet::Config::KEYTAB_REALM,
+                   Keytab      => $Wallet::Config::KEYTAB_FILE);
+    my $client = Heimdal::Kadm5::Client->new (@options);
     return $client;
 }
 
@@ -70,16 +67,8 @@ sub exists {
         $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
     }
     my $kadmin = $self->{client};
-    my $princdata = eval { $kadmin->getPrincipal ($principal) };
-
-    if ($@) {
-	die $@;
-	return 0;
-    } elsif ($princdata) { 
-	return 1;
-    } else {
-	return 0;
-    }
+    my $princdata = $kadmin->getPrincipal ($principal);
+    return $princdata ? 1 : 0;
 }
 
 # Create a principal in Kerberos.  Since this is only called by create, it
@@ -95,7 +84,7 @@ sub addprinc {
     if ($Wallet::Config::KEYTAB_REALM) {
         $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
     }
-    die "error adding principal $principal: $@" if $@;
+    die "error adding principal $principal: $@\n" if $@;
     return 1 if $exists;
 
     # The way Heimdal::Kadm5 works, we create a principal object, create the
@@ -106,20 +95,19 @@ sub addprinc {
     my $kadmin = $self->{client};
     my $princdata = $kadmin->makePrincipal ($principal);
 
-    # Disable the principal before creating, until we've randomized the 
+    # Disable the principal before creating, until we've randomized the
     # password.
     my $attrs = $princdata->getAttributes;
     $attrs |= KRB5_KDB_DISALLOW_ALL_TIX;
     $princdata->setAttributes ($attrs);
 
     my $password = 'inactive';
-    my $retval = eval { $kadmin->createPrincipal ($princdata, $password, 0) };
-    die "error adding principal $principal: $@" if $@;
-    $retval = eval { $kadmin->randKeyPrincipal ($principal) };
-    die "error adding principal $principal: $@" if $@;
-    $retval = eval { $kadmin->enablePrincipal ($principal) };
+    eval {
+        $kadmin->createPrincipal ($princdata, $password, 0);
+        $kadmin->randKeyPrincipal ($principal);
+        $kadmin->enablePrincipal ($principal);
+    };
     die "error adding principal $principal: $@" if $@;
-
     return 1;
 }
 
@@ -130,7 +118,7 @@ sub addprinc {
 sub ktadd {
     my ($self, $principal, $file, @enctypes) = @_;
     unless ($self->valid_principal ($principal)) {
-        die ("invalid principal name: $principal");
+        die "invalid principal name: $principal\n";
     }
     if ($Wallet::Config::KEYTAB_REALM) {
         $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
@@ -138,35 +126,35 @@ sub ktadd {
 
     # The way Heimdal works, you can only remove enctypes from a principal,
     # not add them back in.  So we need to run randkeyPrincipal first each
-    # time to restore all possible enctypes and then whittle them back down 
+    # time to restore all possible enctypes and then whittle them back down
     # to those we have been asked for this time.
     my $kadmin = $self->{client};
     eval { $kadmin->randKeyPrincipal ($principal) };
-    die "error creating keytab for $principal: could not reinit enctypes: $@" 
+    die "error creating keytab for $principal: could not reinit enctypes: $@\n"
         if $@;
     my $princdata = eval { $kadmin->getPrincipal ($principal) };
     if ($@) {
-	die "error creating keytab for $principal: $@";
+        die "error creating keytab for $principal: $@\n";
     } elsif (!$princdata) {
-	die "error creating keytab for $principal: principal does not exist";
+        die "error creating keytab for $principal: principal does not exist\n";
     }
 
     # 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];
-	    next if exists $wanted{$keytype};
-	    eval { $princdata->delKeytypes ($keytype) };
-	    die "error removing keytype $keytype from the keytab: $@" if $@;
-	}
-	eval { $kadmin->modifyPrincipal ($princdata) };
+        my (%wanted);
+        my $alltypes = $princdata->getKeytypes ();
+        foreach (@enctypes) { $wanted{$_} = 1 }
+        foreach my $key (@{$alltypes}) {
+            my $keytype = ${$key}[0];
+            next if exists $wanted{$keytype};
+            eval { $princdata->delKeytypes ($keytype) };
+            die "error removing keytype $keytype from the keytab: $@\n" if $@;
+        }
+        eval { $kadmin->modifyPrincipal ($princdata) };
     }
 
     eval { $kadmin->extractKeytab ($princdata, $file) };
-    die "error creating keytab for principal: $@" if $@;
+    die "error creating keytab for principal: $@\n" if $@;
 
     return 1;
 }
@@ -177,7 +165,7 @@ sub ktadd {
 sub delprinc {
     my ($self, $principal) = @_;
     unless ($self->valid_principal ($principal)) {
-        die ("invalid principal name: $principal");
+        die "invalid principal name: $principal\n";
     }
     my $exists = eval { $self->exists ($principal) };
     die $@ if $@;
@@ -190,7 +178,7 @@ sub delprinc {
 
     my $kadmin = $self->{client};
     my $retval = eval { $kadmin->deletePrincipal ($principal) };
-    die "error deleting $principal: $@" if $@;
+    die "error deleting $principal: $@\n" if $@;
     return 1;
 }
 
@@ -199,12 +187,12 @@ sub delprinc {
 ##############################################################################
 
 # 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 
+# will probably fill out if we go to using a module rather than calling
 # kadmin directly.
 sub new {
     my ($class) = @_;
     my $self = {
-	client => kadmin_client (),
+        client => kadmin_client (),
     };
     bless ($self, $class);
     return $self;
@@ -235,7 +223,7 @@ Wallet::Kadmin::MIT is an interface for keytab integration with the wallet,
 specifically for using kadmin to create, delete, and add enctypes to keytabs.
 It implments the wallet kadmin API and provides the necessary glue to MIT
 Kerberos installs for each of these functions, while allowing the wallet
-to keep the details of what type of Kerberos installation is being used 
+to keep the details of what type of Kerberos installation is being used
 abstracted.
 
 A keytab is an on-disk store for the key or keys for a Kerberos principal.
@@ -254,15 +242,15 @@ information about how to set wallet configuration.
 
 =item addprinc(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 
+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, or throws an error if there was a failure in adding the principal.
-If the principal already exists, return true as we are bringing our 
+If the principal already exists, return true as we are bringing our
 expectations in line with reality.
 
 =item addprinc(PRINCIPAL)
 
-Removes a principal with the given name.  Returns true on success, or throws 
+Removes a principal with the given name.  Returns true on success, or throws
 an error if there was a failure in removing the principal.  If the principal
 does not exist, return true as we are bringing our expectations in line with
 reality.
@@ -270,8 +258,8 @@ reality.
 =item ktadd(PRINCIPAL, FILE, ENCTYPES)
 
 Creates a new keytab for the given principal, as the given file, limited to
-the enctypes supplied.  The enctype values must be enctype strings recognized 
-by Kerberos (strings like C<aes256-cts> or C<des-cbc-crc>).  An error is 
+the enctypes supplied.  The enctype values must be enctype strings recognized
+by Kerberos (strings like C<aes256-cts> or C<des-cbc-crc>).  An error is
 thrown on failure or if the creation fails, otherwise true is returned.
 
 =back
@@ -279,7 +267,7 @@ thrown on failure or if the creation fails, otherwise true is returned.
 =head1 LIMITATIONS
 
 Currently, this implementation calls an external B<kadmin> program rather
- than using a native Perl module and therefore requires B<kadmin> be 
+ than using a native Perl module and therefore requires B<kadmin> be
 installed and parses its output.  It may miss some error conditions if the
 output of B<kadmin> ever changes.
 
diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm
index b7d4913..7bbb248 100644
--- a/perl/Wallet/Kadmin/MIT.pm
+++ b/perl/Wallet/Kadmin/MIT.pm
@@ -130,7 +130,7 @@ sub addprinc {
 sub ktadd {
     my ($self, $principal, $file, @enctypes) = @_;
     unless ($self->valid_principal ($principal)) {
-        die ("invalid principal name: $principal");
+        die "invalid principal name: $principal\n";
     }
     if ($Wallet::Config::KEYTAB_REALM) {
         $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
@@ -143,7 +143,7 @@ sub ktadd {
     my $output = eval { $self->kadmin ("$command $principal") };
     die ($@) if ($@);
     if ($output =~ /^(?:kadmin|ktadd): (.*)/m) {
-        die ("error creating keytab for $principal: $1");
+        die "error creating keytab for $principal: $1\n";
     }
     return 1;
 }
@@ -154,7 +154,7 @@ sub ktadd {
 sub delprinc {
     my ($self, $principal) = @_;
     unless ($self->valid_principal ($principal)) {
-        die ("invalid principal name: $principal");
+        die "invalid principal name: $principal\n";
     }
     my $exists = eval { $self->exists ($principal) };
     die $@ if $@;
@@ -167,7 +167,7 @@ sub delprinc {
     my $output = eval { $self->kadmin ("delprinc -force $principal") };
     die $@ if $@;
     if ($output =~ /^delete_principal: (.*)/m) {
-        die ("error deleting $principal: $1");
+        die "error deleting $principal: $1\n";
     }
     return 1;
 }
@@ -177,12 +177,11 @@ sub delprinc {
 ##############################################################################
 
 # 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 
+# will probably fill out if we go to using a module rather than calling
 # kadmin directly.
 sub new {
     my ($class) = @_;
-    my $self = {
-    };
+    my $self = {};
     bless ($self, $class);
     return $self;
 }
@@ -212,7 +211,7 @@ Wallet::Kadmin::MIT is an interface for keytab integration with the wallet,
 specifically for using kadmin to create, delete, and add enctypes to keytabs.
 It implments the wallet kadmin API and provides the necessary glue to MIT
 Kerberos installs for each of these functions, while allowing the wallet
-to keep the details of what type of Kerberos installation is being used 
+to keep the details of what type of Kerberos installation is being used
 abstracted.
 
 A keytab is an on-disk store for the key or keys for a Kerberos principal.
@@ -231,15 +230,15 @@ information about how to set wallet configuration.
 
 =item addprinc(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 
+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, or throws an error if there was a failure in adding the principal.
-If the principal already exists, return true as we are bringing our 
+If the principal already exists, return true as we are bringing our
 expectations in line with reality.
 
 =item addprinc(PRINCIPAL)
 
-Removes a principal with the given name.  Returns true on success, or throws 
+Removes a principal with the given name.  Returns true on success, or throws
 an error if there was a failure in removing the principal.  If the principal
 does not exist, return true as we are bringing our expectations in line with
 reality.
@@ -247,8 +246,8 @@ reality.
 =item ktadd(PRINCIPAL, FILE, ENCTYPES)
 
 Creates a new keytab for the given principal, as the given file, limited to
-the enctypes supplied.  The enctype values must be enctype strings recognized 
-by Kerberos (strings like C<aes256-cts> or C<des-cbc-crc>).  An error is 
+the enctypes supplied.  The enctype values must be enctype strings recognized
+by Kerberos (strings like C<aes256-cts> or C<des-cbc-crc>).  An error is
 thrown on failure or if the creation fails, otherwise true is returned.
 
 =back
@@ -256,7 +255,7 @@ thrown on failure or if the creation fails, otherwise true is returned.
 =head1 LIMITATIONS
 
 Currently, this implementation calls an external B<kadmin> program rather
- than using a native Perl module and therefore requires B<kadmin> be 
+than using a native Perl module and therefore requires B<kadmin> be
 installed and parses its output.  It may miss some error conditions if the
 output of B<kadmin> ever changes.
 
@@ -269,7 +268,6 @@ from L<http://www.eyrie.org/~eagle/software/wallet/>.
 
 =head1 AUTHORS
 
-Russ Allbery <rra@stanford.edu>
-Jon Robertson <jonrober@stanford.edu>
+Russ Allbery <rra@stanford.edu> and Jon Robertson <jonrober@stanford.edu>.
 
 =cut
diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm
index f2568eb..fea0320 100644
--- a/perl/Wallet/Object/Base.pm
+++ b/perl/Wallet/Object/Base.pm
@@ -445,7 +445,7 @@ sub flag_set {
 # History
 ##############################################################################
 
-# Expand a given ACL id to add its name, for readability.  Returns the 
+# Expand a given ACL id to add its name, for readability.  Returns the
 # original id alone if there was a problem finding the name.
 sub format_acl_id {
     my ($self, $id) = @_;
@@ -455,7 +455,7 @@ sub format_acl_id {
     my $sth = $self->{dbh}->prepare ($sql);
     $sth->execute ($id);
     if (my @ref = $sth->fetchrow_array) {
-	$name = $ref[0] . " ($id)";
+        $name = $ref[0] . " ($id)";
     }
 
     return $name;
@@ -492,11 +492,11 @@ sub history {
                 } elsif (defined ($new)) {
                     $output .= "add $new to attribute $attr";
                 }
-            } elsif ($data[0] eq 'set' 
-		     and ($data[1] eq 'owner' or $data[1] =~ /^acl_/)) {
+            } elsif ($data[0] eq 'set'
+                     and ($data[1] eq 'owner' or $data[1] =~ /^acl_/)) {
                 my $field = $data[1];
-		$old = $self->format_acl_id ($old) if defined ($old);
-		$new = $self->format_acl_id ($new) if defined ($new);
+                $old = $self->format_acl_id ($old) if defined ($old);
+                $new = $self->format_acl_id ($new) if defined ($new);
                 if (defined ($old) and defined ($new)) {
                     $output .= "set $field to $new (was $old)";
                 } elsif (defined ($new)) {
diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm
index b1c9d6d..a361599 100644
--- a/perl/Wallet/Object/Keytab.pm
+++ b/perl/Wallet/Object/Keytab.pm
@@ -1,7 +1,7 @@
 # Wallet::Object::Keytab -- Keytab object implementation for the wallet.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2009 Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
@@ -477,15 +477,14 @@ sub new {
 # caller.
 sub create {
     my ($class, $type, $name, $dbh, $creator, $host, $time) = @_;
-    my $self = { 
-	dbh    => $dbh,
-	kadmin => undef,
+    my $self = {
+        dbh    => $dbh,
+        kadmin => undef,
     };
     bless $self, $class;
     my $kadmin = Wallet::Kadmin->new ();
     $self->{kadmin} = $kadmin;
     $kadmin->addprinc ($name);
-    
     $self = $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time);
     $self->{kadmin} = $kadmin;
     return $self;
@@ -556,8 +555,8 @@ sub get {
     my $kadmin = $self->{kadmin};
     my $retval = eval { $kadmin->ktadd ($self->{name}, $file, @enctypes) };
     if ($@) {
-	$self->error ($@);
-	return;
+        $self->error ($@);
+        return;
     }
     return unless $retval;
     local *KEYTAB;
diff --git a/perl/t/admin.t b/perl/t/admin.t
index 77c786d..e963857 100755
--- a/perl/t/admin.t
+++ b/perl/t/admin.t
@@ -120,7 +120,7 @@ is ($lines[2][1], 'admin@EXAMPLE.COM', ' and the right identifier');
 # owned by ADMIN or with any permissions from it.
 is ($server->create ('base', 'service/null'), 1,
     'Creating base:service/null succeeds');
-is ($server->acl ('base', 'service/foo', 'get', 'ADMIN'), 1, 
+is ($server->acl ('base', 'service/foo', 'get', 'ADMIN'), 1,
     'Changing the get ACL for the search also does');
 @lines = $admin->list_objects ('owner', 'ADMIN');
 is (scalar (@lines), 1, 'Searching for objects owned by ADMIN finds one');
@@ -150,7 +150,7 @@ is ($lines[2][1], 'service/null', ' and the right name');
 is (scalar (@lines), 0, 'Searching for all objects of type keytab finds none');
 
 # Test setting a flag, searching for objects with it, and then clearing it.
-is ($server->flag_set ('base', 'service/admin', 'unchanging'), 1, 
+is ($server->flag_set ('base', 'service/admin', 'unchanging'), 1,
     'Setting a flag works');
 @lines = $admin->list_objects ('flag', 'unchanging');
 is (scalar (@lines), 1, 'Searching for all objects with that flag finds one');
diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index 5c9ee68..3cd77d8 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -8,7 +8,7 @@
 # See LICENSE for licensing terms.
 
 use POSIX qw(strftime);
-use Test::More tests => 221;
+use Test::More tests => 219;
 
 use Wallet::Admin;
 use Wallet::Config;
@@ -57,15 +57,15 @@ sub system_quiet {
 sub create {
     my ($principal) = @_;
     if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
-	my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k',
-		    '-t', $Wallet::Config::KEYTAB_FILE,
-		    '-r', $Wallet::Config::KEYTAB_REALM,
-		    '-q', "addprinc -clearpolicy -randkey $principal");
+        my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k',
+                    '-t', $Wallet::Config::KEYTAB_FILE,
+                    '-r', $Wallet::Config::KEYTAB_REALM,
+                    '-q', "addprinc -clearpolicy -randkey $principal");
     } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
-	@args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL,
-		 '-K', $Wallet::Config::KEYTAB_FILE,
-		 '-r', $Wallet::Config::KEYTAB_REALM,
-		 'add', $principal);
+        @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL,
+                 '-K', $Wallet::Config::KEYTAB_FILE,
+                 '-r', $Wallet::Config::KEYTAB_REALM,
+                 'add', $principal);
     }
     system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args);
 }
@@ -76,15 +76,15 @@ sub destroy {
     my ($principal) = @_;
     my (@args);
     if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
-	@args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k',
-		 '-t', $Wallet::Config::KEYTAB_FILE,
-		 '-r', $Wallet::Config::KEYTAB_REALM,
-		 '-q', "delprinc -force $principal");
+        @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k',
+                 '-t', $Wallet::Config::KEYTAB_FILE,
+                 '-r', $Wallet::Config::KEYTAB_REALM,
+                 '-q', "delprinc -force $principal");
     } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
-	@args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL,
-		 '-K', $Wallet::Config::KEYTAB_FILE,
-		 '-r', $Wallet::Config::KEYTAB_REALM,
-		 'delete', $principal);
+        @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL,
+                 '-K', $Wallet::Config::KEYTAB_FILE,
+                 '-r', $Wallet::Config::KEYTAB_REALM,
+                 'delete', $principal);
     }
     system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args);
 }
@@ -95,15 +95,15 @@ sub created {
     my ($principal) = @_;
     $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
     if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
-	local $ENV{KRB5CCNAME} = 'krb5cc_temp';
-	getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL);
-	return (system_quiet ('kvno', $principal) == 0);
+        local $ENV{KRB5CCNAME} = 'krb5cc_temp';
+        getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL);
+        return (system_quiet ('kvno', $principal) == 0);
     } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
-	@args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL,
-		 '-K', $Wallet::Config::KEYTAB_FILE,
-		 '-r', $Wallet::Config::KEYTAB_REALM,
-		 'get', $principal);
-	return (system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args) == 0);
+        @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL,
+                 '-K', $Wallet::Config::KEYTAB_FILE,
+                 '-r', $Wallet::Config::KEYTAB_REALM,
+                 'get', $principal);
+        return (system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args) == 0);
     }
 }
 
@@ -135,28 +135,28 @@ sub enctypes {
 
     my @enctypes;
     if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
-	open (KLIST, '-|', 'klist', '-ke', 'keytab')
-	    or die "cannot run klist: $!\n";
-	local $_;
-	while (<KLIST>) {
-	    next unless /^ *\d+ /;
-	    my ($string) = /\((.*)\)\s*$/;
-	    next unless $string;
-	    $enctype = $enctype{lc $string} || 'UNKNOWN';
-	    push (@enctypes, $enctype);
-	}
-	close KLIST;
+        open (KLIST, '-|', 'klist', '-ke', 'keytab')
+            or die "cannot run klist: $!\n";
+        local $_;
+        while (<KLIST>) {
+            next unless /^ *\d+ /;
+            my ($string) = /\((.*)\)\s*$/;
+            next unless $string;
+            $enctype = $enctype{lc $string} || 'UNKNOWN';
+            push (@enctypes, $enctype);
+        }
+        close KLIST;
     } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
-	open (KTUTIL, '-|', 'ktutil', '-k', 'keytab', 'list')
-	    or die "cannot run ktutil: $!\n";
-	local $_;
-	while (<KTUTIL>) {
-	    next unless /^ *\d+ /;
-	    my ($string) = /^\s*\d+\s+(\S+)/;
-	    next unless $string;
-	    push (@enctypes, $string);
-	}
-	close KTUTIL;
+        open (KTUTIL, '-|', 'ktutil', '-k', 'keytab', 'list')
+            or die "cannot run ktutil: $!\n";
+        local $_;
+        while (<KTUTIL>) {
+            next unless /^ *\d+ /;
+            my ($string) = /^\s*\d+\s+(\S+)/;
+            next unless $string;
+            push (@enctypes, $string);
+        }
+        close KTUTIL;
     }
     unlink 'keytab';
     return sort @enctypes;
@@ -298,16 +298,15 @@ EOO
     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';
-
-	$Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file';
-	$data = $object->get (@trace);
-	is ($data, undef, 'Cope with a failure to run kadmin');
-	like ($object->error, qr{^cannot run /some/nonexistent/file: },
-	      ' with the right error');
-	$Wallet::Config::KEYTAB_KADMIN = 'kadmin';
+  SKIP: {
+        skip 'no kadmin program test for Heimdal', 2
+            if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal';
+        $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file';
+        $data = $object->get (@trace);
+        is ($data, undef, 'Cope with a failure to run kadmin');
+        like ($object->error, qr{^cannot run /some/nonexistent/file: },
+              ' with the right error');
+        $Wallet::Config::KEYTAB_KADMIN = 'kadmin';
     }
     destroy ('wallet/one');
     $data = $object->get (@trace);
@@ -323,19 +322,16 @@ EOO
       };
     ok (defined ($object), 'Creating good principal succeeds');
     ok (created ('wallet/one'), ' and the principal was created');
-
-    SKIP: {
-	skip ' no kadmin program test for Heimdal', 2
-	    if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal';
-
-	$Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file';
-	is ($object->destroy (@trace), undef,
-	    ' and destroying it with bad kadmin fails');
-	like ($object->error, qr{^cannot run /some/nonexistent/file: },
-	      ' with the right error');
-	$Wallet::Config::KEYTAB_KADMIN = 'kadmin';
+  SKIP: {
+        skip 'no kadmin program test for Heimdal', 2
+            if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal';
+        $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file';
+        is ($object->destroy (@trace), undef,
+            ' and destroying it with bad kadmin fails');
+        like ($object->error, qr{^cannot run /some/nonexistent/file: },
+              ' with the right error');
+        $Wallet::Config::KEYTAB_KADMIN = 'kadmin';
     }
-
     is ($object->flag_set ('locked', @trace), 1, ' and setting locked works');
     is ($object->destroy (@trace), undef, ' and destroying it fails');
     is ($object->error, "cannot destroy keytab:wallet/one: object is locked",
@@ -713,8 +709,10 @@ EOO
 
 # Tests for enctype restriction.
 SKIP: {
-    skip 'no keytab configuration', 36 unless (-f 't/data/test.keytab' 
-        && $Wallet::Config::KEYTAB_KRBTYPE eq 'MIT');
+    unless (-f 't/data/test.keytab'
+            && $Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
+        skip 'no keytab configuration', 36;
+    }
 
     # Set up our configuration.
     $Wallet::Config::KEYTAB_FILE      = 't/data/test.keytab';
@@ -810,7 +808,6 @@ EOO
         ok (defined ($keytab), ' and retrieving the keytab still works');
         @values = enctypes ($keytab);
         is ("@values", $enctypes[0], ' and it has the right enctype');
-        ok (defined ($one), ' and recreating it succeeds');
         is ($one->attr ('enctypes', [ $enctypes[1] ], @trace), 1,
             'Setting a different single enctype works');
         @values = $one->attr ('enctypes');
@@ -819,7 +816,6 @@ EOO
         ok (defined ($keytab), ' and retrieving the keytab still works');
         @values = enctypes ($keytab);
         is ("@values", $enctypes[1], ' and it has the right enctype');
-        ok (defined ($one), ' and recreating it succeeds');
         is ($one->attr ('enctypes', [ @enctypes[0..1] ], @trace), 1,
             'Setting two enctypes works');
         @values = $one->attr ('enctypes');
-- 
cgit v1.2.3


From 854063db2095fac8079260b414714d239221fdff Mon Sep 17 00:00:00 2001
From: Jon Robertson <jonrober@stanford.edu>
Date: Thu, 21 Jan 2010 20:53:20 -0800
Subject: Removed valid_principal as a Kadmin API function

valid_principal has been removed from Wallet::Kadmin and
Wallet::Kadmin::Heimdal.  An accessor for it in Wallet::Object::Keytab
has also been removed, as have the tests in perl/t/keytab.t for the
function.  It still remains within Wallet::Kadmin::MIT and is used there,
but only as a private method for flagging what the kadmin command-line
interface cannot handle.
---
 perl/Wallet/Kadmin.pm         | 26 +-------------------------
 perl/Wallet/Kadmin/Heimdal.pm | 21 +--------------------
 perl/Wallet/Object/Keytab.pm  |  9 +--------
 perl/t/keytab.t               | 28 +++++++++++++---------------
 4 files changed, 16 insertions(+), 68 deletions(-)

(limited to 'perl/t/keytab.t')

diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm
index 0a9bd43..95859a9 100644
--- a/perl/Wallet/Kadmin.pm
+++ b/perl/Wallet/Kadmin.pm
@@ -20,27 +20,12 @@ 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';
 
 ##############################################################################
 # Public methods
 ##############################################################################
 
-# Validate a principal with a submodule's validator.  We can also do this via
-# creating an object with new and then running valid_principal from that,
-# but there are times we might wish to run it without going through the
-# object creation.
-sub valid_principal {
-    my ($class, $principal) = @_;
-    if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
-        require Wallet::Kadmin::MIT;
-        return Wallet::Kadmin::MIT->valid_principal ($principal);
-    } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
-        require Wallet::Kadmin::Heimdal;
-        return Wallet::Kadmin::Heimdal->valid_principal ($principal);
-    }
-}
-
 # Create a new kadmin object, by finding the type requested in the wallet
 # config and passing off to the proper module.  Returns the object directly
 # from the specific Wallet::Kadmin::* module.
@@ -111,15 +96,6 @@ Finds the proper Kerberos implementation and calls the new() constructor for
 that implementation's module, returning the result.  If the implementation
 is not recognized or set, die with an error message.
 
-=item valid_principal(PRINCIPAL)
-
-Finds the proper Kerberos implementation and calls its own valid_principal
-method, returning the result.  This tells whether a principal is valid for
-that implementation.  This can be achieved by using new() and then directly
-calling valid_principal on the returned object -- this method is a shortcut
-in case we want to check validity without creating the object and worrying
-about proper setup.
-
 =back
 
 =head1 SEE ALSO
diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm
index a8859bf..a05362e 100644
--- a/perl/Wallet/Kadmin/Heimdal.pm
+++ b/perl/Wallet/Kadmin/Heimdal.pm
@@ -21,21 +21,12 @@ 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.01';
+$VERSION = '0.02';
 
 ##############################################################################
 # kadmin Interaction
 ##############################################################################
 
-# Make sure that principals are well-formed and don't contain characters that
-# will cause us problems when talking to kadmin.  Takes a principal and
-# returns true if it's okay, false otherwise.  Note that we do not permit
-# realm information here.
-sub valid_principal {
-    my ($self, $principal) = @_;
-    return scalar ($principal =~ m,^[\w-]+(/[\w_.-]+)?\z,);
-}
-
 # Create a Heimdal::Kadm5 client object and return it.  It should load
 # configuration from Wallet::Config.
 sub kadmin_client {
@@ -62,7 +53,6 @@ sub kadmin_client {
 # so, false otherwise.  Throws an exception if an error.
 sub exists {
     my ($self, $principal) = @_;
-    return unless $self->valid_principal ($principal);
     if ($Wallet::Config::KEYTAB_REALM) {
         $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
     }
@@ -76,9 +66,6 @@ sub exists {
 # undef.
 sub addprinc {
     my ($self, $principal) = @_;
-    unless ($self->valid_principal ($principal)) {
-        die "invalid principal name $principal\n";
-    }
 
     my $exists = eval { $self->exists ($principal) };
     if ($Wallet::Config::KEYTAB_REALM) {
@@ -117,9 +104,6 @@ sub addprinc {
 # error.
 sub ktadd {
     my ($self, $principal, $file, @enctypes) = @_;
-    unless ($self->valid_principal ($principal)) {
-        die "invalid principal name: $principal\n";
-    }
     if ($Wallet::Config::KEYTAB_REALM) {
         $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
     }
@@ -164,9 +148,6 @@ sub ktadd {
 # exist, return success; we're bringing reality in line with our expectations.
 sub delprinc {
     my ($self, $principal) = @_;
-    unless ($self->valid_principal ($principal)) {
-        die "invalid principal name: $principal\n";
-    }
     my $exists = eval { $self->exists ($principal) };
     die $@ if $@;
     if (not $exists) {
diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm
index a361599..092e973 100644
--- a/perl/Wallet/Object/Keytab.pm
+++ b/perl/Wallet/Object/Keytab.pm
@@ -24,7 +24,7 @@ use Wallet::Kadmin;
 # 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.06';
+$VERSION = '0.07';
 
 ##############################################################################
 # AFS kaserver synchronization
@@ -490,13 +490,6 @@ sub create {
     return $self;
 }
 
-# Provides wrapper to individual Kadmin class's valid_principal.  Here only
-# to help expose for testing.
-sub valid_principal {
-    my ($self, $principal) = @_;
-    return Wallet::Kadmin->valid_principal ($principal);
-}
-
 # Override destroy to delete the principal out of Kerberos as well.
 sub destroy {
     my ($self, $user, $host, $time) = @_;
diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index 3cd77d8..7745290 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -8,7 +8,8 @@
 # See LICENSE for licensing terms.
 
 use POSIX qw(strftime);
-use Test::More tests => 219;
+use Test::More tests => 208
+;
 
 use Wallet::Admin;
 use Wallet::Config;
@@ -192,18 +193,6 @@ my $dbh = $admin->dbh;
 my $history = '';
 my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]);
 
-# Do some white-box testing of the principal validation regex.
-for my $bad (qw{service\* = host/foo+bar host/foo/bar /bar bar/
-                rcmd.foo}) {
-    ok (! Wallet::Object::Keytab->valid_principal ($bad),
-        "Invalid principal name $bad");
-}
-for my $good (qw{service service/foo bar foo/bar host/example.org
-                 aservice/foo}) {
-    ok (Wallet::Object::Keytab->valid_principal ($good),
-        "Valid principal name $good");
-}
-
 # Basic keytab creation and manipulation tests.
 SKIP: {
     skip 'no keytab configuration', 49 unless -f 't/data/test.keytab';
@@ -228,12 +217,21 @@ SKIP: {
         Wallet::Object::Keytab->create ('keytab', "wallet\nf", $dbh, @trace)
       };
     is ($object, undef, 'Creating malformed principal fails');
-    is ($@, "invalid principal name wallet\nf\n", ' with the right error');
+    if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
+        is ($@, "invalid principal name wallet\nf\n", ' with the right error');
+    } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
+        like ($@, qr/^error adding principal wallet\nf/, 
+              ' with the right error');
+    }
     $object = eval {
         Wallet::Object::Keytab->create ('keytab', '', $dbh, @trace)
       };
     is ($object, undef, 'Creating empty principal fails');
-    is ($@, "invalid principal name \n", ' with the right error');
+    if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
+        is ($@, "invalid principal name \n", ' with the right error');
+    } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
+        like ($@, qr/^error adding principal \@/, ' with the right error');
+    }
     $object = eval {
         Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
       };
-- 
cgit v1.2.3


From 04b875599b1d4559dbcd356726035416081c6b48 Mon Sep 17 00:00:00 2001
From: Jon Robertson <jonrober@stanford.edu>
Date: Thu, 28 Jan 2010 00:07:16 -0800
Subject: Improved and fixed tests related to Pod and KDC type

Added a fix to the Pod tests to change the order of the arguments in a
skip statement to the correct order.  Also added tests for the
KEYTAB_KRBTYPE value in the keytab tests, and changed the Wallet::Kadmin
module to standardize the errors returned with no keytab set and add new
error for keytab set but not a valid value.
---
 perl/Wallet/Kadmin.pm |  5 ++++-
 perl/t/keytab.t       | 23 ++++++++++++++++++++---
 tests/server/pod-t.in |  2 +-
 3 files changed, 25 insertions(+), 5 deletions(-)

(limited to 'perl/t/keytab.t')

diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm
index 95859a9..501bc37 100644
--- a/perl/Wallet/Kadmin.pm
+++ b/perl/Wallet/Kadmin.pm
@@ -32,7 +32,10 @@ $VERSION = '0.03';
 sub new {
     my ($class) = @_;
     my ($kadmin);
-    if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
+    if (!defined $Wallet::Config::KEYTAB_KRBTYPE 
+        || !$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 ();
     } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index 7745290..ab5b19d 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -8,7 +8,7 @@
 # See LICENSE for licensing terms.
 
 use POSIX qw(strftime);
-use Test::More tests => 208
+use Test::More tests => 212
 ;
 
 use Wallet::Admin;
@@ -387,6 +387,21 @@ EOO
     is ($@, "keytab object implementation not configured\n",
         ' with the right error');
     $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm');
+    undef $Wallet::Config::KEYTAB_KRBTYPE;
+    $object = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+      };
+    is ($object, undef, ' and another');
+    is ($@, "keytab object implementation not configured\n",
+        ' with the right error');
+    $Wallet::Config::KEYTAB_KRBTYPE = 'Active Directory';
+    $object = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+      };
+    is ($object, undef, ' and one set to an invalid value');
+    is ($@, "keytab krb server type not set to a valid value\n",
+        ' with the right error');
+    $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype');
 }
 
 # Tests for unchanging support.  Skip these if we don't have a keytab or if we
@@ -403,6 +418,7 @@ SKIP: {
     $Wallet::Config::KEYTAB_FILE      = 't/data/test.keytab';
     $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal');
     $Wallet::Config::KEYTAB_REALM     = contents ('t/data/test.realm');
+    $Wallet::Config::KEYTAB_KRBTYPE   = contents ('t/data/test.krbtype');
     $Wallet::Config::KEYTAB_TMP       = '.';
     my $realm = $Wallet::Config::KEYTAB_REALM;
     my $principal = $Wallet::Config::KEYTAB_PRINCIPAL;
@@ -581,6 +597,7 @@ EOO
     $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          = '.';
     $Wallet::Config::KEYTAB_AFS_KASETKEY = '../kasetkey/kasetkey';
     my $realm = $Wallet::Config::KEYTAB_REALM;
@@ -707,8 +724,7 @@ EOO
 
 # Tests for enctype restriction.
 SKIP: {
-    unless (-f 't/data/test.keytab'
-            && $Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
+    unless (-f 't/data/test.keytab') {
         skip 'no keytab configuration', 36;
     }
 
@@ -716,6 +732,7 @@ SKIP: {
     $Wallet::Config::KEYTAB_FILE      = 't/data/test.keytab';
     $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal');
     $Wallet::Config::KEYTAB_REALM     = contents ('t/data/test.realm');
+    $Wallet::Config::KEYTAB_KRBTYPE   = contents ('t/data/test.krbtype');
     $Wallet::Config::KEYTAB_TMP       = '.';
     my $realm = $Wallet::Config::KEYTAB_REALM;
     my $principal = $Wallet::Config::KEYTAB_PRINCIPAL;
diff --git a/tests/server/pod-t.in b/tests/server/pod-t.in
index 4973d23..4575ecb 100644
--- a/tests/server/pod-t.in
+++ b/tests/server/pod-t.in
@@ -15,7 +15,7 @@ plan tests => $total;
 
 eval 'use Test::Pod 1.00';
 SKIP: {
-    skip $total, 'Test::Pod 1.00 required for testing POD' if $@;
+    skip 'Test::Pod 1.00 required for testing POD', $total if $@;
     for my $file (@files) {
         pod_file_ok ("@abs_top_srcdir@/server/$file", "server/$file");
     }
-- 
cgit v1.2.3


From 346660359be7666e8629c14b2d12cebf794f6f26 Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
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/keytab.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) [ <searchtype> [ <arg> ... ] ]
 
-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:
 
     <name> (ACL ID: <id>)
@@ -210,8 +210,8 @@ can be housekept.
 
 =item list acls entry <schema> <identifier>
 
-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 b6cf2f78636970900015e74b03160e7280164e47 Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Mon, 8 Feb 2010 19:40:17 -0800
Subject: Use kvno or kgetcred to check principal existance

Don't use kadmin to check for principal existence.  We want to verify
that we can get tickets, not just look at kadmin.  Use whatever is found
on the user's PATH, not something based on the Kerberos type, since our
userspace may not match the server implementation.
---
 perl/t/keytab.t | 23 ++++++++++++-----------
 1 file changed, 12 insertions(+), 11 deletions(-)

(limited to 'perl/t/keytab.t')

diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index d1d5ba6..5488e28 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -90,21 +90,22 @@ sub destroy {
     system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args);
 }
 
-# Check whether a principal exists.  kvno works for MIT, but isn't in the
-# Heimdal dist.
+# Check whether a principal exists.  MIT uses kvno and Heimdal uses kgetcred.
+# Note that the Kerberos type may be different than our local userspace, so
+# don't use the Kerberos type to decide here.  Instead, check for which
+# program is available on the path.
 sub created {
     my ($principal) = @_;
     $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
-    if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
-        local $ENV{KRB5CCNAME} = 'krb5cc_temp';
-        getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL);
+    local $ENV{KRB5CCNAME} = 'krb5cc_temp';
+    getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL);
+    if (grep { -x "$_/kvno" } split (':', $ENV{PATH})) {
         return (system_quiet ('kvno', $principal) == 0);
-    } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
-        @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL,
-                 '-K', $Wallet::Config::KEYTAB_FILE,
-                 '-r', $Wallet::Config::KEYTAB_REALM,
-                 'get', $principal);
-        return (system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args) == 0);
+    } elsif (grep { -x "$_/kgetcred" } split (':', $ENV{PATH})) {
+        return (system_quiet ('kgetcred', $principal) == 0);
+    } else {
+        warn "# No kvno or kgetcred found\n";
+        return;
     }
 }
 
-- 
cgit v1.2.3


From a96f4abbbe8176101584e414be5139e244377025 Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Mon, 8 Feb 2010 19:46:54 -0800
Subject: Use Wallet::Kadmin to do kadmin operations in the keytab test

Now that we have Wallet::Kadmin, use it, rather than running the kadmin
client program.  We may not have the same kadmin client program as the
server that we're testing against.
---
 perl/t/keytab.t | 36 ++++++++----------------------------
 1 file changed, 8 insertions(+), 28 deletions(-)

(limited to 'perl/t/keytab.t')

diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index 5488e28..25e946c 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -3,16 +3,17 @@
 # t/keytab.t -- Tests for the keytab object implementation.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2009, 2010
+#     Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
 use POSIX qw(strftime);
-use Test::More tests => 212
-;
+use Test::More tests => 212;
 
 use Wallet::Admin;
 use Wallet::Config;
+use Wallet::Kadmin;
 use Wallet::Object::Keytab;
 
 use lib 't/lib';
@@ -57,37 +58,16 @@ sub system_quiet {
 # been set up.
 sub create {
     my ($principal) = @_;
-    if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
-        my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k',
-                    '-t', $Wallet::Config::KEYTAB_FILE,
-                    '-r', $Wallet::Config::KEYTAB_REALM,
-                    '-q', "addprinc -clearpolicy -randkey $principal");
-    } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
-        @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL,
-                 '-K', $Wallet::Config::KEYTAB_FILE,
-                 '-r', $Wallet::Config::KEYTAB_REALM,
-                 'add', $principal);
-    }
-    system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args);
+    my $kadmin = Wallet::Kadmin->new;
+    return $kadmin->addprinc ($principal);
 }
 
 # Destroy a principal out of Kerberos.  Only usable once the configuration has
 # been set up.
 sub destroy {
     my ($principal) = @_;
-    my (@args);
-    if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
-        @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k',
-                 '-t', $Wallet::Config::KEYTAB_FILE,
-                 '-r', $Wallet::Config::KEYTAB_REALM,
-                 '-q', "delprinc -force $principal");
-    } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
-        @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL,
-                 '-K', $Wallet::Config::KEYTAB_FILE,
-                 '-r', $Wallet::Config::KEYTAB_REALM,
-                 'delete', $principal);
-    }
-    system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args);
+    my $kadmin = Wallet::Kadmin->new;
+    return $kadmin->delprinc ($principal);
 }
 
 # Check whether a principal exists.  MIT uses kvno and Heimdal uses kgetcred.
-- 
cgit v1.2.3


From c2422d4f762b5db774c6e0fef2cb2de916904f0e Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Mon, 8 Feb 2010 19:59:26 -0800
Subject: Redo how we find enctypes in the keytab test suite

We may have a different userspace than the Kerberos type, so always
try klist -ke first and then fall back on ktutil if it fails.

Also display the error message in a few more places if things fail,
discovered as useful when debugging other problems.
---
 perl/t/keytab.t | 36 ++++++++++++++++++++++--------------
 1 file changed, 22 insertions(+), 14 deletions(-)

(limited to 'perl/t/keytab.t')

diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index 25e946c..c3e89d5 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -116,19 +116,22 @@ sub enctypes {
     close KEYTAB;
 
     my @enctypes;
-    if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
-        open (KLIST, '-|', 'klist', '-ke', 'keytab')
-            or die "cannot run klist: $!\n";
-        local $_;
-        while (<KLIST>) {
-            next unless /^ *\d+ /;
-            my ($string) = /\((.*)\)\s*$/;
-            next unless $string;
-            $enctype = $enctype{lc $string} || 'UNKNOWN';
-            push (@enctypes, $enctype);
-        }
-        close KLIST;
-    } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
+    open (KLIST, '-|', 'klist', '-ke', 'keytab')
+        or die "cannot run klist: $!\n";
+    local $_;
+    while (<KLIST>) {
+        next unless /^ *\d+ /;
+        my ($string) = /\((.*)\)\s*$/;
+        next unless $string;
+        $enctype = $enctype{lc $string} || 'UNKNOWN';
+        push (@enctypes, $enctype);
+    }
+    close KLIST;
+
+    # If that failed, we may have a Heimdal user space instead, so try ktutil.
+    # If we try this directly, it will just hang with MIT ktutil.
+    if ($? != 0) {
+        @enctypes = ();
         open (KTUTIL, '-|', 'ktutil', '-k', 'keytab', 'list')
             or die "cannot run ktutil: $!\n";
         local $_;
@@ -227,9 +230,14 @@ SKIP: {
     $object = eval {
         Wallet::Object::Keytab->create ('keytab', 'wallet/two', $dbh, @trace)
       };
-    ok (defined ($object), 'Creating an existing principal succeeds');
+    if (defined ($object)) {
+        ok (defined ($object), 'Creating an existing principal succeeds');
+    } else {
+        is ($@, '', 'Creating an existing principal succeeds');
+    }
     ok ($object->isa ('Wallet::Object::Keytab'), ' and is the right class');
     is ($object->destroy (@trace), 1, ' and destroying it succeeds');
+    is ($object->error, undef, ' with no error message');
     ok (! created ('wallet/two'), ' and now it does not exist');
     my @name = qw(keytab wallet-test/one);
     $object = eval { Wallet::Object::Keytab->create (@name, $dbh, @trace) };
-- 
cgit v1.2.3


From 954151bb1aeb8920b0077692db1705c39ff76eda Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Mon, 8 Feb 2010 20:08:32 -0800
Subject: Additional cleanup of the keytab test suite

Map the AES enctype to the full enctype name, which will work for both
MIT and Heimdal.  Fix the test count.  Really test rollback from invalid
enctypes (what we did before made no sense).  Skip tests that will just
fail if the enctype stuff is not working, since otherwise it confuses
matters.
---
 perl/t/keytab.t | 15 +++++++++------
 1 file changed, 9 insertions(+), 6 deletions(-)

(limited to 'perl/t/keytab.t')

diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index c3e89d5..93df51c 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 => 212;
+use Test::More tests => 213;
 
 use Wallet::Admin;
 use Wallet::Config;
@@ -26,7 +26,7 @@ my %enctype =
     ('triple des cbc mode with hmac/sha1'      => 'des3-cbc-sha1',
      'des cbc mode with crc-32'                => 'des-cbc-crc',
      'des cbc mode with rsa-md5'               => 'des-cbc-md5',
-     'aes-256 cts mode with 96-bit sha-1 hmac' => 'aes256-cts',
+     'aes-256 cts mode with 96-bit sha-1 hmac' => 'aes256-cts-hmac-sha1-96',
      'arcfour with hmac/md5'                   => 'rc4-hmac');
 
 # Some global defaults to use.
@@ -788,8 +788,7 @@ EOO
         'Setting an unrecognized enctype fails');
     is ($one->error, 'unknown encryption type foo-bar',
         ' with the right error message');
-    @values = enctypes ($keytab);
-    is ("@values", "@enctypes", ' and we did rollback properly');
+    is ($one->show, $expected, ' and we did rollback properly');
     $history .= <<"EOO";
 $date  get
     by $user from $host
@@ -810,8 +809,12 @@ EOO
         is ("@values", $enctypes[0], ' and we get back the right value');
         $keytab = $one->get (@trace);
         ok (defined ($keytab), ' and retrieving the keytab still works');
-        @values = enctypes ($keytab);
-        is ("@values", $enctypes[0], ' and it has the right enctype');
+        if (defined ($keytab)) {
+            @values = enctypes ($keytab);
+            is ("@values", $enctypes[0], ' and it has the right enctype');
+        } else {
+            ok (0, ' and it has the right keytab');
+        }
         is ($one->attr ('enctypes', [ $enctypes[1] ], @trace), 1,
             'Setting a different single enctype works');
         @values = $one->attr ('enctypes');
-- 
cgit v1.2.3


From 59455fd5e6a47a66a2a84779f42928fd66ec9747 Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Tue, 9 Feb 2010 13:06:31 -0800
Subject: Remove kaserver synchronization support from the wallet backend

Remove kaserver synchronization support.  It is no longer tested, and
retaining the code was increasing the complexity of wallet, and some
specific requirements (such as different realm names between kaserver
and Kerberos v5 and the kvno handling) were Stanford-specific.  Rather
than using this support, AFS sites running kaserver will probably find
deploying Heimdal with its internal kaserver compatibility is probably
an easier transition approach.
---
 NEWS                         |   8 +
 perl/Wallet/Config.pm        |  83 +---------
 perl/Wallet/Object/Keytab.pm | 349 +++++++------------------------------------
 perl/Wallet/Schema.pm        |  10 +-
 perl/t/config.t              |   6 +-
 perl/t/keytab.t              | 217 ++-------------------------
 perl/t/schema.t              |   2 +-
 7 files changed, 86 insertions(+), 589 deletions(-)

(limited to 'perl/t/keytab.t')

diff --git a/NEWS b/NEWS
index 04942ea..3185db3 100644
--- a/NEWS
+++ b/NEWS
@@ -2,6 +2,14 @@
 
 wallet 0.10 (unreleased)
 
+    Remove kaserver synchronization support.  It is no longer tested, and
+    retaining the code was increasing the complexity of wallet, and some
+    specific requirements (such as different realm names between kaserver
+    and Kerberos v5 and the kvno handling) were Stanford-specific.  Rather
+    than using this support, AFS sites running kaserver will probably find
+    deploying Heimdal with its internal kaserver compatibility is probably
+    an easier transition approach.
+
     Correctly handle storing of data that begins with a dash and don't
     parse it as an argument to wallet-backend.
 
diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm
index 3f52cf0..7198c07 100644
--- a/perl/Wallet/Config.pm
+++ b/perl/Wallet/Config.pm
@@ -1,7 +1,7 @@
 # Wallet::Config -- Configuration handling for the wallet server.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
@@ -14,7 +14,7 @@ use vars qw($PATH $VERSION);
 # 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.03';
+$VERSION = '0.04';
 
 # Path to the config file to load.
 $PATH = $ENV{WALLET_CONFIG} || '/etc/wallet/wallet.conf';
@@ -351,85 +351,6 @@ our $KEYTAB_REMCTL_PORT;
 
 =back
 
-=head2 Synchronization with AFS kaserver
-
-The keytab backend optionally supports synchronizing keys between the
-Kerberos v5 realm and a Kerberos v4 realm using kaserver.  This
-synchronization is done using B<kasetkey> and is controlled by the C<sync>
-attribute on keytab objects.  To configure that support, set the following
-variables.
-
-=over 4
-
-=item KEYTAB_AFS_ADMIN
-
-The Kerberos v4 principal to use for authentication to the AFS kaserver.  If
-this principal is not in the default local Kerberos v4 realm, it must be
-fully qualified.  A srvtab for this principal must be stored in the path set
-in $KEYTAB_AFS_SRVTAB.  This principal must have the ADMIN flag set in the
-AFS kaserver so that it can create and remove principals.  This variable
-must be set to use the kaserver synchronization support.
-
-=cut
-
-our $KEYTAB_AFS_ADMIN;
-
-=item KEYTAB_AFS_DESTROY
-
-If this variable, which is false by default, is set to a true value, each
-time a keytab object that is not configured to be synchronized with the AFS
-kaserver, the corresponding Kerberos v4 principal will be deleted from the
-AFS kaserver.  Use this with caution; it will cause the AFS kaserver realm
-to be slowly stripped of principals.  This is intended for use with
-migration from Kerberos v4 to Kerberos v5, where the old principals should
-be deleted out of Kerberos v4 whenever not requested from the wallet to aid
-in tracking down and removing any systems with lingering Kerberos v4
-dependencies.
-
-Be aware that multiple Kerberos v5 principals map to the same Kerberos v4
-principal since in Kerberos v4 the domain name is stripped from the
-principal for machine principals.  If you create a keytab named
-host/foo.example.com and mark it synchronized, and then create another
-keytab named host/foo.example.net and don't mark it synchronized,
-downloading the second will destroy the Kerberos v4 principal of the first
-if this variable is set.
-
-=cut
-
-our $KEYTAB_AFS_DESTROY;
-
-=item KEYTAB_AFS_KASETKEY
-
-The path to the B<kasetkey> command-line client.  The default value is
-C<kasetkey>, which will cause the wallet to search for B<kasetkey> on its
-default PATH.
-
-=cut
-
-our $KEYTAB_AFS_KASETKEY = 'kasetkey';
-
-=item KEYTAB_AFS_REALM
-
-The name of the Kerberos v4 realm with which to synchronize keys.  This is a
-realm, not a cell, so it should be in all uppercase.  If this variable is
-not set, the default is the realm determined from the local cell name.
-
-=cut
-
-our $KEYTAB_AFS_REALM;
-
-=item KEYTAB_AFS_SRVTAB
-
-The path to a srvtab used to authenticate to the AFS kaserver.  This srvtab
-should be for the principal set in $KEYTAB_AFS_ADMIN.  This variable must be
-set to use the kaserver synchronization support.
-
-=cut
-
-our $KEYTAB_AFS_SRVTAB;
-
-=back
-
 =head1 NETDB ACL CONFIGURATION
 
 These configuration variables are only needed if you intend to use the
diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm
index 9fece80..b604907 100644
--- a/perl/Wallet/Object/Keytab.pm
+++ b/perl/Wallet/Object/Keytab.pm
@@ -1,7 +1,8 @@
 # Wallet::Object::Keytab -- Keytab object implementation for the wallet.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2009 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2009, 2010
+#     Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
@@ -24,230 +25,7 @@ use Wallet::Kadmin;
 # This version should be increased on any code change to this module.  Always
 # use two digits for the minor version with a leading zero if necessary so
 # that it will sort properly.
-$VERSION = '0.07';
-
-##############################################################################
-# AFS kaserver synchronization
-##############################################################################
-
-# Given a Kerberos v5 principal name, convert it to a Kerberos v4 principal
-# name.  Returns undef if it can't convert the name for some reason (right
-# now, only if the principal has more than two parts).  Note that this mapping
-# does not guarantee a unique result; multiple hosts in different domains can
-# be mapped to the same Kerberos v4 principal name using this function.
-sub kaserver_name {
-    my ($self, $k5) = @_;
-    my %host = map { $_ => 1 } qw(host ident imap pop smtp);
-    $k5 =~ s/\@.*//;
-    my @parts = split ('/', $k5);
-    if (@parts > 2) {
-        return;
-    } elsif (@parts == 2 and $host{$parts[0]}) {
-        $parts[1] =~ s/\..*//;
-        $parts[0] = 'rcmd' if $parts[0] eq 'host';
-    }
-    my $k4 = join ('.', @parts);
-    if ($Wallet::Config::KEYTAB_AFS_REALM) {
-        $k4 .= '@' . $Wallet::Config::KEYTAB_AFS_REALM;
-    }
-    return $k4;
-}
-
-# Run kasetkey with the given arguments.  Returns true on success and false on
-# failure.  On failure, sets the internal error to the error from kasetkey.
-sub kaserver_kasetkey {
-    my ($self, @args) = @_;
-    my $admin = $Wallet::Config::KEYTAB_AFS_ADMIN;
-    my $admin_srvtab = $Wallet::Config::KEYTAB_AFS_SRVTAB;
-    my $kasetkey = $Wallet::Config::KEYTAB_AFS_KASETKEY;
-    unless ($kasetkey and $admin and $admin_srvtab) {
-        $self->error ('kaserver synchronization not configured');
-        return;
-    }
-    my $pid = open (KASETKEY, '-|');
-    if (not defined $pid) {
-        $self->error ("cannot fork: $!");
-        return;
-    } elsif ($pid == 0) {
-        # 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.)
-        $self->{dbh}->{InactiveDestroy} = 1;
-        unless (open (STDERR, '>&STDOUT')) {
-            warn "cannot redirect stderr: $!\n";
-            exit 1;
-        }
-        unless (exec ($kasetkey, '-k', $admin_srvtab, '-a', $admin, @args)) {
-            warn "cannot exec $kasetkey: $!\n";
-            exit 1;
-        }
-    } else {
-        local $/;
-        my $output = <KASETKEY>;
-        close KASETKEY;
-        if ($? != 0) {
-            $output =~ s/\s+\z//;
-            $output =~ s/\n/, /g;
-            $output = ': ' . $output if $output;
-            $self->error ("cannot synchronize key with kaserver$output");
-            return;
-        }
-    }
-    return 1;
-}
-
-# Given a keytab file name, the Kerberos v5 principal that's stored in that
-# keytab, a srvtab file name, and the corresponding Kerberos v4 principal,
-# write out a srvtab file containing the DES key in that keytab.  Fails if
-# there is no DES key in the keytab.
-sub kaserver_srvtab {
-    my ($self, $keytab, $k5, $srvtab, $k4) = @_;
-
-    # Gah.  Someday I will write Perl bindings for Kerberos that are less
-    # broken.
-    eval { require Authen::Krb5 };
-    if ($@) {
-        $self->error ("kaserver synchronization support not available: $@");
-        return;
-    }
-    eval { Authen::Krb5::init_context() };
-    if ($@ and not $@ =~ /^Authen::Krb5 already initialized/) {
-        $self->error ('Kerberos initialization failed');
-        return;
-    }
-    undef $@;
-
-    # Do the interface dance.  We call kt_read_service_key with 0 for the kvno
-    # to get any kvno, which works with MIT Kerberos at least.  Assume a DES
-    # enctype of 1.  This code won't work with any enctype other than
-    # des-cbc-crc.
-    my $princ = Authen::Krb5::parse_name ($k5);
-    unless (defined $princ) {
-        my $error = Authen::Krb5::error();
-        $self->error ("cannot parse $k5: $error");
-        return;
-    }
-    my $key = Authen::Krb5::kt_read_service_key ($keytab, $princ, 0, 1);
-    unless (defined $key) {
-        my $error = Authen::Krb5::error();
-        $self->error ("cannot find des-cbc-crc key in $keytab: $error");
-        return;
-    }
-    unless (open (SRVTAB, '>', $srvtab)) {
-        $self->error ("cannot create $srvtab: $!");
-        return;
-    }
-
-    # srvtab format is nul-terminated name, nul-terminated instance,
-    # nul-terminated realm, single character kvno (which we always set to 0),
-    # and DES keyblock.
-    my ($principal, $realm) = split ('@', $k4);
-    $realm ||= '';
-    my ($name, $inst) = split (/\./, $principal, 2);
-    $inst ||= '';
-    my $data = join ("\0", $name, $inst, $realm);
-    $data .= "\0\0" . $key->contents;
-    print SRVTAB $data;
-    unless (close SRVTAB) {
-        unlink $srvtab;
-        $self->error ("cannot write to $srvtab: $!");
-        return;
-    }
-    return 1;
-}
-
-# Given a principal name and a path to the keytab, synchronizes the key with a
-# principal in an AFS kaserver.  Returns true on success and false on failure.
-# On failure, sets the internal error.
-sub kaserver_sync {
-    my ($self, $principal, $keytab) = @_;
-    if ($Wallet::Config::KEYTAB_REALM) {
-        $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
-    }
-    my $k4 = $self->kaserver_name ($principal);
-    if (not defined $k4) {
-        $self->error ("cannot convert $principal to Kerberos v4");
-        return;
-    }
-    my $srvtab = $Wallet::Config::KEYTAB_TMP . "/srvtab.$$";
-    unless ($self->kaserver_srvtab ($keytab, $principal, $srvtab, $k4)) {
-        return;
-    }
-    unless ($self->kaserver_kasetkey ('-c', $srvtab, '-s', $k4)) {
-        unlink $srvtab;
-        return;
-    }
-    unlink $srvtab;
-    return 1;
-}
-
-# Given a principal name, destroy the corresponding principal in the AFS
-# kaserver.  Returns true on success and false on failure, setting the object
-# error if it fails.
-sub kaserver_destroy {
-    my ($self, $principal) = @_;
-    my $k4 = $self->kaserver_name ($principal);
-    if (not defined $k4) {
-        $self->error ("cannot convert $principal to Kerberos v4");
-        return;
-    }
-    return $self->kaserver_kasetkey ('-D', $k4);
-}
-
-# Set the kaserver sync attribute.  Called by attr().  Returns true on success
-# and false on failure, setting the object error if it fails.
-sub kaserver_set {
-    my ($self, $user, $host, $time) = @_;
-    $time ||= time;
-    my @trace = ($user, $host, $time);
-    my $name = $self->{name};
-    eval {
-        my $sql = "select ks_name from keytab_sync where ks_name = ? and
-            ks_target = 'kaserver'";
-        my $result = $self->{dbh}->selectrow_array ($sql, undef, $name);
-        if ($result) {
-            die "kaserver synchronization already set\n";
-        }
-        $sql = "insert into keytab_sync (ks_name, ks_target)
-            values (?, 'kaserver')";
-        $self->{dbh}->do ($sql, undef, $name);
-        $self->log_set ('type_data sync', undef, 'kaserver', @trace);
-        $self->{dbh}->commit;
-    };
-    if ($@) {
-        $self->error ($@);
-        $self->{dbh}->rollback;
-        return;
-    }
-    return 1;
-}
-
-# Clear the kaserver sync attribute.  Called by attr().  Returns true on
-# success and false on failure, setting the object error if it fails.
-sub kaserver_clear {
-    my ($self, $user, $host, $time) = @_;
-    $time ||= time;
-    my @trace = ($user, $host, $time);
-    my $name = $self->{name};
-    eval {
-        my $sql = "select ks_name from keytab_sync where ks_name = ? and
-            ks_target = 'kaserver'";
-        my $result = $self->{dbh}->selectrow_array ($sql, undef, $name);
-        unless ($result) {
-            die "kaserver synchronization not set\n";
-        }
-        $sql = 'delete from keytab_sync where ks_name = ?';
-        $self->{dbh}->do ($sql, undef, $name);
-        $self->log_set ('type_data sync', 'kaserver', undef, @trace);
-        $self->{dbh}->commit;
-    };
-    if ($@) {
-        $self->error ($@);
-        $self->{dbh}->rollback;
-        return;
-    }
-    return 1;
-}
+$VERSION = '0.08';
 
 ##############################################################################
 # Enctype restriction
@@ -379,9 +157,14 @@ sub keytab_retrieve {
 # Core methods
 ##############################################################################
 
-# Override attr to support setting the enctypes and sync attributes.
+# Override attr to support setting the enctypes and sync attributes.  Note
+# that the sync attribute has no supported targets at present and hence will
+# always return an error, but the code is still here so that it doesn't have
+# to be rewritten once a new sync target is added.
 sub attr {
     my ($self, $attribute, $values, $user, $host, $time) = @_;
+    $time ||= time;
+    my @trace = ($user, $host, $time);
     my %known = map { $_ => 1 } qw(enctypes sync);
     undef $self->{error};
     unless ($known{$attribute}) {
@@ -395,14 +178,25 @@ sub attr {
             if (@$values > 1) {
                 $self->error ('only one synchronization target supported');
                 return;
-            } elsif (@$values and $values->[0] ne 'kaserver') {
+            } elsif (@$values) {
                 my $target = $values->[0];
                 $self->error ("unsupported synchronization target $target");
                 return;
-            } elsif (@$values) {
-                return $self->kaserver_set ($user, $host, $time);
             } else {
-                return $self->kaserver_clear ($user, $host, $time);
+                eval {
+                    my $sql = 'select ks_target from keytab_sync where
+                        ks_name = ?';
+                    my $dbh = $self->{dbh};
+                    my $name = $self->{name};
+                    my ($result) = $dbh->selectrow_array ($sql, undef, $name);
+                    if ($result) {
+                        my $sql = 'delete from keytab_sync where ks_name = ?';
+                        $self->{dbh}->do ($sql, undef, $name);
+                        $self->log_set ('type_data sync', $result, undef,
+                                        @trace);
+                    }
+                    $self->{dbh}->commit;
+                }
             }
         }
     } else {
@@ -511,12 +305,6 @@ sub destroy {
         $self->error ("cannot destroy $id: object is locked");
         return;
     }
-    my @sync = $self->attr ('sync');
-    if (grep { $_ eq 'kaserver' } @sync) {
-        unless ($self->kaserver_destroy ($self->{name})) {
-            return;
-        }
-    }
     eval {
         my $sql = 'delete from keytab_sync where ks_name = ?';
         $self->{dbh}->do ($sql, undef, $self->{name});
@@ -582,15 +370,6 @@ sub get {
         return;
     }
     close KEYTAB;
-    my @sync = $self->attr ('sync');
-    if (grep { $_ eq 'kaserver' } @sync) {
-        unless ($self->kaserver_sync ($self->{name}, $file)) {
-            unlink $file;
-            return;
-        }
-    } elsif ($Wallet::Config::KEYTAB_AFS_DESTROY) {
-        $self->kaserver_destroy ($self->{name});
-    }
     unlink $file;
     $self->log_action ('get', $user, $host, $time);
     return $data;
@@ -646,7 +425,7 @@ methods that are overridden or behave specially for this implementation.
 
 =item attr(ATTRIBUTE [, VALUES, PRINCIPAL, HOSTNAME [, DATETIME]])
 
-Sets or retrieves a given object attribute.  The following attributes are
+Sets or retrieves a given object attribute.  The following attribute is
 supported:
 
 =over 4
@@ -655,40 +434,21 @@ supported:
 
 Restricts the generated keytab to a specific set of encryption types.  The
 values of this attribute must be enctype strings recognized by Kerberos
-(strings like C<aes256-cts> or C<des-cbc-crc>).  Encryption types must also
-be present in the list of supported enctypes stored in the database database
-or the attr() method will reject them.  Note that the salt should not be
-included; since the salt is irrelevant for keytab keys, it will always be
-set to C<normal> by the wallet.
+(strings like C<aes256-cts-hmac-sha1-96> or C<des-cbc-crc>).  Encryption
+types must also be present in the list of supported enctypes stored in the
+database database or the attr() method will reject them.  Note that the
+salt should not be included; since the salt is irrelevant for keytab keys,
+it will always be set to the default by the wallet.
 
-If this attribute is set, the specified enctype list will be passed to
-ktadd when get() is called for that keytab.  If it is not set, the default
-set in the KDC will be used.
+If this attribute is set, the principal will be restricted to that
+specific enctype list when get() is called for that keytab.  If it is not
+set, the default set in the KDC will be used.
 
 This attribute is ignored if the C<unchanging> flag is set on a keytab.
 Keytabs retrieved with C<unchanging> set will contain all keys present in
 the KDC for that Kerberos principal and therefore may contain different
 enctypes than those requested by this attribute.
 
-=item sync
-
-Sets the external systems to which the key of a given principal is
-synchronized.  The only supported value for this attribute is C<kaserver>,
-which says to synchronize the key with an AFS Kerberos v4 kaserver.
-
-If this attribute is set on a keytab, whenever get() is called for that
-keytab, the new DES key will be extracted from that keytab and set in the
-configured AFS kaserver.  The Kerberos v4 principal name will be the same as
-the Kerberos v5 principal name except that the components are separated by
-C<.> instead of C</>; the second component is truncated after the first C<.>
-if the first component is one of C<host>, C<ident>, C<imap>, C<pop>, or
-C<smtp>; and the first component is C<rcmd> if the Kerberos v5 principal
-component is C<host>.  The principal name must not contain more than two
-components.
-
-If this attribute is set, calling destroy() will also destroy the principal
-from the AFS kaserver, with a principal mapping determined as above.
-
 =back
 
 If no other arguments besides ATTRIBUTE are given, returns the values of
@@ -716,11 +476,11 @@ used.
 
 When a new keytab object is created, the Kerberos principal designated by
 NAME is also created in the Kerberos realm determined from the wallet
-configuration.  If the principal already exists, create() still succeeds (so
-that a previously unmanaged principal can be imported into the wallet).
-Otherwise, if the Kerberos principal could not be created, create() fails.
-The principal is created with the C<-randkey> option to randomize its keys.
-NAME must not contain the realm; instead, the KEYTAB_REALM configuration
+configuration.  If the principal already exists, create() still succeeds
+(so that a previously unmanaged principal can be imported into the
+wallet).  Otherwise, if the Kerberos principal could not be created,
+create() fails.  The principal is created with the randomized keys.  NAME
+must not contain the realm; instead, the KEYTAB_REALM configuration
 variable should be set.  See Wallet::Config(3) for more information.
 
 If create() fails, it throws an exception.
@@ -738,18 +498,14 @@ destroying the object.  If DATETIME isn't given, the current time is used.
 
 =item get(PRINCIPAL, HOSTNAME [, DATETIME])
 
-Retrieves a keytab for this object and returns the keytab data or undef
-on error.  The caller should call error() to get the error message if
-get() returns undef.  The keytab is created with C<ktadd>, invalidating
-any existing keytabs for that principal, unless the unchanging flag is set
-on the object.  PRINCIPAL, HOSTNAME, and DATETIME are stored as history
-information.  PRINCIPAL should be the user who is downloading the keytab.
-If DATETIME isn't given, the current time is used.
-
-If the configuration variable $KEYTAB_AFS_DESTROY is set and the C<sync>
-attribute is not set to C<kaserver>, calling get() on a keytab object will
-cause the corresponding Kerberos v4 principal to be destroyed.  This
-variable is not set by default.
+Retrieves a keytab for this object and returns the keytab data or undef on
+error.  The caller should call error() to get the error message if get()
+returns undef.  The keytab is created with new randomized keys,
+invalidating any existing keytabs for that principal, unless the
+unchanging flag is set on the object.  PRINCIPAL, HOSTNAME, and DATETIME
+are stored as history information.  PRINCIPAL should be the user who is
+downloading the keytab.  If DATETIME isn't given, the current time is
+used.
 
 =back
 
@@ -767,15 +523,14 @@ of the current process.  The file is unlinked after being read.
 
 =head1 LIMITATIONS
 
-Currently, this implementation only supports MIT Kerberos and needs
-modifications to support Heimdal.  It calls an external B<kadmin> program
-rather than using a native Perl module and therefore requires B<kadmin> be
-installed and parses its output.  It may miss some error conditions if the
-output of B<kadmin> ever changes.
+Currently, when used with MIT Kerberos, this implementation calls an
+external B<kadmin> program rather than using a native Perl module and
+therefore requires B<kadmin> be installed and parses its output.  It may
+miss some error conditions if the output of B<kadmin> 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.
+all keytab objects stored must be in that realm.  Keytab names in the
+wallet database do not have realm information.
 
 =head1 SEE ALSO
 
diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm
index 2b256a2..252da03 100644
--- a/perl/Wallet/Schema.pm
+++ b/perl/Wallet/Schema.pm
@@ -1,7 +1,7 @@
 # Wallet::Schema -- Database schema for the wallet system.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
@@ -20,7 +20,7 @@ use DBI;
 # 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.05';
+$VERSION = '0.06';
 
 ##############################################################################
 # Data manipulation
@@ -372,12 +372,12 @@ change was made.
 
 =head2 Keytab Backend Data
 
-The keytab backend supports synchronizing keys with an external system.  The
-permitted external systems are listed in a normalization table:
+The keytab backend has stub support for synchronizing keys with an
+external system, although no external systems are currently supported.
+The permitted external systems are listed in a normalization table:
 
   create table sync_targets
      (st_name             varchar(255) primary key);
-  insert into sync_targets (st_name) values ('kaserver');
 
 and then the synchronization targets for a given keytab are stored in this
 table:
diff --git a/perl/t/config.t b/perl/t/config.t
index d60d7e7..1377cb8 100755
--- a/perl/t/config.t
+++ b/perl/t/config.t
@@ -3,11 +3,11 @@
 # t/config.t -- Tests for the wallet server configuration.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 7;
+use Test::More tests => 6;
 
 # Silence warnings since we're not using use.
 package Wallet::Config;
@@ -25,8 +25,6 @@ is ($Wallet::Config::KEYTAB_FLAGS, '-clearpolicy',
     ' and KEYTAB_FLAGS is correct');
 is ($Wallet::Config::KEYTAB_KADMIN, 'kadmin',
     ' and KEYTAB_KADMIN is correct');
-is ($Wallet::Config::KEYTAB_AFS_KASETKEY, 'kasetkey',
-    ' and KEYTAB_AFS_KASETKEY is correct');
 is ($Wallet::Config::DB_DRIVER, undef, ' and DB_DRIVER is unset');
 
 # Create a configuration file with a single setting.
diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index 93df51c..e5a68be 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 => 213;
+use Test::More tests => 125;
 
 use Wallet::Admin;
 use Wallet::Config;
@@ -147,24 +147,6 @@ sub enctypes {
     return sort @enctypes;
 }
 
-# Given a Wallet::Object::Keytab object, the keytab data, the Kerberos v5
-# principal, and the Kerberos v4 principal, write the keytab to a file,
-# generate a srvtab, and try authenticating using k4start.
-sub valid_srvtab {
-    my ($object, $keytab, $k5, $k4) = @_;
-    open (KEYTAB, '>', 'keytab') or die "cannot create keytab: $!\n";
-    print KEYTAB $keytab;
-    close KEYTAB;
-    unless ($object->kaserver_srvtab ('keytab', $k5, 'srvtab', $k4)) {
-        warn "cannot write srvtab: ", $object->error, "\n";
-        return 0;
-    }
-    $ENV{KRBTKFILE} = 'krb4cc_temp';
-    system ("k4start -f srvtab $k4 2>&1 >/dev/null </dev/null");
-    unlink 'keytab', 'srvtab', 'krb4cc_temp';
-    return ($? == 0) ? 1 : 0;
-}
-
 # Use Wallet::Admin to set up the database.
 unlink ('krb5cc_temp', 'krb5cc_test', 'test-acl', 'test-pid');
 db_setup;
@@ -474,55 +456,18 @@ EOO
     is ($one->history, $history, 'History is correct to this point');
 }
 
-# Tests for kaserver synchronization support.
+# Tests for synchronization support.  This code is deactivated at present
+# since no synchronization targets are supported, but we want to still test
+# the basic stub code.
 SKIP: {
     skip 'no keytab configuration', 106 unless -f 't/data/test.keytab';
 
-    # Test the principal mapping.  We can do this without having a kaserver
-    # configuration.  We only need a basic keytab object configuration.  Do
-    # this as white-box testing since we don't want to fill the test realm
-    # with a bunch of random principals.
+    # Test setting synchronization attributes, which can also be done without
+    # configuration.
     my $one = eval {
         Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
       };
     ok (defined ($one), 'Creating wallet/one succeeds');
-    my %princs =
-        (foo                     => 'foo',
-         host                    => 'host',
-         rcmd                    => 'rcmd',
-         'rcmd.foo'              => 'rcmd.foo',
-         'host/foo.example.org'  => 'rcmd.foo',
-         'ident/foo.example.org' => 'ident.foo',
-         'imap/foo.example.org'  => 'imap.foo',
-         'pop/foo.example.org'   => 'pop.foo',
-         'smtp/foo.example.org'  => 'smtp.foo',
-         'service/foo'           => 'service.foo',
-         'foo/bar'               => 'foo.bar');
-    for my $princ (sort keys %princs) {
-        my $result = $princs{$princ};
-        is ($one->kaserver_name ($princ), $result, "Name mapping: $princ");
-        is ($one->kaserver_name ("$princ\@EXAMPLE.ORG"), $result,
-            ' with K5 realm');
-        $Wallet::Config::KEYTAB_AFS_REALM = 'AFS.EXAMPLE.ORG';
-        is ($one->kaserver_name ($princ), "$result\@AFS.EXAMPLE.ORG",
-            ' with K4 realm');
-        is ($one->kaserver_name ("$princ\@EXAMPLE.ORG"),
-            "$result\@AFS.EXAMPLE.ORG", ' with K5 and K4 realm');
-        undef $Wallet::Config::KEYTAB_AFS_REALM;
-    }
-    for my $princ (qw{service/foo/bar foo/bar/baz}) {
-        is ($one->kaserver_name ($princ), undef, "Name mapping: $princ");
-        is ($one->kaserver_name ("$princ\@EXAMPLE.ORG"), undef,
-            ' with K5 realm');
-        $Wallet::Config::KEYTAB_AFS_REALM = 'AFS.EXAMPLE.ORG';
-        is ($one->kaserver_name ($princ), undef, ' with K4 realm');
-        is ($one->kaserver_name ("$princ\@EXAMPLE.ORG"), undef,
-            ' with K5 and K4 realm');
-        undef $Wallet::Config::KEYTAB_AFS_REALM;
-    }
-
-    # Test setting synchronization attributes, which can also be done without
-    # configuration.
     my $expected = <<"EOO";
            Type: keytab
            Name: wallet/one
@@ -537,16 +482,20 @@ EOO
     my @targets = $one->attr ('foo');
     is (scalar (@targets), 0, ' and getting an unknown attribute fails');
     is ($one->error, 'unknown attribute foo', ' with the right error');
-    is ($one->attr ('sync', [ 'foo' ], @trace), undef,
+    is ($one->attr ('sync', [ 'kaserver' ], @trace), undef,
         ' and setting an unknown sync target fails');
-    is ($one->error, 'unsupported synchronization target foo',
+    is ($one->error, 'unsupported synchronization target kaserver',
         ' with the right error');
     is ($one->attr ('sync', [ 'kaserver', 'bar' ], @trace), undef,
         ' and setting two targets fails');
     is ($one->error, 'only one synchronization target supported',
         ' with the right error');
-    is ($one->attr ('sync', [ 'kaserver' ], @trace), 1,
-        ' but setting only kaserver works');
+
+    # Create a synchronization manually so that we can test the display and
+    # removal code.
+    my $sql = "insert into keytab_sync (ks_name, ks_target) values
+        ('wallet/one', 'kaserver')";
+    $dbh->do ($sql);
     @targets = $one->attr ('sync');
     is (scalar (@targets), 1, ' and now one target is set');
     is ($targets[0], 'kaserver', ' and it is correct');
@@ -563,15 +512,10 @@ EOO
     $history .= <<"EOO";
 $date  create
     by $user from $host
-$date  add kaserver to attribute sync
-    by $user from $host
 EOO
     is ($one->history, $history, ' and history is correct for attributes');
-    is ($one->destroy (@trace), undef, 'Destroying wallet/one fails');
-    is ($one->error, 'kaserver synchronization not configured',
-        ' because kaserver support is not configured');
     is ($one->attr ('sync', [], @trace), 1,
-        ' but removing the kaserver sync attribute works');
+        'Removing the kaserver sync attribute works');
     is ($one->destroy (@trace),1, ' and then destroying wallet/one works');
     $history .= <<"EOO";
 $date  remove kaserver from attribute sync
@@ -579,136 +523,7 @@ $date  remove kaserver from attribute sync
 $date  destroy
     by $user from $host
 EOO
-
-    # Set up our configuration.
-    skip 'no AFS kaserver configuration', 34 unless -f 't/data/test.srvtab';
-    skip 'no kaserver support', 34 unless -x '../kasetkey/kasetkey';
-    $Wallet::Config::KEYTAB_FILE         = 't/data/test.keytab';
-    $Wallet::Config::KEYTAB_PRINCIPAL    = contents ('t/data/test.principal');
-    $Wallet::Config::KEYTAB_REALM        = contents ('t/data/test.realm');
-    $Wallet::Config::KEYTAB_KRBTYPE      = contents ('t/data/test.krbtype');
-    $Wallet::Config::KEYTAB_TMP          = '.';
-    $Wallet::Config::KEYTAB_AFS_KASETKEY = '../kasetkey/kasetkey';
-    my $realm = $Wallet::Config::KEYTAB_REALM;
-    my $k5 = "wallet/one\@$realm";
-
-    # Recreate and reconfigure the object.
-    $one = eval {
-        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
-      };
-    ok (defined ($one), 'Creating wallet/one succeeds');
-    is ($one->attr ('sync', [ 'kaserver' ], @trace), 1,
-        ' and setting the kaserver sync attribute works');
-
-    # Finally, we can test.
-    is ($one->get (@trace), undef, 'Get without configuration fails');
-    is ($one->error, 'kaserver synchronization not configured',
-        ' with the right error');
-    $Wallet::Config::KEYTAB_AFS_ADMIN = contents ('t/data/test.admin');
-    my $k4_realm = $Wallet::Config::KEYTAB_AFS_ADMIN;
-    $k4_realm =~ s/^[^\@]+\@//;
-    $Wallet::Config::KEYTAB_AFS_REALM = $k4_realm;
-    my $k4 = "wallet.one\@$k4_realm";
-    is ($one->get (@trace), undef, ' and still fails with just admin');
-    is ($one->error, 'kaserver synchronization not configured',
-        ' with the right error');
-    $Wallet::Config::KEYTAB_AFS_SRVTAB = 't/data/test.srvtab';
-    my $keytab = $one->get (@trace);
-    if (defined ($keytab)) {
-        ok (1, ' and now get works');
-    } else {
-        is ($one->error, '', ' and now get works');
-    }
-    ok (valid_srvtab ($one, $keytab, $k5, $k4), ' and the srvtab is valid');
-    ok (! -f "./srvtab.$$", ' and the temporary file was cleaned up');
-
-    # Now remove the sync attribute and make sure things aren't synced.
-    is ($one->attr ('sync', [], @trace), 1, 'Clearing sync works');
-    @targets = $one->attr ('sync');
-    is (scalar (@targets), 0, ' and now there is no attribute');
-    is ($one->error, undef, ' and no error');
-    my $new_keytab = $one->get (@trace);
-    ok (defined ($new_keytab), ' and get still works');
-    ok (! valid_srvtab ($one, $new_keytab, $k5, $k4),
-        ' but the srvtab does not');
-    ok (valid_srvtab ($one, $keytab, $k5, $k4), ' and the old one does');
-    is ($one->destroy (@trace), 1, ' and destroying wallet/one works');
-    ok (valid_srvtab ($one, $keytab, $k5, $k4),
-        ' and the principal is still there');
-
-    # Test KEYTAB_AFS_DESTROY.
-    $one = eval {
-        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
-      };
-    ok (defined ($one), 'Creating wallet/one succeeds');
-    $Wallet::Config::KEYTAB_AFS_DESTROY = 1;
-    $new_keytab = $one->get (@trace);
-    ok (defined ($new_keytab), ' and get works');
-    ok (! valid_srvtab ($one, $new_keytab, $k5, $k4),
-        ' but the srvtab does not');
-    ok (! valid_srvtab ($one, $keytab, $k5, $k4),
-        ' and now neither does the old one');
-    $Wallet::Config::KEYTAB_AFS_DESTROY = 0;
-
-    # Put it back and make sure it works again.
-    is ($one->attr ('sync', [ 'kaserver' ], @trace), 1, 'Setting sync works');
-    $keytab = $one->get (@trace);
-    ok (defined ($keytab), ' and get works');
-    ok (valid_srvtab ($one, $keytab, $k5, $k4), ' and the srvtab is valid');
-    $Wallet::Config::KEYTAB_AFS_KASETKEY = '/path/to/nonexistent/file';
-    $new_keytab = $one->get (@trace);
-    ok (! defined ($new_keytab),
-        ' but it fails if we mess up the kasetkey path');
-    like ($one->error, qr{^cannot synchronize key with kaserver: },
-          ' with the right error message');
-    ok (! -f "keytab.$$", ' and the temporary file was cleaned up');
-    $Wallet::Config::KEYTAB_AFS_KASETKEY = '../kasetkey/kasetkey';
-
-    # Destroy the principal and recreate it and make sure we cleaned up.
-    is ($one->destroy (@trace), 1, 'Destroying wallet/one works');
-    ok (! valid_srvtab ($one, $keytab, $k5, $k4),
-        ' and the principal is gone');
-    $one = eval {
-        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
-      };
-    ok (defined ($one), ' and recreating it succeeds');
-    @targets = $one->attr ('sync');
-    is (scalar (@targets), 0, ' and now there is no attribute');
-    is ($one->error, undef, ' and no error');
-
-    # Now destroy it for good.
-    is ($one->destroy (@trace), 1, 'Destroying wallet/one works');
-
-    # Check that history is still correct.
-    $history .= <<"EOO";
-$date  create
-    by $user from $host
-$date  add kaserver to attribute sync
-    by $user from $host
-$date  get
-    by $user from $host
-$date  remove kaserver from attribute sync
-    by $user from $host
-$date  get
-    by $user from $host
-$date  destroy
-    by $user from $host
-$date  create
-    by $user from $host
-$date  get
-    by $user from $host
-$date  add kaserver to attribute sync
-    by $user from $host
-$date  get
-    by $user from $host
-$date  destroy
-    by $user from $host
-$date  create
-    by $user from $host
-$date  destroy
-    by $user from $host
-EOO
-    is ($one->history, $history, 'History is correct to this point');
+    is ($one->history, $history, ' and history is correct for removal');
 }
 
 # Tests for enctype restriction.
diff --git a/perl/t/schema.t b/perl/t/schema.t
index 01d5dac..559ece4 100755
--- a/perl/t/schema.t
+++ b/perl/t/schema.t
@@ -21,7 +21,7 @@ ok (defined $schema, 'Wallet::Schema creation');
 ok ($schema->isa ('Wallet::Schema'), ' and class verification');
 my @sql = $schema->sql;
 ok (@sql > 0, 'sql() returns something');
-is (scalar (@sql), 29, ' and returns the right number of statements');
+is (scalar (@sql), 28, ' and returns the right number of statements');
 
 # Connect to a database and test create.
 db_setup;
-- 
cgit v1.2.3


From 31c47c6f5efde6df930b11be281470f75e685324 Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Tue, 9 Feb 2010 18:42:26 -0800
Subject: Update keytab test for new KRBTYPE error message

---
 perl/t/keytab.t | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'perl/t/keytab.t')

diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index e5a68be..39be547 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -370,7 +370,7 @@ EOO
         Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
       };
     is ($object, undef, ' and one set to an invalid value');
-    is ($@, "keytab krb server type not set to a valid value\n",
+    is ($@, "unknown KEYTAB_KRBTYPE setting: Active Directory\n",
         ' with the right error');
     $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype');
 }
-- 
cgit v1.2.3


From 2651ef4352c8cc782c4e0f3175257f7bb0c1e495 Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
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/keytab.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.<pid>
 
-The keytab is created in this file using C<ktadd> and then read into
-memory.  KEYTAB_TMP is set in the wallet configuration, and <pid> 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 <pid> 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<kadmin> program rather than using a native Perl module and
-therefore requires B<kadmin> be installed and parses its output.  It may
-miss some error conditions if the output of B<kadmin> 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 <rra@stanford.edu>
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/keytab.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<keytab-backend>.  This is enabled by setting the
-C<unchanging> 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<keytab-backend>.  This is
+enabled by setting the C<unchanging> flag on keytab objects.  To configure
+that support, set the following variables.
+
+This is not required for Heimdal; for Heimdal, setting the C<unchanging>
+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<aes256-cts-hmac-sha1-96> or C<des-cbc-crc>).  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<aes256-cts-hmac-sha1-96> or
+C<des-cbc-crc>).  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 = <TMPFILE>;
+    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.<pid>
+
+The keytab is created in this file and then read into memory.  KEYTAB_TMP
+is set in the wallet configuration, and <pid> 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 <rra@stanford.edu>
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/keytab.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 = <TMPFILE>;
+    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<Wallet::Config/"KEYTAB OBJECT CONFIGURATION"> 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<aes256-cts-hmac-sha1-96> or
 C<des-cbc-crc>).  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 = <TMPFILE>;
-    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<Wallet::Config/"KEYTAB OBJECT CONFIGURATION"> 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<Wallet::Config/"KEYTAB OBJECT CONFIGURATION"> for details.
+
+=head1 FILES
+
+=over 4
+
+=item KEYTAB_TMP/keytab.<pid>
+
+The keytab is created in this file and then read into memory.  KEYTAB_TMP
+is set in the wallet configuration, and <pid> 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 = <KEYTAB>;
-    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 <rra@stanford.edu>
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/keytab.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 69289862465a3bfb3488c1b3a674b6b06c9911ee Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
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/keytab.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 <rra@stanford.edu>
 # 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 <rra@stanford.edu>
 # 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 <rra@stanford.edu>
 # 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 <rra@stanford.edu>
 # 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 <rra@stanford.edu>
 # 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 <jonrober@stanford.edu>
 # 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 <rra@stanford.edu>
 # 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 <rra@stanford.edu>
 # 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 <rra@stanford.edu>
 # 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 <rra@stanford.edu>
 #
-# 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 <rra@stanford.edu>
 # 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 <rra@stanford.edu>
 # 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 <rra@stanford.edu>
 # 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 <rra@stanford.edu>
 # 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 <rra@stanford.edu>
 # 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 <rra@stanford.edu>
 # 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 1e28788f0b0f5cae3dd815f07d39ad70e7da0ce2 Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Tue, 18 May 2010 16:47:31 -0700
Subject: Fix error handling for klist with Heimdal user space

The check for the enctypes of created keytabs tries klist for MIT
first and then Heimdal ktutil.  The klist options are invalid for
Heimdal.  Suppress the resulting complaining to standard error.
---
 perl/t/keytab.t | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

(limited to 'perl/t/keytab.t')

diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index b16cea5..fabdc5b 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -103,8 +103,14 @@ sub enctypes {
     close KEYTAB;
 
     my @enctypes;
-    open (KLIST, '-|', 'klist', '-ke', 'keytab')
-        or die "cannot run klist: $!\n";
+    my $pid = open (KLIST, '-|');
+    if (not defined $pid) {
+        die "cannot fork: $!\n";
+    } elsif ($pid == 0) {
+        open (STDERR, '>', '/dev/null') or die "cannot reopen stderr: $!\n";
+        exec ('klist', '-ke', 'keytab')
+            or die "cannot run klist: $!\n";
+    }
     local $_;
     while (<KLIST>) {
         next unless /^ *\d+ /;
-- 
cgit v1.2.3


From e43dd833852f40fb6e9356e7ff8904455d1646ea Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Thu, 30 Aug 2012 14:56:08 -0700
Subject: Fix test counts and an error in the MIT keytab test suite

---
 perl/t/keytab.t | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

(limited to 'perl/t/keytab.t')

diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index fabdc5b..68cd2b4 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 => 135;
+use Test::More tests => 139;
 
 BEGIN { $Wallet::Config::KEYTAB_TMP = '.' }
 
@@ -399,15 +399,15 @@ SKIP: {
 
     # Finally we can test.  First the MIT Kerberos tests.
   SKIP: {
-        skip 'skipping MIT unchanging tests for Heimdal', 12
+        skip 'skipping MIT unchanging tests for Heimdal', 16
             if (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'heimdal');
 
         # We need remctld and Net::Remctl.
         my @path = (split (':', $ENV{PATH}), '/usr/local/sbin', '/usr/sbin');
         my ($remctld) = grep { -x $_ } map { "$_/remctld" } @path;
-        skip 'remctld not found', 12 unless $remctld;
+        skip 'remctld not found', 16 unless $remctld;
         eval { require Net::Remctl };
-        skip 'Net::Remctl not available', 12 if $@;
+        skip 'Net::Remctl not available', 16 if $@;
 
         # Now spawn our remctld server and get a ticket cache.
         remctld_spawn ($remctld, $principal, 't/data/test.keytab',
@@ -441,7 +441,7 @@ SKIP: {
             ' 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);
+        my $data = $one->get (@trace);
         ok (defined ($data), ' and getting the keytab works');
         ok (keytab_valid ($data, 'wallet/one'), ' and the keytab is valid');
         is ($two->get (@trace), undef, 'Get for wallet/two does not work');
-- 
cgit v1.2.3


From c82a0a11a1306a805a3db5813e26bef72984db4c Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Thu, 30 Aug 2012 14:57:44 -0700
Subject: Clean up a file created by the MIT keytab tests

---
 perl/t/keytab.t | 1 +
 1 file changed, 1 insertion(+)

(limited to 'perl/t/keytab.t')

diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index 68cd2b4..01def75 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -451,6 +451,7 @@ SKIP: {
         is ($one->destroy (@trace), 1, 'Destroying wallet/one works');
         is ($two->destroy (@trace), 1, ' as does destroying wallet/two');
         remctld_stop;
+        unlink 'krb5cc_good';
     }
 
     # Now Heimdal.  Since the keytab contains timestamps, before testing for
-- 
cgit v1.2.3


From a30984dc9602e5a7efe9556f337eb21dbcec8319 Mon Sep 17 00:00:00 2001
From: Jon Robertson <jonrober@stanford.edu>
Date: Thu, 31 Jan 2013 14:38:25 -0800
Subject: Fixed errors with Keytab object and its tests

perl/Wallet/Object/Keytab.pm was using the wrong value for the database
handle in some places (trying to load as a subroutine rather than part
of the object).  Also, the keytab.t tests were attempting to run against
the DBIx::Class object rather than a direct dbh handle that they
expected.

Change-Id: Ifbb8b110d559f3ba867fc5b0dc3933fd2d4fd484
Reviewed-on: https://gerrit.stanford.edu/731
Reviewed-by: Russ Allbery <rra@stanford.edu>
Tested-by: Russ Allbery <rra@stanford.edu>
---
 perl/Wallet/Object/Keytab.pm |  8 +++----
 perl/t/keytab.t              | 55 +++++++++++++++++++++++++++++---------------
 2 files changed, 40 insertions(+), 23 deletions(-)

(limited to 'perl/t/keytab.t')

diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm
index 083dae6..b50fb6e 100644
--- a/perl/Wallet/Object/Keytab.pm
+++ b/perl/Wallet/Object/Keytab.pm
@@ -140,8 +140,8 @@ sub sync_set {
         eval {
             my $name = $self->{name};
             my %search = (ks_name => $name);
-            my $sync_rs = $self->dbh->resultset('KeytabSync')
-                ->search (\%search);
+            my $sync_rs = $self->{dbh}->resultset('KeytabSync')
+                ->find (\%search);
             if (defined $sync_rs) {
                 my $target = $sync_rs->ks_target;
                 $sync_rs->delete;
@@ -167,8 +167,8 @@ sub sync_list {
     eval {
         my %search = (ks_name => $self->{name});
         my %attrs = (order_by => 'ks_target');
-        my @syncs = $self->dbh->resultset('KeytabSync')->search (\%search,
-                                                                 \%attrs);
+        my @syncs = $self->{dbh}->resultset('KeytabSync')->search (\%search,
+                                                                   \%attrs);
         for my $sync_rs (@syncs) {
             push (@targets, $sync_rs->ks_target);
         }
diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index 01def75..c263f58 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -13,6 +13,7 @@ use Test::More tests => 139;
 
 BEGIN { $Wallet::Config::KEYTAB_TMP = '.' }
 
+use DBI;
 use Wallet::Admin;
 use Wallet::Config;
 use Wallet::Kadmin;
@@ -146,7 +147,8 @@ db_setup;
 my $admin = eval { Wallet::Admin->new };
 is ($@, '', 'Database connection succeeded');
 is ($admin->reinitialize ($user), 1, 'Database initialization succeeded');
-my $dbh = $admin->dbh;
+my $schema = $admin->dbh;
+my $dbh = $schema->storage->dbh;
 
 # Use this to accumulate the history traces so that we can check history.
 my $history = '';
@@ -173,7 +175,8 @@ SKIP: {
     # Test that object creation without KEYTAB_TMP fails.
     undef $Wallet::Config::KEYTAB_TMP;
     $object = eval {
-        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
       };
     is ($object, undef, 'Creating keytab without KEYTAB_TMP fails');
     is ($@, "KEYTAB_TMP configuration variable not set\n",
@@ -182,7 +185,8 @@ SKIP: {
 
     # Okay, now we can test.  First, create.
     $object = eval {
-        Wallet::Object::Keytab->create ('keytab', "wallet\nf", $dbh, @trace)
+        Wallet::Object::Keytab->create ('keytab', "wallet\nf", $schema,
+                                        @trace)
       };
     is ($object, undef, 'Creating malformed principal fails');
     if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
@@ -192,7 +196,7 @@ SKIP: {
               ' with the right error');
     }
     $object = eval {
-        Wallet::Object::Keytab->create ('keytab', '', $dbh, @trace)
+        Wallet::Object::Keytab->create ('keytab', '', $schema, @trace)
       };
     is ($object, undef, 'Creating empty principal fails');
     if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
@@ -201,7 +205,8 @@ SKIP: {
         like ($@, qr/^error adding principal \@/, ' with the right error');
     }
     $object = eval {
-        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
       };
     if (defined ($object)) {
         ok (defined ($object), 'Creating good principal succeeds');
@@ -212,7 +217,8 @@ SKIP: {
     ok (created ('wallet/one'), ' and the principal was created');
     create ('wallet/two');
     $object = eval {
-        Wallet::Object::Keytab->create ('keytab', 'wallet/two', $dbh, @trace)
+        Wallet::Object::Keytab->create ('keytab', 'wallet/two', $schema,
+                                        @trace)
       };
     if (defined ($object)) {
         ok (defined ($object), 'Creating an existing principal succeeds');
@@ -224,13 +230,13 @@ SKIP: {
     is ($object->error, undef, ' with no error message');
     ok (! created ('wallet/two'), ' and now it does not exist');
     my @name = qw(keytab wallet-test/one);
-    $object = eval { Wallet::Object::Keytab->create (@name, $dbh, @trace) };
+    $object = eval { Wallet::Object::Keytab->create (@name, $schema, @trace) };
     is ($object, undef, 'Creation without permissions fails');
     like ($@, qr{^error adding principal wallet-test/one\@\Q$realm: },
           ' with the right error');
 
     # Now, try retrieving the keytab.
-    $object = Wallet::Object::Keytab->new ('keytab', 'wallet/one', $dbh);
+    $object = Wallet::Object::Keytab->new ('keytab', 'wallet/one', $schema);
     ok (defined ($object), 'Retrieving the object works');
     ok ($object->isa ('Wallet::Object::Keytab'), ' and is the right type');
     is ($object->flag_set ('locked', @trace), 1, ' and setting locked works');
@@ -283,7 +289,8 @@ EOO
 
     # Test principal deletion on object destruction.
     $object = eval {
-        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
       };
     ok (defined ($object), 'Creating good principal succeeds');
     ok (created ('wallet/one'), ' and the principal was created');
@@ -332,7 +339,8 @@ EOO
     # Test configuration errors.
     undef $Wallet::Config::KEYTAB_FILE;
     $object = eval {
-        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
       };
     is ($object, undef, 'Creating with bad configuration fails');
     is ($@, "keytab object implementation not configured\n",
@@ -340,7 +348,8 @@ EOO
     $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab';
     undef $Wallet::Config::KEYTAB_PRINCIPAL;
     $object = eval {
-        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
       };
     is ($object, undef, ' likewise with another missing variable');
     is ($@, "keytab object implementation not configured\n",
@@ -348,7 +357,8 @@ EOO
     $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal');
     undef $Wallet::Config::KEYTAB_REALM;
     $object = eval {
-        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
       };
     is ($object, undef, ' and another');
     is ($@, "keytab object implementation not configured\n",
@@ -356,14 +366,16 @@ EOO
     $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm');
     undef $Wallet::Config::KEYTAB_KRBTYPE;
     $object = eval {
-        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
       };
     is ($object, undef, ' and another');
     is ($@, "keytab object implementation not configured\n",
         ' with the right error');
     $Wallet::Config::KEYTAB_KRBTYPE = 'Active Directory';
     $object = eval {
-        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
       };
     is ($object, undef, ' and one set to an invalid value');
     is ($@, "unknown KEYTAB_KRBTYPE setting: Active Directory\n",
@@ -387,12 +399,14 @@ SKIP: {
 
     # Create the objects for testing and set the unchanging flag.
     my $one = eval {
-        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
       };
     ok (defined ($one), 'Creating wallet/one succeeds');
     is ($one->flag_set ('unchanging', @trace), 1, ' and setting unchanging');
     my $two = eval {
-        Wallet::Object::Keytab->create ('keytab', 'wallet/two', $dbh, @trace);
+        Wallet::Object::Keytab->create ('keytab', 'wallet/two', $schema,
+                                        @trace);
       };
     ok (defined ($two), 'Creating wallet/two succeeds');
     is ($two->flag_set ('unchanging', @trace), 1, ' and setting unchanging');
@@ -507,7 +521,8 @@ SKIP: {
     # Test setting synchronization attributes, which can also be done without
     # configuration.
     my $one = eval {
-        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
       };
     ok (defined ($one), 'Creating wallet/one succeeds');
     my $expected = <<"EOO";
@@ -584,7 +599,8 @@ SKIP: {
     # Create an object for testing and determine the enctypes we have to work
     # with.
     my $one = eval {
-        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
       };
     if (defined ($one)) {
         ok (1, 'Creating wallet/one succeeds');
@@ -730,7 +746,8 @@ EOO
         'Setting a single enctype works');
     is ($one->destroy (@trace), 1, ' and destroying the object works');
     $one = eval {
-        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
       };
     ok (defined ($one), ' as does recreating it');
     @values = $one->attr ('enctypes');
-- 
cgit v1.2.3


From bf18b39b6afe541e6888d32d6a555643cbe9d22e Mon Sep 17 00:00:00 2001
From: Jon Robertson <jonrober@stanford.edu>
Date: Thu, 31 Jan 2013 16:27:49 -0800
Subject: Renamed dbh subroutines and variables for clarity

In moving from DBI to DBIx::Class, we at first left the various
variables the same.  This goes through to update them for the proper
names.

* Wallet::Admin::schema was created to return the schema object (and
similarly for Wallet::Server and Wallet::Report).
* Wallet::Admin::dbh was modified to return the actual DBI handle again
(and similarly for Wallet::Server and Wallet::Report).
* Various places that used $admin->{dbh} were moved to $admin->{schema}.
* Various places using $dbh for the schema object were changed to
$schema.

Change-Id: I00914866e9a8250855a7828474aa9ce0f37b914f
Reviewed-on: https://gerrit.stanford.edu/733
Reviewed-by: Russ Allbery <rra@stanford.edu>
Tested-by: Russ Allbery <rra@stanford.edu>
---
 perl/Wallet/ACL.pm              | 64 ++++++++++++++++-----------------
 perl/Wallet/Admin.pm            | 49 ++++++++++++++-----------
 perl/Wallet/Object/Base.pm      | 80 ++++++++++++++++++++---------------------
 perl/Wallet/Object/File.pm      |  2 +-
 perl/Wallet/Object/Keytab.pm    | 43 +++++++++++-----------
 perl/Wallet/Object/WAKeyring.pm |  2 +-
 perl/Wallet/Report.pm           | 50 ++++++++++++++------------
 perl/Wallet/Schema.pm           |  6 ++--
 perl/Wallet/Server.pm           | 64 +++++++++++++++++++--------------
 perl/t/acl.t                    | 26 +++++++-------
 perl/t/admin.t                  |  4 +--
 perl/t/file.t                   | 14 ++++----
 perl/t/init.t                   |  6 ++--
 perl/t/keytab.t                 |  4 +--
 perl/t/object.t                 | 20 +++++------
 perl/t/server.t                 |  4 +--
 perl/t/wa-keyring.t             | 10 +++---
 17 files changed, 236 insertions(+), 212 deletions(-)

(limited to 'perl/t/keytab.t')

diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm
index 4f51c70..1e62e7b 100644
--- a/perl/Wallet/ACL.pm
+++ b/perl/Wallet/ACL.pm
@@ -32,7 +32,7 @@ $VERSION = '0.07';
 # and the database handle to use for future operations.  If the object
 # doesn't exist, throws an exception.
 sub new {
-    my ($class, $id, $dbh) = @_;
+    my ($class, $id, $schema) = @_;
     my (%search, $data, $name);
     if ($id =~ /^\d+\z/) {
         $search{ac_id} = $id;
@@ -40,7 +40,7 @@ sub new {
         $search{ac_name} = $id;
     }
     eval {
-        $data = $dbh->resultset('Acl')->find (\%search);
+        $data = $schema->resultset('Acl')->find (\%search);
     };
     if ($@) {
         die "cannot search for ACL $id: $@\n";
@@ -48,9 +48,9 @@ sub new {
         die "ACL $id not found\n";
     }
     my $self = {
-        dbh  => $dbh,
-        id   => $data->ac_id,
-        name => $data->ac_name,
+        schema  => $schema,
+        id      => $data->ac_id,
+        name    => $data->ac_name,
     };
     bless ($self, $class);
     return $self;
@@ -60,18 +60,18 @@ sub new {
 # blessed ACL object for it.  Stores the database handle to use and the ID of
 # the newly created ACL in the object.  On failure, throws an exception.
 sub create {
-    my ($class, $name, $dbh, $user, $host, $time) = @_;
+    my ($class, $name, $schema, $user, $host, $time) = @_;
     if ($name =~ /^\d+\z/) {
         die "ACL name may not be all numbers\n";
     }
     $time ||= time;
     my $id;
     eval {
-        my $guard = $dbh->txn_scope_guard;
+        my $guard = $schema->txn_scope_guard;
 
         # Create the new record.
         my %record = (ac_name => $name);
-        my $acl = $dbh->resultset('Acl')->create (\%record);
+        my $acl = $schema->resultset('Acl')->create (\%record);
         $id = $acl->ac_id;
         die "unable to retrieve new ACL ID" unless defined $id;
 
@@ -82,7 +82,7 @@ sub create {
                    ah_by     => $user,
                    ah_from   => $host,
                    ah_on     => $date);
-        my $history = $dbh->resultset('AclHistory')->create (\%record);
+        my $history = $schema->resultset('AclHistory')->create (\%record);
         die "unable to create new history entry" unless defined $history;
 
         $guard->commit;
@@ -91,9 +91,9 @@ sub create {
         die "cannot create ACL $name: $@\n";
     }
     my $self = {
-        dbh  => $dbh,
-        id   => $id,
-        name => $name,
+        schema => $schema,
+        id     => $id,
+        name   => $name,
     };
     bless ($self, $class);
     return $self;
@@ -134,7 +134,7 @@ sub scheme_mapping {
     my $class;
     eval {
         my %search = (as_name => $scheme);
-        my $scheme_rec = $self->{dbh}->resultset('AclScheme')
+        my $scheme_rec = $self->{schema}->resultset('AclScheme')
             ->find (\%search);
         $class = $scheme_rec->as_class;
     };
@@ -169,7 +169,7 @@ sub log_acl {
                   ah_by         => $user,
                   ah_from       => $host,
                   ah_on         => strftime ('%Y-%m-%d %T', localtime $time));
-    $self->{dbh}->resultset('AclHistory')->create (\%record);
+    $self->{schema}->resultset('AclHistory')->create (\%record);
 }
 
 ##############################################################################
@@ -186,9 +186,9 @@ sub rename {
         return;
     }
     eval {
-        my $guard = $self->{dbh}->txn_scope_guard;
+        my $guard = $self->{schema}->txn_scope_guard;
         my %search = (ac_id => $self->{id});
-        my $acls = $self->{dbh}->resultset('Acl')->find (\%search);
+        my $acls = $self->{schema}->resultset('Acl')->find (\%search);
         $acls->ac_name ($name);
         $acls->update;
         $guard->commit;
@@ -212,7 +212,7 @@ sub destroy {
     my ($self, $user, $host, $time) = @_;
     $time ||= time;
     eval {
-        my $guard = $self->{dbh}->txn_scope_guard;
+        my $guard = $self->{schema}->txn_scope_guard;
 
         # Make certain no one is using the ACL.
         my @search = ({ ob_owner       => $self->{id} },
@@ -221,7 +221,7 @@ sub destroy {
                       { ob_acl_show    => $self->{id} },
                       { ob_acl_destroy => $self->{id} },
                       { ob_acl_flags   => $self->{id} });
-        my @entries = $self->{dbh}->resultset('Object')->search (\@search);
+        my @entries = $self->{schema}->resultset('Object')->search (\@search);
         if (@entries) {
             my ($entry) = @entries;
             die "ACL in use by ".$entry->ob_type.":".$entry->ob_name;
@@ -229,14 +229,14 @@ sub destroy {
 
         # Delete any entries (there may or may not be any).
         my %search = (ae_id => $self->{id});
-        @entries = $self->{dbh}->resultset('AclEntry')->search(\%search);
+        @entries = $self->{schema}->resultset('AclEntry')->search(\%search);
         for my $entry (@entries) {
             $entry->delete;
         }
 
         # There should definitely be an ACL record to delete.
         %search = (ac_id => $self->{id});
-        my $entry = $self->{dbh}->resultset('Acl')->find(\%search);
+        my $entry = $self->{schema}->resultset('Acl')->find(\%search);
         $entry->delete if defined $entry;
 
         # Create new history line for the deletion.
@@ -245,7 +245,7 @@ sub destroy {
                       ah_by     => $user,
                       ah_from   => $host,
                       ah_on     => $time);
-        $self->{dbh}->resultset('AclHistory')->create (\%record);
+        $self->{schema}->resultset('AclHistory')->create (\%record);
         $guard->commit;
     };
     if ($@) {
@@ -268,11 +268,11 @@ sub add {
         return;
     }
     eval {
-        my $guard = $self->{dbh}->txn_scope_guard;
+        my $guard = $self->{schema}->txn_scope_guard;
         my %record = (ae_id         => $self->{id},
                       ae_scheme     => $scheme,
                       ae_identifier => $identifier);
-        my $entry = $self->{dbh}->resultset('AclEntry')->create (\%record);
+        my $entry = $self->{schema}->resultset('AclEntry')->create (\%record);
         $self->log_acl ('add', $scheme, $identifier, $user, $host, $time);
         $guard->commit;
     };
@@ -290,11 +290,11 @@ sub remove {
     my ($self, $scheme, $identifier, $user, $host, $time) = @_;
     $time ||= time;
     eval {
-        my $guard = $self->{dbh}->txn_scope_guard;
+        my $guard = $self->{schema}->txn_scope_guard;
         my %search = (ae_id         => $self->{id},
                       ae_scheme     => $scheme,
                       ae_identifier => $identifier);
-        my $entry = $self->{dbh}->resultset('AclEntry')->find (\%search);
+        my $entry = $self->{schema}->resultset('AclEntry')->find (\%search);
         unless (defined $entry) {
             die "entry not found in ACL\n";
         }
@@ -322,9 +322,9 @@ sub list {
     undef $self->{error};
     my @entries;
     eval {
-        my $guard = $self->{dbh}->txn_scope_guard;
+        my $guard = $self->{schema}->txn_scope_guard;
         my %search = (ae_id => $self->{id});
-        my @entry_recs = $self->{dbh}->resultset('AclEntry')
+        my @entry_recs = $self->{schema}->resultset('AclEntry')
             ->search (\%search);
         for my $entry (@entry_recs) {
             push (@entries, [ $entry->ae_scheme, $entry->ae_identifier ]);
@@ -364,11 +364,11 @@ sub history {
     my ($self) = @_;
     my $output = '';
     eval {
-        my $guard = $self->{dbh}->txn_scope_guard;
+        my $guard = $self->{schema}->txn_scope_guard;
         my %search  = (ah_acl => $self->{id});
         my %options = (order_by => 'ah_on');
-        my @data = $self->{dbh}->resultset('AclHistory')->search (\%search,
-                                                                  \%options);
+        my @data = $self->{schema}->resultset('AclHistory')
+            ->search (\%search, \%options);
         for my $data (@data) {
             $output .= sprintf ("%s %s  ", $data->ah_on->ymd,
                                 $data->ah_on->hms);
@@ -512,14 +512,14 @@ references.
 
 =over 4
 
-=item new(ACL, DBH)
+=item new(ACL, SCHEMA)
 
 Instantiate a new ACL object with the given ACL ID or name.  Takes the
 Wallet::Schema object to use for retrieving metadata from the wallet
 database.  Returns a new ACL object if the ACL was found and throws an
 exception if it wasn't or on any other error.
 
-=item create(NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME])
+=item create(NAME, SCHEMA, PRINCIPAL, HOSTNAME [, DATETIME])
 
 Similar to new() in that it instantiates a new ACL object, but instead of
 finding an existing one, creates a new ACL record in the database with the
diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm
index c0b1730..9fc146c 100644
--- a/perl/Wallet/Admin.pm
+++ b/perl/Wallet/Admin.pm
@@ -39,8 +39,8 @@ our $BASE_VERSION = '0.07';
 # Throw an exception if anything goes wrong.
 sub new {
     my ($class) = @_;
-    my $dbh = Wallet::Schema->connect;
-    my $self = { dbh => $dbh };
+    my $schema = Wallet::Schema->connect;
+    my $self = { schema => $schema };
     bless ($self, $class);
     return $self;
 }
@@ -48,7 +48,13 @@ sub new {
 # Returns the database handle (used mostly for testing).
 sub dbh {
     my ($self) = @_;
-    return $self->{dbh};
+    return $self->{schema}->storage->dbh;
+}
+
+# Returns the DBIx::Class-based database schema object.
+sub schema {
+    my ($self) = @_;
+    return $self->{schema};
 }
 
 # Set or return the error stashed in the object.
@@ -66,7 +72,7 @@ sub error {
 # Disconnect the database handle on object destruction to avoid warnings.
 sub DESTROY {
     my ($self) = @_;
-    $self->{dbh}->storage->dbh->disconnect;
+    $self->{schema}->storage->dbh->disconnect;
 }
 
 ##############################################################################
@@ -83,7 +89,7 @@ sub initialize {
 
     # Deploy the database schema from DDL files, if they exist.  If not then
     # we automatically get the database from the Schema modules.
-    $self->{dbh}->deploy ({}, $Wallet::Config::DB_DDL_DIRECTORY);
+    $self->{schema}->deploy ({}, $Wallet::Config::DB_DDL_DIRECTORY);
     if ($@) {
         $self->error ($@);
         return;
@@ -91,7 +97,8 @@ sub initialize {
     $self->default_data;
 
     # Create a default admin ACL.
-    my $acl = Wallet::ACL->create ('ADMIN', $self->{dbh}, $user, 'localhost');
+    my $acl = Wallet::ACL->create ('ADMIN', $self->{schema}, $user,
+                                   'localhost');
     unless ($acl->add ('krb5', $user, $user, 'localhost')) {
         $self->error ($acl->error);
         return;
@@ -106,7 +113,7 @@ sub default_data {
     my ($self) = @_;
 
     # acl_schemes default rows.
-    my ($r1) = $self->{dbh}->resultset('AclScheme')->populate ([
+    my ($r1) = $self->{schema}->resultset('AclScheme')->populate ([
                        [ qw/as_name as_class/ ],
                        [ 'krb5',       'Wallet::ACL::Krb5'            ],
                        [ 'krb5-regex', 'Wallet::ACL::Krb5::Regex'     ],
@@ -120,7 +127,7 @@ sub default_data {
     my @record = ([ qw/ty_name ty_class/ ],
                [ 'file', 'Wallet::Object::File' ],
                [ 'keytab', 'Wallet::Object::Keytab' ]);
-    ($r1) = $self->{dbh}->resultset('Type')->populate (\@record);
+    ($r1) = $self->{schema}->resultset('Type')->populate (\@record);
     warn "default Type not installed" unless defined $r1;
 
     return 1;
@@ -141,13 +148,13 @@ sub destroy {
     my ($self) = @_;
 
     # Get an actual DBI handle and use it to delete all tables.
-    my $real_dbh = $self->{dbh}->storage->dbh;
+    my $dbh = $self->dbh;
     my @tables = qw/acls acl_entries acl_history acl_schemes enctypes
         flags keytab_enctypes keytab_sync objects object_history
         sync_targets types dbix_class_schema_versions/;
     for my $table (@tables) {
         my $sql = "DROP TABLE IF EXISTS $table";
-        $real_dbh->do ($sql);
+        $dbh->do ($sql);
     }
 
     return 1;
@@ -160,9 +167,9 @@ sub backup {
 
     my @dbs = qw/MySQL SQLite PostgreSQL/;
     my $version = $Wallet::Schema::VERSION;
-    $self->{dbh}->create_ddl_dir (\@dbs, $version,
-                                  $Wallet::Config::DB_DDL_DIRECTORY,
-                                  $oldversion);
+    $self->{schema}->create_ddl_dir (\@dbs, $version,
+                                     $Wallet::Config::DB_DDL_DIRECTORY,
+                                     $oldversion);
 
     return 1;
 }
@@ -174,8 +181,8 @@ sub upgrade {
 
     # Check to see if the database is versioned.  If not, install the
     # versioning table and default version.
-    if (!$self->{dbh}->get_db_version) {
-        $self->{dbh}->install ($BASE_VERSION);
+    if (!$self->{schema}->get_db_version) {
+        $self->{schema}->install ($BASE_VERSION);
     }
 
     # Suppress warnings that actually are just informational messages.
@@ -187,8 +194,8 @@ sub upgrade {
     };
 
     # Perform the actual upgrade.
-    if ($self->{dbh}->get_db_version) {
-        eval { $self->{dbh}->upgrade; };
+    if ($self->{schema}->get_db_version) {
+        eval { $self->{schema}->upgrade; };
     }
     if ($@) {
         $self->error ($@);
@@ -210,10 +217,10 @@ sub upgrade {
 sub register_object {
     my ($self, $type, $class) = @_;
     eval {
-        my $guard = $self->{dbh}->txn_scope_guard;
+        my $guard = $self->{schema}->txn_scope_guard;
         my %record = (ty_name  => $type,
                       ty_class => $class);
-        $self->{dbh}->resultset('Type')->create (\%record);
+        $self->{schema}->resultset('Type')->create (\%record);
         $guard->commit;
     };
     if ($@) {
@@ -230,10 +237,10 @@ sub register_object {
 sub register_verifier {
     my ($self, $scheme, $class) = @_;
     eval {
-        my $guard = $self->{dbh}->txn_scope_guard;
+        my $guard = $self->{schema}->txn_scope_guard;
         my %record = (as_name  => $scheme,
                       as_class => $class);
-        $self->{dbh}->resultset('AclScheme')->create (\%record);
+        $self->{schema}->resultset('AclScheme')->create (\%record);
         $guard->commit;
     };
     if ($@) {
diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm
index 5bd89a7..dd128cc 100644
--- a/perl/Wallet/Object/Base.pm
+++ b/perl/Wallet/Object/Base.pm
@@ -36,16 +36,16 @@ $VERSION = '0.06';
 # type in the object.  If the object doesn't exist, returns undef.  This will
 # probably be usable as-is by most object types.
 sub new {
-    my ($class, $type, $name, $dbh) = @_;
+    my ($class, $type, $name, $schema) = @_;
     my %search = (ob_type => $type,
                   ob_name => $name);
-    my $object = $dbh->resultset('Object')->find (\%search);
+    my $object = $schema->resultset('Object')->find (\%search);
     die "cannot find ${type}:${name}\n"
         unless ($object and $object->ob_name eq $name);
     my $self = {
-        dbh  => $dbh,
-        name => $name,
-        type => $type,
+        schema => $schema,
+        name   => $name,
+        type   => $type,
     };
     bless ($self, $class);
     return $self;
@@ -56,11 +56,11 @@ sub new {
 # specified class.  Stores the database handle to use, the name, and the type
 # in the object.  Subclasses may need to override this to do additional setup.
 sub create {
-    my ($class, $type, $name, $dbh, $user, $host, $time) = @_;
+    my ($class, $type, $name, $schema, $user, $host, $time) = @_;
     $time ||= time;
     die "invalid object type\n" unless $type;
     die "invalid object name\n" unless $name;
-    my $guard = $dbh->txn_scope_guard;
+    my $guard = $schema->txn_scope_guard;
     eval {
         my %record = (ob_type         => $type,
                       ob_name         => $name,
@@ -68,7 +68,7 @@ sub create {
                       ob_created_from => $host,
                       ob_created_on   => strftime ('%Y-%m-%d %T',
                                                    localtime $time));
-        $dbh->resultset('Object')->create (\%record);
+        $schema->resultset('Object')->create (\%record);
 
         %record = (oh_type   => $type,
                    oh_name   => $name,
@@ -76,7 +76,7 @@ sub create {
                    oh_by     => $user,
                    oh_from   => $host,
                    oh_on     => strftime ('%Y-%m-%d %T', localtime $time));
-        $dbh->resultset('ObjectHistory')->create (\%record);
+        $schema->resultset('ObjectHistory')->create (\%record);
 
         $guard->commit;
     };
@@ -84,9 +84,9 @@ sub create {
         die "cannot create object ${type}:${name}: $@\n";
     }
     my $self = {
-        dbh  => $dbh,
-        name => $name,
-        type => $type,
+        schema => $schema,
+        name   => $name,
+        type   => $type,
     };
     bless ($self, $class);
     return $self;
@@ -136,7 +136,7 @@ sub log_action {
     # We have two traces to record, one in the object_history table and one in
     # the object record itself.  Commit both changes as a transaction.  We
     # assume that AutoCommit is turned off.
-    my $guard = $self->{dbh}->txn_scope_guard;
+    my $guard = $self->{schema}->txn_scope_guard;
     eval {
         my %record = (oh_type   => $self->{type},
                       oh_name   => $self->{name},
@@ -144,11 +144,11 @@ sub log_action {
                       oh_by     => $user,
                       oh_from   => $host,
                       oh_on     => strftime ('%Y-%m-%d %T', localtime $time));
-        $self->{dbh}->resultset('ObjectHistory')->create (\%record);
+        $self->{schema}->resultset('ObjectHistory')->create (\%record);
 
         my %search = (ob_type   => $self->{type},
                       ob_name   => $self->{name});
-        my $object = $self->{dbh}->resultset('Object')->find (\%search);
+        my $object = $self->{schema}->resultset('Object')->find (\%search);
         if ($action eq 'get') {
             $object->ob_downloaded_by   ($user);
             $object->ob_downloaded_from ($host);
@@ -202,7 +202,7 @@ sub log_set {
                   oh_by         => $user,
                   oh_from       => $host,
                   oh_on         => strftime ('%Y-%m-%d %T', localtime $time));
-    $self->{dbh}->resultset('ObjectHistory')->create (\%record);
+    $self->{schema}->resultset('ObjectHistory')->create (\%record);
 }
 
 ##############################################################################
@@ -225,11 +225,11 @@ sub _set_internal {
         return;
     }
 
-    my $guard = $self->{dbh}->txn_scope_guard;
+    my $guard = $self->{schema}->txn_scope_guard;
     eval {
         my %search = (ob_type => $type,
                       ob_name => $name);
-        my $object = $self->{dbh}->resultset('Object')->find (\%search);
+        my $object = $self->{schema}->resultset('Object')->find (\%search);
         my $old = $object->get_column ("ob_$attr");
 
         $object->update ({ "ob_$attr" => $value });
@@ -261,7 +261,7 @@ sub _get_internal {
     eval {
         my %search = (ob_type => $type,
                       ob_name => $name);
-        my $object = $self->{dbh}->resultset('Object')->find (\%search);
+        my $object = $self->{schema}->resultset('Object')->find (\%search);
         $value = $object->get_column ($attr);
     };
     if ($@) {
@@ -282,7 +282,7 @@ sub acl {
     my $attr = "acl_$type";
     if ($id) {
         my $acl;
-        eval { $acl = Wallet::ACL->new ($id, $self->{dbh}) };
+        eval { $acl = Wallet::ACL->new ($id, $self->{schema}) };
         if ($@) {
             $self->error ($@);
             return;
@@ -352,7 +352,7 @@ sub owner {
     my ($self, $owner, $user, $host, $time) = @_;
     if ($owner) {
         my $acl;
-        eval { $acl = Wallet::ACL->new ($owner, $self->{dbh}) };
+        eval { $acl = Wallet::ACL->new ($owner, $self->{schema}) };
         if ($@) {
             $self->error ($@);
             return;
@@ -375,13 +375,13 @@ sub flag_check {
     my ($self, $flag) = @_;
     my $name = $self->{name};
     my $type = $self->{type};
-    my $dbh = $self->{dbh};
+    my $schema = $self->{schema};
     my $value;
     eval {
         my %search = (fl_type => $type,
                       fl_name => $name,
                       fl_flag => $flag);
-        my $flag = $dbh->resultset('Flag')->find (\%search);
+        my $flag = $schema->resultset('Flag')->find (\%search);
         if (not defined $flag) {
             $value = 0;
         } else {
@@ -403,13 +403,13 @@ sub flag_clear {
     $time ||= time;
     my $name = $self->{name};
     my $type = $self->{type};
-    my $dbh = $self->{dbh};
-    my $guard = $dbh->txn_scope_guard;
+    my $schema = $self->{schema};
+    my $guard = $schema->txn_scope_guard;
     eval {
         my %search = (fl_type => $type,
                       fl_name => $name,
                       fl_flag => $flag);
-        my $flag = $dbh->resultset('Flag')->find (\%search);
+        my $flag = $schema->resultset('Flag')->find (\%search);
         unless (defined $flag) {
             die "flag not set\n";
         }
@@ -435,8 +435,8 @@ sub flag_list {
         my %search = (fl_type => $self->{type},
                       fl_name => $self->{name});
         my %attrs  = (order_by => 'fl_flag');
-        my @flags_rs = $self->{dbh}->resultset('Flag')->search (\%search,
-                                                                \%attrs);
+        my @flags_rs = $self->{schema}->resultset('Flag')->search (\%search,
+                                                                   \%attrs);
         for my $flag (@flags_rs) {
             push (@flags, $flag->fl_flag);
         }
@@ -457,17 +457,17 @@ sub flag_set {
     $time ||= time;
     my $name = $self->{name};
     my $type = $self->{type};
-    my $dbh = $self->{dbh};
-    my $guard = $dbh->txn_scope_guard;
+    my $schema = $self->{schema};
+    my $guard = $schema->txn_scope_guard;
     eval {
         my %search = (fl_type => $type,
                       fl_name => $name,
                       fl_flag => $flag);
-        my $flag = $dbh->resultset('Flag')->find (\%search);
+        my $flag = $schema->resultset('Flag')->find (\%search);
         if (defined $flag) {
             die "flag already set\n";
         }
-        $flag = $dbh->resultset('Flag')->create (\%search);
+        $flag = $schema->resultset('Flag')->create (\%search);
         $self->log_set ('flags', undef, $flag->fl_flag, $user, $host, $time);
         $guard->commit;
     };
@@ -489,7 +489,7 @@ sub format_acl_id {
     my $name = $id;
 
     my %search = (ac_id => $id);
-    my $acl_rs = $self->{dbh}->resultset('Acl')->find (\%search);
+    my $acl_rs = $self->{schema}->resultset('Acl')->find (\%search);
     if (defined $acl_rs) {
         $name = $acl_rs->ac_name . " ($id)";
     }
@@ -507,7 +507,7 @@ sub history {
         my %search = (oh_type => $self->{type},
                       oh_name => $self->{name});
         my %attrs = (order_by => 'oh_on');
-        my @history = $self->{dbh}->resultset('ObjectHistory')
+        my @history = $self->{schema}->resultset('ObjectHistory')
             ->search (\%search, \%attrs);
 
         for my $history_rs (@history) {
@@ -620,7 +620,7 @@ sub show {
     eval {
         my %search = (ob_type => $type,
                       ob_name => $name);
-        $object_rs = $self->{dbh}->resultset('Object')->find (\%search);
+        $object_rs = $self->{schema}->resultset('Object')->find (\%search);
     };
     if ($@) {
         $self->error ("cannot retrieve data for ${type}:${name}: $@");
@@ -658,7 +658,7 @@ sub show {
             $output .= $attr_output;
         }
         if ($field =~ /^ob_(owner|acl_)/) {
-            my $acl = eval { Wallet::ACL->new ($value, $self->{dbh}) };
+            my $acl = eval { Wallet::ACL->new ($value, $self->{schema}) };
             if ($acl and not $@) {
                 $value = $acl->name || $value;
                 push (@acls, [ $acl, $value ]);
@@ -688,18 +688,18 @@ sub destroy {
         $self->error ("cannot destroy ${type}:${name}: object is locked");
         return;
     }
-    my $guard = $self->{dbh}->txn_scope_guard;
+    my $guard = $self->{schema}->txn_scope_guard;
     eval {
 
         # Remove any flags that may exist for the record.
         my %search = (fl_type => $type,
                       fl_name => $name);
-        $self->{dbh}->resultset('Flag')->search (\%search)->delete;
+        $self->{schema}->resultset('Flag')->search (\%search)->delete;
 
         # Remove any object records
         %search = (ob_type => $type,
                    ob_name => $name);
-        $self->{dbh}->resultset('Object')->search (\%search)->delete;
+        $self->{schema}->resultset('Object')->search (\%search)->delete;
 
         # And create a new history object for the destroy action.
         my %record = (oh_type => $type,
@@ -708,7 +708,7 @@ sub destroy {
                       oh_by     => $user,
                       oh_from   => $host,
                       oh_on     => strftime ('%Y-%m-%d %T', localtime $time));
-        $self->{dbh}->resultset('ObjectHistory')->create (\%record);
+        $self->{schema}->resultset('ObjectHistory')->create (\%record);
         $guard->commit;
     };
     if ($@) {
diff --git a/perl/Wallet/Object/File.pm b/perl/Wallet/Object/File.pm
index 47c8ac2..69468e1 100644
--- a/perl/Wallet/Object/File.pm
+++ b/perl/Wallet/Object/File.pm
@@ -143,7 +143,7 @@ API HOSTNAME DATETIME keytab remctld backend nul Allbery wallet-backend
 
     my @name = qw(file mysql-lsdb)
     my @trace = ($user, $host, time);
-    my $object = Wallet::Object::Keytab->create (@name, $dbh, @trace);
+    my $object = Wallet::Object::Keytab->create (@name, $schema, @trace);
     unless ($object->store ("the-password\n")) {
         die $object->error, "\n";
     }
diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm
index b50fb6e..962c19b 100644
--- a/perl/Wallet/Object/Keytab.pm
+++ b/perl/Wallet/Object/Keytab.pm
@@ -40,12 +40,12 @@ sub enctypes_set {
     my @trace = ($user, $host, $time);
     my $name = $self->{name};
     my %enctypes = map { $_ => 1 } @$enctypes;
-    my $guard = $self->{dbh}->txn_scope_guard;
+    my $guard = $self->{schema}->txn_scope_guard;
     eval {
 
         # Find all enctypes for the given keytab.
         my %search = (ke_name => $name);
-        my @enctypes = $self->{dbh}->resultset('KeytabEnctype')
+        my @enctypes = $self->{schema}->resultset('KeytabEnctype')
             ->search (\%search);
         my (@current);
         for my $enctype_rs (@enctypes) {
@@ -61,7 +61,7 @@ sub enctypes_set {
             } else {
                 %search = (ke_name    => $name,
                            ke_enctype => $enctype);
-                $self->{dbh}->resultset('KeytabEnctype')->find (\%search)
+                $self->{schema}->resultset('KeytabEnctype')->find (\%search)
                     ->delete;
                 $self->log_set ('type_data enctypes', $enctype, undef, @trace);
             }
@@ -73,13 +73,13 @@ sub enctypes_set {
         # to make it easier to test.
         for my $enctype (sort keys %enctypes) {
             my %search = (en_name => $enctype);
-            my $enctype_rs = $self->{dbh}->('Enctype')->find (\%search);
+            my $enctype_rs = $self->{schema}->('Enctype')->find (\%search);
             unless (defined $enctype_rs) {
                 die "unknown encryption type $enctype\n";
             }
             my %record = (ke_name    => $name,
                           ke_enctype => $enctype);
-            $self->{dbh}->resultset('Enctype')->create (\%record);
+            $self->{schema}->resultset('Enctype')->create (\%record);
             $self->log_set ('type_data enctypes', undef, $enctype, @trace);
         }
         $guard->commit;
@@ -101,7 +101,7 @@ sub enctypes_list {
     eval {
         my %search = (ke_name => $self->{name});
         my %attrs = (order_by => 'ke_enctype');
-        my @enctypes_rs = $self->{dbh}->resultset('KeytabEnctype')
+        my @enctypes_rs = $self->{schema}->resultset('KeytabEnctype')
             ->search (\%search, \%attrs);
         for my $enctype_rs (@enctypes_rs) {
             push (@enctypes, $enctype_rs->ke_enctype);
@@ -136,11 +136,11 @@ sub sync_set {
         $self->error ("unsupported synchronization target $target");
         return;
     } else {
-        my $guard = $self->{dbh}->txn_scope_guard;
+        my $guard = $self->{schema}->txn_scope_guard;
         eval {
             my $name = $self->{name};
             my %search = (ks_name => $name);
-            my $sync_rs = $self->{dbh}->resultset('KeytabSync')
+            my $sync_rs = $self->{schema}->resultset('KeytabSync')
                 ->find (\%search);
             if (defined $sync_rs) {
                 my $target = $sync_rs->ks_target;
@@ -167,8 +167,8 @@ sub sync_list {
     eval {
         my %search = (ks_name => $self->{name});
         my %attrs = (order_by => 'ks_target');
-        my @syncs = $self->{dbh}->resultset('KeytabSync')->search (\%search,
-                                                                   \%attrs);
+        my @syncs = $self->{schema}->resultset('KeytabSync')->search (\%search,
+                                                                      \%attrs);
         for my $sync_rs (@syncs) {
             push (@targets, $sync_rs->ks_target);
         }
@@ -239,16 +239,16 @@ sub attr_show {
 # Override new to start by creating a handle for the kadmin module we're
 # using.
 sub new {
-    my ($class, $type, $name, $dbh) = @_;
+    my ($class, $type, $name, $schema) = @_;
      my $self = {
-        dbh    => $dbh,
+        schema => $schema,
         kadmin => undef,
     };
     bless $self, $class;
     my $kadmin = Wallet::Kadmin->new ();
     $self->{kadmin} = $kadmin;
 
-    $self = $class->SUPER::new ($type, $name, $dbh);
+    $self = $class->SUPER::new ($type, $name, $schema);
     $self->{kadmin} = $kadmin;
     return $self;
 }
@@ -258,9 +258,9 @@ sub new {
 # great here since we don't have a way to communicate the error back to the
 # caller.
 sub create {
-    my ($class, $type, $name, $dbh, $creator, $host, $time) = @_;
+    my ($class, $type, $name, $schema, $creator, $host, $time) = @_;
     my $self = {
-        dbh    => $dbh,
+        schema => $schema,
         kadmin => undef,
     };
     bless $self, $class;
@@ -270,7 +270,8 @@ sub create {
     if (not $kadmin->create ($name)) {
         die $kadmin->error, "\n";
     }
-    $self = $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time);
+    $self = $class->SUPER::create ($type, $name, $schema, $creator, $host,
+                                   $time);
     $self->{kadmin} = $kadmin;
     return $self;
 }
@@ -283,15 +284,15 @@ sub destroy {
         $self->error ("cannot destroy $id: object is locked");
         return;
     }
-    my $dbh = $self->{dbh};
-    my $guard = $dbh->txn_scope_guard;
+    my $schema = $self->{schema};
+    my $guard = $schema->txn_scope_guard;
     eval {
         my %search = (ks_name => $self->{name});
-        my $sync_rs = $dbh->resultset('KeytabSync')->search (\%search);
+        my $sync_rs = $schema->resultset('KeytabSync')->search (\%search);
         $sync_rs->delete_all if defined $sync_rs;
 
         %search = (ke_name => $self->{name});
-        my $enctype_rs = $dbh->resultset('KeytabEnctype')->search (\%search);
+        my $enctype_rs = $schema->resultset('KeytabEnctype')->search (\%search);
         $enctype_rs->delete_all if defined $enctype_rs;
 
         $guard->commit;
@@ -353,7 +354,7 @@ Wallet::Object::Keytab - Keytab object implementation for wallet
 
     my @name = qw(keytab host/shell.example.com);
     my @trace = ($user, $host, time);
-    my $object = Wallet::Object::Keytab->create (@name, $dbh, @trace);
+    my $object = Wallet::Object::Keytab->create (@name, $schema, @trace);
     my $keytab = $object->get (@trace);
     $object->destroy (@trace);
 
diff --git a/perl/Wallet/Object/WAKeyring.pm b/perl/Wallet/Object/WAKeyring.pm
index b26be58..f33497c 100644
--- a/perl/Wallet/Object/WAKeyring.pm
+++ b/perl/Wallet/Object/WAKeyring.pm
@@ -255,7 +255,7 @@ Wallet::Object::WAKeyring - WebAuth keyring object implementation for wallet
     my ($user, $host, $time);
     my @name = qw(wa-keyring www.stanford.edu);
     my @trace = ($user, $host, $time);
-    my $object = Wallet::Object::WAKeyring->create (@name, $dbh, $trace);
+    my $object = Wallet::Object::WAKeyring->create (@name, $schema, $trace);
     my $keyring = $object->get (@trace);
     unless ($object->store ($keyring)) {
         die $object->error, "\n";
diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm
index ea8cd2f..ff25b3a 100644
--- a/perl/Wallet/Report.pm
+++ b/perl/Wallet/Report.pm
@@ -32,8 +32,8 @@ $VERSION = '0.04';
 # exception if anything goes wrong.
 sub new {
     my ($class) = @_;
-    my $dbh = Wallet::Schema->connect;
-    my $self = { dbh => $dbh };
+    my $schema = Wallet::Schema->connect;
+    my $self = { schema => $schema };
     bless ($self, $class);
     return $self;
 }
@@ -41,7 +41,13 @@ sub new {
 # Returns the database handle (used mostly for testing).
 sub dbh {
     my ($self) = @_;
-    return $self->{dbh};
+    return $self->{schema}->storage->dbh;
+}
+
+# Returns the DBIx::Class-based database schema object.
+sub schema {
+    my ($self) = @_;
+    return $self->{schema};
 }
 
 # Set or return the error stashed in the object.
@@ -59,7 +65,7 @@ sub error {
 # Disconnect the database handle on object destruction to avoid warnings.
 sub DESTROY {
     my ($self) = @_;
-    $self->{dbh}->storage->dbh->disconnect;
+    $self->{schema}->storage->dbh->disconnect;
 }
 
 ##############################################################################
@@ -106,7 +112,7 @@ sub objects_owner {
     if (lc ($owner) eq 'null') {
         %search = (ob_owner => undef);
     } else {
-        my $acl = eval { Wallet::ACL->new ($owner, $self->{dbh}) };
+        my $acl = eval { Wallet::ACL->new ($owner, $self->{schema}) };
         return unless $acl;
         %search = (ob_owner => $acl->id);
     }
@@ -138,8 +144,8 @@ sub objects_acl {
     my ($self, $search) = @_;
     my @objects;
 
-    my $dbh = $self->{dbh};
-    my $acl = eval { Wallet::ACL->new ($search, $dbh) };
+    my $schema = $self->{schema};
+    my $acl = eval { Wallet::ACL->new ($search, $schema) };
     return unless $acl;
 
     my @search = ({ ob_owner       => $acl->id },
@@ -202,10 +208,10 @@ sub objects {
 
     # Perform the search and return on any errors.
     my @objects;
-    my $dbh = $self->{dbh};
+    my $schema = $self->{schema};
     eval {
-        my @objects_rs = $dbh->resultset('Object')->search ($search_ref,
-                                                            $options_ref);
+        my @objects_rs = $schema->resultset('Object')->search ($search_ref,
+                                                               $options_ref);
         for my $object_rs (@objects_rs) {
             push (@objects, [ $object_rs->ob_type, $object_rs->ob_name ]);
         }
@@ -228,13 +234,13 @@ sub acls_all {
     my ($self) = @_;
     my @acls;
 
-    my $dbh = $self->{dbh};
+    my $schema = $self->{schema};
     my %search = ();
     my %options = (order_by => [ qw/ac_id/ ],
                    select   => [ qw/ac_id ac_name/ ]);
 
     eval {
-        my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options);
+        my @acls_rs = $schema->resultset('Acl')->search (\%search, \%options);
         for my $acl_rs (@acls_rs) {
             push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]);
         }
@@ -252,7 +258,7 @@ sub acls_empty {
     my ($self) = @_;
     my @acls;
 
-    my $dbh = $self->{dbh};
+    my $schema = $self->{schema};
     my %search = (ae_id => undef);
     my %options = (join     => 'acl_entries',
                    prefetch => 'acl_entries',
@@ -260,7 +266,7 @@ sub acls_empty {
                    select   => [ qw/ac_id ac_name/ ]);
 
     eval {
-        my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options);
+        my @acls_rs = $schema->resultset('Acl')->search (\%search, \%options);
         for my $acl_rs (@acls_rs) {
             push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]);
         }
@@ -280,7 +286,7 @@ sub acls_entry {
     my ($self, $type, $identifier) = @_;
     my @acls;
 
-    my $dbh = $self->{dbh};
+    my $schema = $self->{schema};
     my %search = (ae_scheme     => $type,
                   ae_identifier => { like => '%'.$identifier.'%' });
     my %options = (join     => 'acl_entries',
@@ -290,7 +296,7 @@ sub acls_entry {
                    distinct => 1);
 
     eval {
-        my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options);
+        my @acls_rs = $schema->resultset('Acl')->search (\%search, \%options);
         for my $acl_rs (@acls_rs) {
             push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]);
         }
@@ -308,7 +314,7 @@ sub acls_unused {
     my ($self) = @_;
     my @acls;
 
-    my $dbh = $self->{dbh};
+    my $schema = $self->{schema};
     my %search = (
                   #'acls_owner.ob_owner'   => undef,
                   #'acls_get.ob_owner'     => undef,
@@ -322,7 +328,7 @@ sub acls_unused {
                    select   => [ qw/ac_id ac_name/ ]);
 
     eval {
-        my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options);
+        my @acls_rs = $schema->resultset('Acl')->search (\%search, \%options);
 
         # FIXME: Almost certainly a way of doing this with the search itself.
         for my $acl_rs (@acls_rs) {
@@ -347,7 +353,7 @@ sub acls_unused {
 # on error and setting the internal error.
 sub acl_membership {
     my ($self, $id) = @_;
-    my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) };
+    my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) };
     if ($@) {
         $self->error ($@);
         return;
@@ -433,7 +439,7 @@ sub acls {
 sub owners {
     my ($self, $type, $name) = @_;
     undef $self->{error};
-    my $dbh = $self->{dbh};
+    my $schema = $self->{schema};
 
     my @owners;
     eval {
@@ -446,8 +452,8 @@ sub owners {
                        distinct => 1,
                       );
 
-        my @acls_rs = $dbh->resultset('AclEntry')->search (\%search,
-                                                           \%options);
+        my @acls_rs = $schema->resultset('AclEntry')->search (\%search,
+                                                              \%options);
         for my $acl_rs (@acls_rs) {
             my $scheme = $acl_rs->ae_scheme;
             my $identifier = $acl_rs->ae_identifier;
diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm
index d36b7ac..cee94f7 100644
--- a/perl/Wallet/Schema.pm
+++ b/perl/Wallet/Schema.pm
@@ -40,11 +40,11 @@ sub connect {
     my $user = $Wallet::Config::DB_USER;
     my $pass = $Wallet::Config::DB_PASSWORD;
     my %attrs = (PrintError => 0, RaiseError => 1);
-    my $dbh = eval { $class->SUPER::connect ($dsn, $user, $pass, \%attrs) };
+    my $schema = eval { $class->SUPER::connect ($dsn, $user, $pass, \%attrs) };
     if ($@) {
         die "cannot connect to database: $@\n";
     }
-    return $dbh;
+    return $schema;
 }
 
 __END__
@@ -62,7 +62,7 @@ Wallet::Schema - Database schema and connector for the wallet system
 =head1 SYNOPSIS
 
     use Wallet::Schema;
-    my $dbh = Wallet::Schema->connect;
+    my $schema = Wallet::Schema->connect;
 
 =head1 DESCRIPTION
 
diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm
index 402fbe0..db53f6c 100644
--- a/perl/Wallet/Server.pm
+++ b/perl/Wallet/Server.pm
@@ -37,13 +37,13 @@ $VERSION = '0.11';
 # for various things.  Throw an exception if anything goes wrong.
 sub new {
     my ($class, $user, $host) = @_;
-    my $dbh = Wallet::Schema->connect;
-    my $acl = Wallet::ACL->new ('ADMIN', $dbh);
+    my $schema = Wallet::Schema->connect;
+    my $acl = Wallet::ACL->new ('ADMIN', $schema);
     my $self = {
-        dbh   => $dbh,
-        user  => $user,
-        host  => $host,
-        admin => $acl,
+        schema => $schema,
+        user   => $user,
+        host   => $host,
+        admin  => $acl,
     };
     bless ($self, $class);
     return $self;
@@ -52,7 +52,13 @@ sub new {
 # Returns the database handle (used mostly for testing).
 sub dbh {
     my ($self) = @_;
-    return $self->{dbh};
+    return $self->{schema}->storage->dbh;
+}
+
+# Returns the DBIx::Class-based database schema object.
+sub schema {
+    my ($self) = @_;
+    return $self->{schema};
 }
 
 # Set or return the error stashed in the object.
@@ -71,8 +77,8 @@ sub error {
 sub DESTROY {
     my ($self) = @_;
 
-    if ($self->{dbh}) {
-        $self->{dbh}->storage->dbh->disconnect;
+    if ($self->{schema}) {
+        $self->{schema}->storage->dbh->disconnect;
     }
 }
 
@@ -86,9 +92,9 @@ sub type_mapping {
     my ($self, $type) = @_;
     my $class;
     eval {
-        my $guard = $self->{dbh}->txn_scope_guard;
+        my $guard = $self->{schema}->txn_scope_guard;
         my %search = (ty_name => $type);
-        my $type_rec = $self->{dbh}->resultset('Type')->find (\%search);
+        my $type_rec = $self->{schema}->resultset('Type')->find (\%search);
         $class = $type_rec->ty_class;
         $guard->commit;
     };
@@ -118,7 +124,7 @@ sub create_check {
     my ($self, $type, $name) = @_;
     my $user = $self->{user};
     my $host = $self->{host};
-    my $dbh = $self->{dbh};
+    my $schema = $self->{schema};
     unless (defined (&Wallet::Config::default_owner)) {
         $self->error ("$user not authorized to create ${type}:${name}");
         return;
@@ -128,9 +134,9 @@ sub create_check {
         $self->error ("$user not authorized to create ${type}:${name}");
         return;
     }
-    my $acl = eval { Wallet::ACL->new ($aname, $dbh) };
+    my $acl = eval { Wallet::ACL->new ($aname, $schema) };
     if ($@) {
-        $acl = eval { Wallet::ACL->create ($aname, $dbh, $user, $host) };
+        $acl = eval { Wallet::ACL->create ($aname, $schema, $user, $host) };
         if ($@) {
             $self->error ($@);
             return;
@@ -181,10 +187,10 @@ sub create_object {
         $self->error ("unknown object type $type");
         return;
     }
-    my $dbh = $self->{dbh};
+    my $schema = $self->{schema};
     my $user = $self->{user};
     my $host = $self->{host};
-    my $object = eval { $class->create ($type, $name, $dbh, $user, $host) };
+    my $object = eval { $class->create ($type, $name, $schema, $user, $host) };
     if ($@) {
         $self->error ($@);
         return;
@@ -246,7 +252,7 @@ sub retrieve {
         $self->error ("unknown object type $type");
         return;
     }
-    my $object = eval { $class->new ($type, $name, $self->{dbh}) };
+    my $object = eval { $class->new ($type, $name, $self->{schema}) };
     if ($@) {
         $self->error ($@);
         return;
@@ -302,7 +308,7 @@ sub acl_verify {
         $self->object_error ($object, $action);
         return;
     }
-    my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) };
+    my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) };
     if ($@) {
         $self->error ($@);
         return;
@@ -556,7 +562,7 @@ sub flag_set {
 # and undef if there was an error in checking the existence of the object.
 sub acl_check {
     my ($self, $id) = @_;
-    my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) };
+    my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) };
     if ($@) {
         if ($@ =~ /^ACL .* not found/) {
             return 0;
@@ -585,8 +591,8 @@ sub acl_create {
             return;
         }
     }
-    my $dbh = $self->{dbh};
-    my $acl = eval { Wallet::ACL->create ($name, $dbh, $user, $host) };
+    my $schema = $self->{schema};
+    my $acl = eval { Wallet::ACL->create ($name, $schema, $user, $host) };
     if ($@) {
         $self->error ($@);
         return;
@@ -617,7 +623,7 @@ sub acl_history {
         $self->acl_error ($id, 'history');
         return;
     }
-    my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) };
+    my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) };
     if ($@) {
         $self->error ($@);
         return;
@@ -637,7 +643,7 @@ sub acl_show {
         $self->acl_error ($id, 'show');
         return;
     }
-    my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) };
+    my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) };
     if ($@) {
         $self->error ($@);
         return;
@@ -658,7 +664,7 @@ sub acl_rename {
         $self->acl_error ($id, 'rename');
         return;
     }
-    my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) };
+    my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) };
     if ($@) {
         $self->error ($@);
         return;
@@ -689,7 +695,7 @@ sub acl_destroy {
         $self->acl_error ($id, 'destroy');
         return;
     }
-    my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) };
+    my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) };
     if ($@) {
         $self->error ($@);
         return;
@@ -713,7 +719,7 @@ sub acl_add {
         $self->acl_error ($id, 'add');
         return;
     }
-    my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) };
+    my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) };
     if ($@) {
         $self->error ($@);
         return;
@@ -733,7 +739,7 @@ sub acl_remove {
         $self->acl_error ($id, 'remove');
         return;
     }
-    my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) };
+    my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) };
     if ($@) {
         $self->error ($@);
         return;
@@ -975,6 +981,10 @@ mostly for testing; normally, clients should perform all actions through
 the Wallet::Server object to ensure that authorization and history logging
 is done properly.
 
+=item schema()
+
+Returns the DBIx::Class schema object.
+
 =item error()
 
 Returns the error of the last failing operation or undef if no operations
diff --git a/perl/t/acl.t b/perl/t/acl.t
index f169eb5..62eb411 100755
--- a/perl/t/acl.t
+++ b/perl/t/acl.t
@@ -29,30 +29,30 @@ db_setup;
 my $setup = eval { Wallet::Admin->new };
 is ($@, '', 'Database connection succeeded');
 is ($setup->reinitialize ($setup), 1, 'Database initialization succeeded');
-my $dbh = $setup->dbh;
+my $schema = $setup->schema;
 
 # Test create and new.
-my $acl = eval { Wallet::ACL->create ('test', $dbh, @trace) };
+my $acl = eval { Wallet::ACL->create ('test', $schema, @trace) };
 ok (defined ($acl), 'ACL creation');
 is ($@, '', ' with no exceptions');
 ok ($acl->isa ('Wallet::ACL'), ' and the right class');
 is ($acl->name, 'test', ' and the right name');
 is ($acl->id, 2, ' and the right ID');
-$acl = eval { Wallet::ACL->create (3, $dbh, @trace) };
+$acl = eval { Wallet::ACL->create (3, $schema, @trace) };
 ok (!defined ($acl), 'Creating with a numeric name');
 is ($@, "ACL name may not be all numbers\n", ' with the right error message');
-$acl = eval { Wallet::ACL->create ('test', $dbh, @trace) };
+$acl = eval { Wallet::ACL->create ('test', $schema, @trace) };
 ok (!defined ($acl), 'Creating a duplicate object');
 like ($@, qr/^cannot create ACL test: /, ' with the right error message');
-$acl = eval { Wallet::ACL->new ('test2', $dbh) };
+$acl = eval { Wallet::ACL->new ('test2', $schema) };
 ok (!defined ($acl), 'Searching for a non-existent ACL');
 is ($@, "ACL test2 not found\n", ' with the right error message');
-$acl = eval { Wallet::ACL->new ('test', $dbh) };
+$acl = eval { Wallet::ACL->new ('test', $schema) };
 ok (defined ($acl), 'Searching for the test ACL by name');
 is ($@, '', ' with no exceptions');
 ok ($acl->isa ('Wallet::ACL'), ' and the right class');
 is ($acl->id, 2, ' and the right ID');
-$acl = eval { Wallet::ACL->new (2, $dbh) };
+$acl = eval { Wallet::ACL->new (2, $schema) };
 ok (defined ($acl), 'Searching for the test ACL by ID');
 is ($@, '', ' with no exceptions');
 ok ($acl->isa ('Wallet::ACL'), ' and the right class');
@@ -66,15 +66,15 @@ if ($acl->rename ('example')) {
 }
 is ($acl->name, 'example', ' and the new name is right');
 is ($acl->id, 2, ' and the ID did not change');
-$acl = eval { Wallet::ACL->new ('test', $dbh) };
+$acl = eval { Wallet::ACL->new ('test', $schema) };
 ok (!defined ($acl), ' and it cannot be found under the old name');
 is ($@, "ACL test not found\n", ' with the right error message');
-$acl = eval { Wallet::ACL->new ('example', $dbh) };
+$acl = eval { Wallet::ACL->new ('example', $schema) };
 ok (defined ($acl), ' and it can be found with the new name');
 is ($@, '', ' with no exceptions');
 is ($acl->name, 'example', ' and the right name');
 is ($acl->id, 2, ' and the right ID');
-$acl = eval { Wallet::ACL->new (2, $dbh) };
+$acl = eval { Wallet::ACL->new (2, $schema) };
 ok (defined ($acl), ' and it can still found by ID');
 is ($@, '', ' with no exceptions');
 is ($acl->name, 'example', ' and the right name');
@@ -212,13 +212,13 @@ if ($acl->destroy (@trace)) {
 } else {
     is ($acl->error, '', 'Destroying the ACL works');
 }
-$acl = eval { Wallet::ACL->new ('example', $dbh) };
+$acl = eval { Wallet::ACL->new ('example', $schema) };
 ok (!defined ($acl), ' and now cannot be found');
 is ($@, "ACL example not found\n", ' with the right error message');
-$acl = eval { Wallet::ACL->new (2, $dbh) };
+$acl = eval { Wallet::ACL->new (2, $schema) };
 ok (!defined ($acl), ' or by ID');
 is ($@, "ACL 2 not found\n", ' with the right error message');
-$acl = eval { Wallet::ACL->create ('example', $dbh, @trace) };
+$acl = eval { Wallet::ACL->create ('example', $schema, @trace) };
 ok (defined ($acl), ' and creating another with the same name works');
 is ($@, '', ' with no exceptions');
 is ($acl->name, 'example', ' and the right name');
diff --git a/perl/t/admin.t b/perl/t/admin.t
index cf6a637..ff69ee9 100755
--- a/perl/t/admin.t
+++ b/perl/t/admin.t
@@ -63,11 +63,11 @@ $Wallet::Schema::VERSION = '0.07';
 is ($admin->reinitialize ('admin@EXAMPLE.COM'), 1,
     ' and re-initialization succeeds');
 $Wallet::Schema::VERSION = '0.08';
-my $schema = $admin->dbh;
+my $schema = $admin->schema;
 $schema->upgrade_directory ('sql/');
 my $retval = $admin->upgrade;
 is ($retval, 1, 'Performing an upgrade succeeds');
-my $dbh = $schema->storage->dbh;
+my $dbh = $admin->dbh;
 my $sql = "select version from dbix_class_schema_versions order by version "
     ."DESC";
 $version = $dbh->selectall_arrayref ($sql);
diff --git a/perl/t/file.t b/perl/t/file.t
index a821c4f..f902fba 100755
--- a/perl/t/file.t
+++ b/perl/t/file.t
@@ -31,7 +31,7 @@ db_setup;
 my $admin = eval { Wallet::Admin->new };
 is ($@, '', 'Database connection succeeded');
 is ($admin->reinitialize ($user), 1, 'Database initialization succeeded');
-my $dbh = $admin->dbh;
+my $schema = $admin->schema;
 
 # Use this to accumulate the history traces so that we can check history.
 my $history = '';
@@ -39,7 +39,7 @@ my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]);
 
 # Test error handling in the absence of configuration.
 $object = eval {
-    Wallet::Object::File->create ('file', 'test', $dbh, @trace)
+    Wallet::Object::File->create ('file', 'test', $schema, @trace)
   };
 ok (defined ($object), 'Creating a basic file object succeeds');
 ok ($object->isa ('Wallet::Object::File'), ' and is the right class');
@@ -55,7 +55,7 @@ $Wallet::Config::FILE_BUCKET = 'test-files';
 
 # Okay, now we can test.  First, the basic object without store.
 $object = eval {
-    Wallet::Object::File->create ('file', 'test', $dbh, @trace)
+    Wallet::Object::File->create ('file', 'test', $schema, @trace)
   };
 ok (defined ($object), 'Creating a basic file object succeeds');
 ok ($object->isa ('Wallet::Object::File'), ' and is the right class');
@@ -66,7 +66,7 @@ is ($object->destroy (@trace), 1, ' but destroying the object succeeds');
 
 # Now store something and be sure that we get something reasonable.
 $object = eval {
-    Wallet::Object::File->create ('file', 'test', $dbh, @trace)
+    Wallet::Object::File->create ('file', 'test', $schema, @trace)
   };
 ok (defined ($object), 'Recreating the object succeeds');
 is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds');
@@ -103,7 +103,7 @@ ok (! -f 'test-files/09/test', ' and the file is gone');
 
 # Now try some aggressive names.
 $object = eval {
-    Wallet::Object::File->create ('file', '../foo', $dbh, @trace)
+    Wallet::Object::File->create ('file', '../foo', $schema, @trace)
   };
 ok (defined ($object), 'Creating ../foo succeeds');
 is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds');
@@ -115,7 +115,7 @@ is ($object->get (@trace), "foo\n", ' and get returns correctly');
 is ($object->destroy (@trace), 1, 'Destroying the object works');
 ok (! -f 'test-files/39/%2E%2E%2Ffoo', ' and the file is gone');
 $object = eval {
-    Wallet::Object::File->create ('file', "\0", $dbh, @trace)
+    Wallet::Object::File->create ('file', "\0", $schema, @trace)
   };
 ok (defined ($object), 'Creating nul succeeds');
 is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds');
@@ -130,7 +130,7 @@ ok (! -f 'test-files/93/%00', ' and the file is gone');
 # Test error handling in the file store.
 system ('rm -r test-files') == 0 or die "cannot remove test-files\n";
 $object = eval {
-    Wallet::Object::File->create ('file', 'test', $dbh, @trace)
+    Wallet::Object::File->create ('file', 'test', $schema, @trace)
   };
 ok (defined ($object), 'Recreating the object succeeds');
 is ($object->store ("foo\n", @trace), undef,
diff --git a/perl/t/init.t b/perl/t/init.t
index 213aedf..aa028e3 100755
--- a/perl/t/init.t
+++ b/perl/t/init.t
@@ -24,7 +24,7 @@ is ($admin->initialize ('admin@EXAMPLE.COM'), 1,
     ' and initialization succeeds');
 
 # Check whether the database entries that should be created were.
-my $acl = eval { Wallet::ACL->new ('ADMIN', $admin->dbh) };
+my $acl = eval { Wallet::ACL->new ('ADMIN', $admin->schema) };
 is ($@, '', 'Retrieving ADMIN ACL successful');
 ok ($acl->isa ('Wallet::ACL'), ' and is the right class');
 my @entries = $acl->list;
@@ -38,7 +38,7 @@ is ($admin->reinitialize ('admin@EXAMPLE.ORG'), 1,
     'Reinitialization succeeded');
 
 # Now repeat the database content checks.
-$acl = eval { Wallet::ACL->new ('ADMIN', $admin->dbh) };
+$acl = eval { Wallet::ACL->new ('ADMIN', $admin->schema) };
 is ($@, '', 'Retrieving ADMIN ACL successful');
 ok ($acl->isa ('Wallet::ACL'), ' and is the right class');
 @entries = $acl->list;
@@ -49,7 +49,7 @@ is ($entries[0][1], 'admin@EXAMPLE.ORG', ' with the right user');
 
 # Test cleanup.
 is ($admin->destroy, 1, 'Destroying the database works');
-$acl = eval { Wallet::ACL->new ('ADMIN', $admin->dbh) };
+$acl = eval { Wallet::ACL->new ('ADMIN', $admin->schema) };
 like ($@, qr/^cannot search for ACL ADMIN: /,
       ' and now the database is gone');
 unlink 'wallet-db';
diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index c263f58..561f130 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -147,8 +147,8 @@ db_setup;
 my $admin = eval { Wallet::Admin->new };
 is ($@, '', 'Database connection succeeded');
 is ($admin->reinitialize ($user), 1, 'Database initialization succeeded');
-my $schema = $admin->dbh;
-my $dbh = $schema->storage->dbh;
+my $schema = $admin->schema;
+my $dbh = $admin->dbh;
 
 # Use this to accumulate the history traces so that we can check history.
 my $history = '';
diff --git a/perl/t/object.t b/perl/t/object.t
index 2d60dd2..5eb6941 100755
--- a/perl/t/object.t
+++ b/perl/t/object.t
@@ -30,26 +30,26 @@ db_setup;
 my $admin = eval { Wallet::Admin->new };
 is ($@, '', 'Database connection succeeded');
 is ($admin->reinitialize ($user), 1, 'Database initialization succeeded');
-my $dbh = $admin->dbh;
+my $schema = $admin->schema;
 
 # Okay, now we have a database.  Test create and new.  We make believe this is
 # a keytab object; it won't matter for what we're doing.
 my $object = eval {
-    Wallet::Object::Base->create ('keytab', $princ, $dbh, @trace)
+    Wallet::Object::Base->create ('keytab', $princ, $schema, @trace)
   };
 is ($@, '', 'Object creation did not die');
 ok ($object->isa ('Wallet::Object::Base'), ' and returned the right class');
 my $other = eval {
-    Wallet::Object::Base->create ('keytab', $princ, $dbh, @trace)
+    Wallet::Object::Base->create ('keytab', $princ, $schema, @trace)
   };
 like ($@, qr/^cannot create object \Qkeytab:$princ: /, 'Repeating fails');
-$other = eval { Wallet::Object::Base->create ('', $princ, $dbh, @trace) };
+$other = eval { Wallet::Object::Base->create ('', $princ, $schema, @trace) };
 is ($@, "invalid object type\n", 'Using an empty type fails');
-$other = eval { Wallet::Object::Base->create ('keytab', '', $dbh, @trace) };
+$other = eval { Wallet::Object::Base->create ('keytab', '', $schema, @trace) };
 is ($@, "invalid object name\n", ' as does an empty name');
-$object = eval { Wallet::Object::Base->new ('keytab', "a$princ", $dbh) };
+$object = eval { Wallet::Object::Base->new ('keytab', "a$princ", $schema) };
 is ($@, "cannot find keytab:a$princ\n", 'Searching for unknown object fails');
-$object = eval { Wallet::Object::Base->new ('keytab', $princ, $dbh) };
+$object = eval { Wallet::Object::Base->new ('keytab', $princ, $schema) };
 is ($@, '', 'Object new did not die');
 ok ($object->isa ('Wallet::Object::Base'), ' and returned the right class');
 
@@ -58,7 +58,7 @@ is ($object->type, 'keytab', 'Type accessor works');
 is ($object->name, $princ, 'Name accessor works');
 
 # We'll use this for later tests.
-my $acl = Wallet::ACL->new ('ADMIN', $dbh);
+my $acl = Wallet::ACL->new ('ADMIN', $schema);
 
 # Owner.
 is ($object->owner, undef, 'Owner is not set to start');
@@ -266,12 +266,12 @@ if ($object->destroy (@trace)) {
 } else {
     is ($object->error, '', 'Destroy is successful');
 }
-$object = eval { Wallet::Object::Base->new ('keytab', $princ, $dbh) };
+$object = eval { Wallet::Object::Base->new ('keytab', $princ, $schema) };
 is ($@, "cannot find keytab:$princ\n", ' and object is all gone');
 
 # Test history.
 $object = eval {
-    Wallet::Object::Base->create ('keytab', $princ, $dbh, @trace)
+    Wallet::Object::Base->create ('keytab', $princ, $schema, @trace)
   };
 ok (defined ($object), 'Recreating the object succeeds');
 $output = <<"EOO";
diff --git a/perl/t/server.t b/perl/t/server.t
index 63f2e76..8474989 100755
--- a/perl/t/server.t
+++ b/perl/t/server.t
@@ -36,8 +36,8 @@ is ($setup->reinitialize ($admin), 1, 'Database initialization succeeded');
 $server = eval { Wallet::Server->new (@trace) };
 is ($@, '', 'Reopening with new did not die');
 ok ($server->isa ('Wallet::Server'), ' and returned the right class');
-my $dbh = $server->dbh;
-ok (defined ($dbh), ' and returns a defined database handle');
+my $schema = $server->schema;
+ok (defined ($schema), ' and returns a defined schema object');
 
 # Allow creation of base objects for testing purposes.
 $setup->register_object ('base', 'Wallet::Object::Base');
diff --git a/perl/t/wa-keyring.t b/perl/t/wa-keyring.t
index 703b7fe..3011d54 100755
--- a/perl/t/wa-keyring.t
+++ b/perl/t/wa-keyring.t
@@ -40,14 +40,14 @@ db_setup;
 my $admin = eval { Wallet::Admin->new };
 is ($@, '', 'Database connection succeeded');
 is ($admin->reinitialize ($user), 1, 'Database initialization succeeded');
-my $dbh = $admin->dbh;
+my $schema = $admin->schema;
 
 # Create a WebAuth context to use.
 my $wa = WebAuth->new;
 
 # Test error handling in the absence of configuration.
 my $object = eval {
-    Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $dbh, @trace)
+    Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace)
   };
 ok (defined ($object), 'Creating a basic WebAuth keyring object succeeds');
 ok ($object->isa ('Wallet::Object::WAKeyring'), ' and is the right class');
@@ -65,7 +65,7 @@ $Wallet::Config::WAKEYRING_BUCKET = 'test-keyrings';
 
 # Okay, now we can test.  First, the basic object without store.
 $object = eval {
-    Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $dbh, @trace)
+    Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace)
   };
 ok (defined ($object), 'Creating a basic WebAuth keyring object succeeds');
 ok ($object->isa ('Wallet::Object::WAKeyring'), ' and is the right class');
@@ -100,7 +100,7 @@ is ($object->destroy (@trace), 1, 'Destroying the object succeeds');
 
 # Now store something and be sure that we get something reasonable.
 $object = eval {
-    Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $dbh, @trace)
+    Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace)
   };
 ok (defined ($object), 'Recreating the object succeeds');
 my $key = WebAuth::Key->new ($wa, WA_KEY_AES, WA_AES_128);
@@ -159,7 +159,7 @@ is ($object->destroy (@trace), 1, 'Destroying the object succeeds');
 # Test error handling in the file store.
 system ('rm -r test-keyrings') == 0 or die "cannot remove test-keyrings\n";
 $object = eval {
-    Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $dbh, @trace)
+    Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace)
   };
 ok (defined ($object), 'Recreating the object succeeds');
 is ($object->get (@trace), undef, ' but retrieving it fails');
-- 
cgit v1.2.3


From 4d11772001f65264bf714711550acdbb05900f4c Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Wed, 27 Feb 2013 14:46:47 -0800
Subject: Use correct form of Stanford's copyright statement

Change-Id: I06dd9ecca19315179bdd34d4b301548fe7604331
Reviewed-on: https://gerrit.stanford.edu/842
Reviewed-by: Russ Allbery <rra@stanford.edu>
Tested-by: Russ Allbery <rra@stanford.edu>
---
 client/file.c                 | 3 ++-
 client/internal.h             | 3 ++-
 client/keytab.c               | 3 ++-
 client/krb5.c                 | 3 ++-
 client/options.c              | 2 +-
 client/remctl.c               | 3 ++-
 client/srvtab.c               | 3 ++-
 client/wallet-rekey.c         | 3 ++-
 client/wallet.c               | 2 +-
 configure.ac                  | 4 +---
 contrib/convert-srvtab-db     | 3 ++-
 contrib/used-principals       | 3 ++-
 contrib/wallet-contacts       | 3 ++-
 contrib/wallet-summary        | 3 ++-
 contrib/wallet-unknown-hosts  | 3 ++-
 examples/stanford.conf        | 3 ++-
 perl/Wallet/ACL.pm            | 3 ++-
 perl/Wallet/ACL/Base.pm       | 3 ++-
 perl/Wallet/ACL/Krb5.pm       | 3 ++-
 perl/Wallet/ACL/Krb5/Regex.pm | 3 ++-
 perl/Wallet/ACL/NetDB.pm      | 3 ++-
 perl/Wallet/ACL/NetDB/Root.pm | 3 ++-
 perl/Wallet/Config.pm         | 3 ++-
 perl/Wallet/Database.pm       | 3 ++-
 perl/Wallet/Kadmin.pm         | 3 ++-
 perl/Wallet/Kadmin/Heimdal.pm | 3 ++-
 perl/Wallet/Kadmin/MIT.pm     | 2 +-
 perl/Wallet/Object/File.pm    | 3 ++-
 perl/Wallet/Object/Keytab.pm  | 4 ++--
 perl/Wallet/Report.pm         | 3 ++-
 perl/create-ddl               | 3 ++-
 perl/t/acl.t                  | 3 ++-
 perl/t/config.t               | 3 ++-
 perl/t/file.t                 | 3 ++-
 perl/t/init.t                 | 3 ++-
 perl/t/keytab.t               | 2 +-
 perl/t/lib/Util.pm            | 3 ++-
 perl/t/pod.t                  | 3 ++-
 perl/t/report.t               | 3 ++-
 perl/t/verifier-netdb.t       | 3 ++-
 perl/t/verifier.t             | 3 ++-
 server/keytab-backend         | 2 +-
 server/wallet-report          | 3 ++-
 tests/client/basic-t.in       | 2 +-
 tests/client/full-t.in        | 3 ++-
 tests/client/prompt-t.in      | 3 ++-
 tests/client/rekey-t.in       | 2 +-
 tests/data/cmd-fake           | 4 +++-
 tests/data/fake-kadmin        | 3 ++-
 tests/server/keytab-t         | 3 ++-
 tests/server/report-t         | 3 ++-
 51 files changed, 95 insertions(+), 54 deletions(-)

(limited to 'perl/t/keytab.t')

diff --git a/client/file.c b/client/file.c
index 861da6a..c171969 100644
--- a/client/file.c
+++ b/client/file.c
@@ -2,7 +2,8 @@
  * File handling for the wallet client.
  *
  * Written by Russ Allbery <rra@stanford.edu>
- * Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+ * Copyright 2007, 2008, 2010
+ *     The Board of Trustees of the Leland Stanford Junior University
  *
  * See LICENSE for licensing terms.
  */
diff --git a/client/internal.h b/client/internal.h
index c8e5802..24dd875 100644
--- a/client/internal.h
+++ b/client/internal.h
@@ -2,7 +2,8 @@
  * Internal support functions for the wallet client.
  *
  * Written by Russ Allbery <rra@stanford.edu>
- * Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+ * Copyright 2007, 2008, 2010
+ *     The Board of Trustees of the Leland Stanford Junior University
  *
  * See LICENSE for licensing terms.
  */
diff --git a/client/keytab.c b/client/keytab.c
index 6614c4b..0a3e419 100644
--- a/client/keytab.c
+++ b/client/keytab.c
@@ -2,7 +2,8 @@
  * Implementation of keytab handling for the wallet client.
  *
  * Written by Russ Allbery <rra@stanford.edu>
- * Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+ * Copyright 2007, 2008, 2010, 2013
+ *     The Board of Trustees of the Leland Stanford Junior University
  *
  * See LICENSE for licensing terms.
  */
diff --git a/client/krb5.c b/client/krb5.c
index aad39f6..e86a225 100644
--- a/client/krb5.c
+++ b/client/krb5.c
@@ -6,7 +6,8 @@
  * client.
  *
  * Written by Russ Allbery <rra@stanford.edu>
- * Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+ * Copyright 2007, 2008, 2010
+ *     The Board of Trustees of the Leland Stanford Junior University
  */
 
 #include <config.h>
diff --git a/client/options.c b/client/options.c
index 2f1de70..67ecb7f 100644
--- a/client/options.c
+++ b/client/options.c
@@ -6,7 +6,7 @@
  *
  * Written by Russ Allbery <rra@stanford.edu>
  * Copyright 2006, 2007, 2008, 2010
- *     Board of Trustees, Leland Stanford Jr. University
+ *     The Board of Trustees of the Leland Stanford Junior University
  *
  * See LICENSE for licensing terms.
  */
diff --git a/client/remctl.c b/client/remctl.c
index 5a541d5..071e410 100644
--- a/client/remctl.c
+++ b/client/remctl.c
@@ -2,7 +2,8 @@
  * remctl interface for the wallet client.
  *
  * Written by Russ Allbery <rra@stanford.edu>
- * Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University
+ * Copyright 2007, 2010
+ *     The Board of Trustees of the Leland Stanford Junior University
  *
  * See LICENSE for licensing terms.
  */
diff --git a/client/srvtab.c b/client/srvtab.c
index b26e6fc..73277e9 100644
--- a/client/srvtab.c
+++ b/client/srvtab.c
@@ -2,7 +2,8 @@
  * Implementation of srvtab handling for the wallet client.
  *
  * Written by Russ Allbery <rra@stanford.edu>
- * Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+ * Copyright 2007, 2008, 2010
+ *     The Board of Trustees of the Leland Stanford Junior University
  *
  * See LICENSE for licensing terms.
  */
diff --git a/client/wallet-rekey.c b/client/wallet-rekey.c
index 3a9687c..5007f41 100644
--- a/client/wallet-rekey.c
+++ b/client/wallet-rekey.c
@@ -3,7 +3,8 @@
  *
  * Written by Russ Allbery <rra@stanford.edu>
  *        and Jon Robertson <jonrober@stanford.edu>
- * Copyright 2010 Board of Trustees, Leland Stanford Jr. University
+ * Copyright 2010
+ *     The Board of Trustees of the Leland Stanford Junior University
  *
  * See LICENSE for licensing terms.
  */
diff --git a/client/wallet.c b/client/wallet.c
index dc04dcd..c5a7877 100644
--- a/client/wallet.c
+++ b/client/wallet.c
@@ -3,7 +3,7 @@
  *
  * Written by Russ Allbery <rra@stanford.edu>
  * Copyright 2006, 2007, 2008, 2010
- *     Board of Trustees, Leland Stanford Jr. University
+ *     The Board of Trustees of the Leland Stanford Junior University
  *
  * See LICENSE for licensing terms.
  */
diff --git a/configure.ac b/configure.ac
index a79e42d..4fc218b 100644
--- a/configure.ac
+++ b/configure.ac
@@ -2,12 +2,10 @@ dnl Autoconf configuration for wallet.
 dnl
 dnl Written by Russ Allbery <rra@stanford.edu>
 dnl Copyright 2006, 2007, 2008, 2010
-dnl     Board of Trustees, Leland Stanford Jr. University
+dnl     The Board of Trustees of the Leland Stanford Junior University
 dnl
 dnl See LICENSE for licensing terms.
 
-dnl We cannot use -Wall -Werror with AM_INIT_AUTOMAKE since we override
-dnl distuninstallcheck (not supported by Perl).
 AC_PREREQ([2.64])
 AC_INIT([wallet], [0.12], [rra@stanford.edu])
 AC_CONFIG_AUX_DIR([build-aux])
diff --git a/contrib/convert-srvtab-db b/contrib/convert-srvtab-db
index 8d3b31e..6263472 100755
--- a/contrib/convert-srvtab-db
+++ b/contrib/convert-srvtab-db
@@ -3,7 +3,8 @@
 # convert-srvtab-db -- Converts a leland_srvtab database to wallet
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/contrib/used-principals b/contrib/used-principals
index aa838fe..ca431e3 100755
--- a/contrib/used-principals
+++ b/contrib/used-principals
@@ -3,7 +3,8 @@
 # used-principals -- Report which Kerberos v5 principals are in use.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/contrib/wallet-contacts b/contrib/wallet-contacts
index 177fc76..907c161 100755
--- a/contrib/wallet-contacts
+++ b/contrib/wallet-contacts
@@ -3,7 +3,8 @@
 # wallet-contacts -- Report contact addresses for matching wallet objects.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2009 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2009
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/contrib/wallet-summary b/contrib/wallet-summary
index aba8406..2237351 100755
--- a/contrib/wallet-summary
+++ b/contrib/wallet-summary
@@ -3,7 +3,8 @@
 # wallet-summary -- Summarize keytabs in the wallet database.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2003, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2003, 2008, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/contrib/wallet-unknown-hosts b/contrib/wallet-unknown-hosts
index da972b2..e19dcf0 100755
--- a/contrib/wallet-unknown-hosts
+++ b/contrib/wallet-unknown-hosts
@@ -3,7 +3,8 @@
 # wallet-unknown-hosts -- Report host keytabs in wallet for unknown hosts.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/examples/stanford.conf b/examples/stanford.conf
index becfc6e..1d14796 100644
--- a/examples/stanford.conf
+++ b/examples/stanford.conf
@@ -6,7 +6,8 @@
 # ACL rules.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm
index 1e62e7b..5d9e8f2 100644
--- a/perl/Wallet/ACL.pm
+++ b/perl/Wallet/ACL.pm
@@ -1,7 +1,8 @@
 # Wallet::ACL -- Implementation of ACLs in the wallet system.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2010, 2013
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/Wallet/ACL/Base.pm b/perl/Wallet/ACL/Base.pm
index 85eaefa..5112c2f 100644
--- a/perl/Wallet/ACL/Base.pm
+++ b/perl/Wallet/ACL/Base.pm
@@ -1,7 +1,8 @@
 # Wallet::ACL::Base -- Parent class for wallet ACL verifiers.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/Wallet/ACL/Krb5.pm b/perl/Wallet/ACL/Krb5.pm
index 12be141..716a223 100644
--- a/perl/Wallet/ACL/Krb5.pm
+++ b/perl/Wallet/ACL/Krb5.pm
@@ -1,7 +1,8 @@
 # Wallet::ACL::Krb5 -- Wallet Kerberos v5 principal ACL verifier.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/Wallet/ACL/Krb5/Regex.pm b/perl/Wallet/ACL/Krb5/Regex.pm
index 8f9702e..ce2fe48 100644
--- a/perl/Wallet/ACL/Krb5/Regex.pm
+++ b/perl/Wallet/ACL/Krb5/Regex.pm
@@ -1,7 +1,8 @@
 # Wallet::ACL::Krb5::Regex -- Wallet Kerberos v5 principal regex ACL verifier
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/Wallet/ACL/NetDB.pm b/perl/Wallet/ACL/NetDB.pm
index 0aa8958..2d35f49 100644
--- a/perl/Wallet/ACL/NetDB.pm
+++ b/perl/Wallet/ACL/NetDB.pm
@@ -1,7 +1,8 @@
 # Wallet::ACL::NetDB -- Wallet NetDB role ACL verifier.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/Wallet/ACL/NetDB/Root.pm b/perl/Wallet/ACL/NetDB/Root.pm
index c28bb1e..ea79d79 100644
--- a/perl/Wallet/ACL/NetDB/Root.pm
+++ b/perl/Wallet/ACL/NetDB/Root.pm
@@ -1,7 +1,8 @@
 # Wallet::ACL::NetDB::Root -- Wallet NetDB role ACL verifier (root instances).
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm
index 9649c6c..af153e7 100644
--- a/perl/Wallet/Config.pm
+++ b/perl/Wallet/Config.pm
@@ -1,7 +1,8 @@
 # Wallet::Config -- Configuration handling for the wallet server.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2010, 2013
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/Wallet/Database.pm b/perl/Wallet/Database.pm
index 8df338a..61de0ba 100644
--- a/perl/Wallet/Database.pm
+++ b/perl/Wallet/Database.pm
@@ -6,7 +6,8 @@
 # like DBIx::Class objects in the rest of the code.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008-2012 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008, 2009, 2010, 2012, 2013
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm
index 074dd1e..bfff3ef 100644
--- a/perl/Wallet/Kadmin.pm
+++ b/perl/Wallet/Kadmin.pm
@@ -1,7 +1,8 @@
 # Wallet::Kadmin -- Kerberos administration API for wallet keytab backend.
 #
 # Written by Jon Robertson <jonrober@stanford.edu>
-# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2009, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm
index 6c91b1d..bb07b93 100644
--- a/perl/Wallet/Kadmin/Heimdal.pm
+++ b/perl/Wallet/Kadmin/Heimdal.pm
@@ -1,7 +1,8 @@
 # Wallet::Kadmin::Heimdal -- Wallet Kerberos administration API for Heimdal.
 #
 # Written by Jon Robertson <jonrober@stanford.edu>
-# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2009, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm
index c191bc9..b633e67 100644
--- a/perl/Wallet/Kadmin/MIT.pm
+++ b/perl/Wallet/Kadmin/MIT.pm
@@ -3,7 +3,7 @@
 # Written by Russ Allbery <rra@stanford.edu>
 # Pulled into a module by Jon Robertson <jonrober@stanford.edu>
 # Copyright 2007, 2008, 2009, 2010
-#     Board of Trustees, Leland Stanford Jr. University
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/Wallet/Object/File.pm b/perl/Wallet/Object/File.pm
index 69468e1..49589f1 100644
--- a/perl/Wallet/Object/File.pm
+++ b/perl/Wallet/Object/File.pm
@@ -1,7 +1,8 @@
 # Wallet::Object::File -- File object implementation for the wallet.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm
index 962c19b..e00747b 100644
--- a/perl/Wallet/Object/Keytab.pm
+++ b/perl/Wallet/Object/Keytab.pm
@@ -1,8 +1,8 @@
 # Wallet::Object::Keytab -- Keytab object implementation for the wallet.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2009, 2010
-#     Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2009, 2010, 2013
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm
index ff25b3a..b27a998 100644
--- a/perl/Wallet/Report.pm
+++ b/perl/Wallet/Report.pm
@@ -1,7 +1,8 @@
 # Wallet::Report -- Wallet system reporting interface.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008, 2009, 2010, 2013
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/create-ddl b/perl/create-ddl
index 62deb86..10f126a 100755
--- a/perl/create-ddl
+++ b/perl/create-ddl
@@ -3,7 +3,8 @@
 # create-ddl - Create DDL files for Wallet
 #
 # Written by Jon Robertson <jonrober@stanford.edu>
-# Copyright 2012 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2012
+#     The Board of Trustees of the Leland Stanford Junior University
 
 #############################################################################
 # Modules and declarations
diff --git a/perl/t/acl.t b/perl/t/acl.t
index 62eb411..26b4903 100755
--- a/perl/t/acl.t
+++ b/perl/t/acl.t
@@ -3,7 +3,8 @@
 # Tests for the wallet ACL API.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/t/config.t b/perl/t/config.t
index 6b9f226..543e5d6 100755
--- a/perl/t/config.t
+++ b/perl/t/config.t
@@ -3,7 +3,8 @@
 # Tests for the wallet server configuration.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/t/file.t b/perl/t/file.t
index f902fba..5cb7c35 100755
--- a/perl/t/file.t
+++ b/perl/t/file.t
@@ -3,7 +3,8 @@
 # Tests for the file object implementation.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/t/init.t b/perl/t/init.t
index aa028e3..142f54c 100755
--- a/perl/t/init.t
+++ b/perl/t/init.t
@@ -3,7 +3,8 @@
 # Tests for database initialization.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index 561f130..3ced592 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -4,7 +4,7 @@
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2007, 2008, 2009, 2010
-#     Board of Trustees, Leland Stanford Jr. University
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm
index c15ccfe..3e606fe 100644
--- a/perl/t/lib/Util.pm
+++ b/perl/t/lib/Util.pm
@@ -1,7 +1,8 @@
 # Utility class for wallet tests.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/t/pod.t b/perl/t/pod.t
index c467b82..dc5f468 100755
--- a/perl/t/pod.t
+++ b/perl/t/pod.t
@@ -3,7 +3,8 @@
 # Test POD formatting for the wallet Perl modules.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/t/report.t b/perl/t/report.t
index 13ef7b6..a6b85df 100755
--- a/perl/t/report.t
+++ b/perl/t/report.t
@@ -3,7 +3,8 @@
 # Tests for the wallet reporting interface.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008, 2009, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/t/verifier-netdb.t b/perl/t/verifier-netdb.t
index 6bd4e73..398cc6a 100755
--- a/perl/t/verifier-netdb.t
+++ b/perl/t/verifier-netdb.t
@@ -7,7 +7,8 @@
 # environments.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/perl/t/verifier.t b/perl/t/verifier.t
index f56f5fa..75f1afa 100755
--- a/perl/t/verifier.t
+++ b/perl/t/verifier.t
@@ -3,7 +3,8 @@
 # Tests for the basic wallet ACL verifiers.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/server/keytab-backend b/server/keytab-backend
index 7b6adb4..3ea3df0 100755
--- a/server/keytab-backend
+++ b/server/keytab-backend
@@ -18,7 +18,7 @@
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2006, 2007, 2008, 2010
-#     Board of Trustees, Leland Stanford Jr. University
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/server/wallet-report b/server/wallet-report
index 992f5b8..0fd8aa9 100755
--- a/server/wallet-report
+++ b/server/wallet-report
@@ -3,7 +3,8 @@
 # wallet-report -- Wallet server reporting interface.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008, 2009, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/tests/client/basic-t.in b/tests/client/basic-t.in
index 11f0bce..836f394 100644
--- a/tests/client/basic-t.in
+++ b/tests/client/basic-t.in
@@ -4,7 +4,7 @@
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2006, 2007, 2008, 2010
-#     Board of Trustees, Leland Stanford Jr. University
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/tests/client/full-t.in b/tests/client/full-t.in
index 680e78f..ebdba03 100644
--- a/tests/client/full-t.in
+++ b/tests/client/full-t.in
@@ -3,7 +3,8 @@
 # End-to-end tests for the wallet client.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/tests/client/prompt-t.in b/tests/client/prompt-t.in
index 682cd70..06991cc 100644
--- a/tests/client/prompt-t.in
+++ b/tests/client/prompt-t.in
@@ -3,7 +3,8 @@
 # Password prompting tests for the wallet client.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/tests/client/rekey-t.in b/tests/client/rekey-t.in
index 390a362..0cfcb5d 100644
--- a/tests/client/rekey-t.in
+++ b/tests/client/rekey-t.in
@@ -4,7 +4,7 @@
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2006, 2007, 2008, 2010
-#     Board of Trustees, Leland Stanford Jr. University
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/tests/data/cmd-fake b/tests/data/cmd-fake
index add72fc..11791a6 100755
--- a/tests/data/cmd-fake
+++ b/tests/data/cmd-fake
@@ -4,7 +4,9 @@
 # the client test suite.  It doesn't test any of the wallet server code.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
+#
 # See LICENSE for licensing terms.
 
 command="$1"
diff --git a/tests/data/fake-kadmin b/tests/data/fake-kadmin
index 4c0ceac..c073ea5 100755
--- a/tests/data/fake-kadmin
+++ b/tests/data/fake-kadmin
@@ -3,7 +3,8 @@
 # Fake kadmin.local used to test the keytab backend.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/tests/server/keytab-t b/tests/server/keytab-t
index 2a0ceed..a9f5450 100755
--- a/tests/server/keytab-t
+++ b/tests/server/keytab-t
@@ -3,7 +3,8 @@
 # Tests for the keytab-backend dispatch code.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2006, 2007, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2006, 2007, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
diff --git a/tests/server/report-t b/tests/server/report-t
index 0771946..43ec9d1 100755
--- a/tests/server/report-t
+++ b/tests/server/report-t
@@ -3,7 +3,8 @@
 # Tests for the wallet-report dispatch code.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008, 2009, 2010
+#     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
-- 
cgit v1.2.3


From e44a0417cde0235c2fc368e86acea3d257816958 Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
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 <rra@stanford.edu>
Tested-by: Russ Allbery <rra@stanford.edu>
---
 perl/t/kadmin.t | 4 ++--
 perl/t/keytab.t | 4 ++--
 2 files changed, 4 insertions(+), 4 deletions(-)

(limited to 'perl/t/keytab.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 <jonrober@stanford.edu>
-# 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 <rra@stanford.edu>
-# 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