Switch to Module::Build for the Perl module

The wallet server now requires Perl 5.8 or later (instead of 5.006 in
previous versions) and is now built with Module::Build instead of
ExtUtils::MakeMaker.  This should be transparent to anyone not working
with the source code, since Perl 5.8 was released in 2002, but
Module::Build is now required to build the wallet server.  It is
included in some versions of Perl, or can be installed separately from
CPAN, distribution packages, or other sources.

Also reorganize the test suite to use subdirectories.

Change-Id: Id06120ba2bad1ebbfee3d8a48ca2f25869463165
Reviewed-on: https://gerrit.stanford.edu/1530
Reviewed-by: Russ Allbery <rra@stanford.edu>
Tested-by: Russ Allbery <rra@stanford.edu>

5 files changed, 1615 insertions, 0 deletions

diff --git a/perl/t/object/base.t b/perl/t/object/base.t
new file mode 100755
index 0000000..0432a23
--- /dev/null
+++ b/perl/t/object/base.t
@@ -0,0 +1,353 @@
+#!/usr/bin/perl -w
+#
+# Tests for the basic object implementation.
+#
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2007, 2008, 2011, 2014
+#     The Board of Trustees of the Leland Stanford Junior University
+#
+# See LICENSE for licensing terms.
+
+use POSIX qw(strftime);
+use Test::More tests => 137;
+
+use Wallet::ACL;
+use Wallet::Admin;
+use Wallet::Config;
+use Wallet::Object::Base;
+
+use lib 't/lib';
+use Util;
+
+# Some global defaults to use.
+my $user = 'admin@EXAMPLE.COM';
+my $host = 'localhost';
+my @trace = ($user, $host, time);
+my $princ = 'service/test@EXAMPLE.COM';
+
+# Use Wallet::Admin to set up the database.
+db_setup;
+my $admin = eval { Wallet::Admin->new };
+is ($@, '', 'Database connection succeeded');
+is ($admin->reinitialize ($user), 1, 'Database initialization succeeded');
+my $schema = $admin->schema;
+
+# Okay, now we have a database.  Test create and new.  We make believe this is
+# a keytab object; it won't matter for what we're doing.
+my $object = eval {
+    Wallet::Object::Base->create ('keytab', $princ, $schema, @trace)
+  };
+is ($@, '', 'Object creation did not die');
+ok ($object->isa ('Wallet::Object::Base'), ' and returned the right class');
+my $other = eval {
+    Wallet::Object::Base->create ('keytab', $princ, $schema, @trace)
+  };
+like ($@, qr/^cannot create object \Qkeytab:$princ: /, 'Repeating fails');
+$other = eval { Wallet::Object::Base->create ('', $princ, $schema, @trace) };
+is ($@, "invalid object type\n", 'Using an empty type fails');
+$other = eval { Wallet::Object::Base->create ('keytab', '', $schema, @trace) };
+is ($@, "invalid object name\n", ' as does an empty name');
+$object = eval { Wallet::Object::Base->new ('keytab', "a$princ", $schema) };
+is ($@, "cannot find keytab:a$princ\n", 'Searching for unknown object fails');
+$object = eval { Wallet::Object::Base->new ('keytab', $princ, $schema) };
+is ($@, '', 'Object new did not die');
+ok ($object->isa ('Wallet::Object::Base'), ' and returned the right class');
+
+# Simple accessor tests.
+is ($object->type, 'keytab', 'Type accessor works');
+is ($object->name, $princ, 'Name accessor works');
+
+# We'll use this for later tests.
+my $acl = Wallet::ACL->new ('ADMIN', $schema);
+
+# Owner.
+is ($object->owner, undef, 'Owner is not set to start');
+if ($object->owner ('ADMIN', @trace)) {
+    ok (1, ' and setting it to ADMIN works');
+} else {
+    is ($object->error, '', ' and setting it to ADMIN works');
+}
+is ($object->owner, $acl->id, ' at which point it is ADMIN');
+ok (! $object->owner ('unknown', @trace),
+    ' but setting it to something bogus fails');
+is ($object->error, 'ACL unknown not found', ' with the right error');
+if ($object->owner ('', @trace)) {
+    ok (1, ' and clearing it works');
+} else {
+    is ($object->error, '', ' and clearing it works');
+}
+is ($object->owner, undef, ' at which point it is cleared');
+is ($object->owner ('ADMIN', @trace), 1, ' and setting it again works');
+
+# Expires.
+is ($object->expires, undef, 'Expires is not set to start');
+my $now = strftime ('%Y-%m-%d %T', localtime time);
+if ($object->expires ($now, @trace)) {
+    ok (1, ' and setting it works');
+} else {
+    is ($object->error, '', ' and setting it works');
+}
+is ($object->expires, $now, ' at which point it matches');
+ok (! $object->expires ('13/13/13 13:13:13', @trace),
+    ' but setting it to something bogus fails');
+is ($object->error, 'malformed expiration time 13/13/13 13:13:13',
+    ' with the right error');
+if ($object->expires ('', @trace)) {
+    ok (1, ' and clearing it works');
+} else {
+    is ($object->error, '', ' and clearing it works');
+}
+is ($object->expires, undef, ' at which point it is cleared');
+is ($object->expires ($now, @trace), 1, ' and setting it again works');
+
+# Comment.
+is ($object->comment, undef, 'Comment is not set to start');
+if ($object->comment ('this is a comment', @trace)) {
+    ok (1, ' and setting it works');
+} else {
+    is ($object->error, '', ' and setting it works');
+}
+is ($object->comment, 'this is a comment', ' at which point it matches');
+if ($object->comment ('', @trace)) {
+    ok (1, ' and clearing it works');
+} else {
+    is ($object->error, '', ' and clearing it works');
+}
+is ($object->comment, undef, ' at which point it is cleared');
+is ($object->comment (join (' ', ('this is a comment') x 5), @trace), 1,
+    ' and setting it again works');
+
+# ACLs.
+for my $type (qw/get store show destroy flags/) {
+    is ($object->acl ($type), undef, "ACL $type is not set to start");
+    if ($object->acl ($type, $acl->id, @trace)) {
+        ok (1, ' and setting it to ADMIN (numeric) works');
+    } else {
+        is ($object->error, '', ' and setting it to ADMIN (numeric) works');
+    }
+    is ($object->acl ($type), $acl->id, ' at which point it is ADMIN');
+    ok (! $object->acl ($type, 22, @trace),
+        ' but setting it to something bogus fails');
+    is ($object->error, 'ACL 22 not found', ' with the right error');
+    if ($object->acl ($type, '', @trace)) {
+        ok (1, ' and clearing it works');
+    } else {
+        is ($object->error, '', ' and clearing it works');
+    }
+    is ($object->acl ($type), undef, ' at which point it is cleared');
+    is ($object->acl ($type, $acl->id, @trace), 1,
+        ' and setting it again works');
+}
+
+# Flags.
+my @flags = $object->flag_list;
+is (scalar (@flags), 0, 'No flags set to start');
+is ($object->flag_check ('locked'), 0, ' and locked is not set');
+is ($object->flag_set ('locked', @trace), 1, ' and setting locked works');
+is ($object->flag_check ('locked'), 1, ' and now locked is set');
+@flags = $object->flag_list;
+is (scalar (@flags), 1, ' and there is one flag');
+is ($flags[0], 'locked', ' which is locked');
+is ($object->flag_set ('locked', @trace), undef, 'Setting locked again fails');
+is ($object->error,
+    "cannot set flag locked on keytab:$princ: flag already set",
+    ' with the right error');
+is ($object->flag_set ('unchanging', @trace), 1,
+    ' but setting unchanging works');
+is ($object->flag_check ('unchanging'), 1, ' and unchanging is now set');
+@flags = $object->flag_list;
+is (scalar (@flags), 2, ' and there are two flags');
+is ($flags[0], 'locked', ' which are locked');
+is ($flags[1], 'unchanging', ' and unchanging');
+is ($object->flag_clear ('locked', @trace), 1, 'Clearing locked works');
+is ($object->flag_check ('locked'), 0, ' and now it is not set');
+is ($object->flag_check ('unchanging'), 1, ' but unchanging still is');
+is ($object->flag_clear ('locked', @trace), undef,
+    ' and clearing it again fails');
+is ($object->error,
+    "cannot clear flag locked on keytab:$princ: flag not set",
+    ' with the right error');
+if ($object->flag_set ('locked', @trace)) {
+    ok (1, ' and setting it again works');
+} else {
+    is ($object->error, '', ' and setting it again works');
+}
+
+# Attributes.  Very boring.
+is ($object->attr ('foo'), undef, 'Retrieving an attribute fails');
+is ($object->error, 'unknown attribute foo', ' with the right error');
+is ($object->attr ('foo', [ 'foo' ], @trace), undef, ' and setting fails');
+is ($object->error, 'unknown attribute foo', ' with the right error');
+
+# Test stub methods and locked status.
+is ($object->store ("Some data", @trace), undef, 'Store fails');
+is ($object->error, "cannot store keytab:${princ}: object is locked",
+    ' because the object is locked');
+is ($object->owner ('', @trace), undef, ' and setting owner fails');
+is ($object->error, "cannot modify keytab:${princ}: object is locked",
+    ' for the same reason');
+is ($object->owner, 1, ' but retrieving the owner works');
+is ($object->expires ('', @trace), undef, ' and setting expires fails');
+is ($object->error, "cannot modify keytab:${princ}: object is locked",
+    ' for the same reason');
+is ($object->expires, $now, ' but retrieving expires works');
+for my $acl (qw/get store show destroy flags/) {
+    is ($object->acl ($acl, '', @trace), undef, " and setting $acl ACL fails");
+    is ($object->error, "cannot modify keytab:${princ}: object is locked",
+        ' for the same reason');
+    is ($object->acl ($acl), 1, " but retrieving $acl ACL works");
+}
+is ($object->flag_check ('locked'), 1, ' and checking flags works');
+@flags = $object->flag_list;
+is (scalar (@flags), 2, ' and listing flags works');
+is ("@flags", 'locked unchanging', ' and returns the right data');
+is ($object->flag_clear ('locked', @trace), 1, 'Clearing locked succeeds');
+eval { $object->get (@trace) };
+is ($@, "Do not instantiate Wallet::Object::Base directly\n",
+    'Get fails with the right error');
+ok (! $object->store ("Some data", @trace), 'Store fails');
+is ($object->error, "cannot store keytab:$princ: object type is immutable",
+    ' with the right error');
+
+# Test show.
+my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]);
+my $output = <<"EOO";
+           Type: keytab
+           Name: $princ
+          Owner: ADMIN
+        Get ACL: ADMIN
+      Store ACL: ADMIN
+       Show ACL: ADMIN
+    Destroy ACL: ADMIN
+      Flags ACL: ADMIN
+        Expires: $now
+        Comment: this is a comment this is a comment this is a comment this is
+                 a comment this is a comment
+          Flags: unchanging
+     Created by: $user
+   Created from: $host
+     Created on: $date
+
+Members of ACL ADMIN (id: 1) are:
+  krb5 $user
+EOO
+is ($object->show, $output, 'Show output is correct');
+is ($object->flag_set ('locked', @trace), 1, ' and setting locked works');
+$output = <<"EOO";
+           Type: keytab
+           Name: $princ
+          Owner: ADMIN
+        Get ACL: ADMIN
+      Store ACL: ADMIN
+       Show ACL: ADMIN
+    Destroy ACL: ADMIN
+      Flags ACL: ADMIN
+        Expires: $now
+        Comment: this is a comment this is a comment this is a comment this is
+                 a comment this is a comment
+          Flags: locked unchanging
+     Created by: $user
+   Created from: $host
+     Created on: $date
+
+Members of ACL ADMIN (id: 1) are:
+  krb5 $user
+EOO
+is ($object->show, $output, ' and show still works and is correct');
+
+# Test destroy.
+is ($object->destroy (@trace), undef, 'Destroy fails');
+is ($object->error, "cannot destroy keytab:${princ}: object is locked",
+    ' because of the locked status');
+is ($object->flag_clear ('locked', @trace), 1,
+    ' and clearing locked status works');
+if ($object->destroy (@trace)) {
+    ok (1, 'Destroy is successful');
+} else {
+    is ($object->error, '', 'Destroy is successful');
+}
+$object = eval { Wallet::Object::Base->new ('keytab', $princ, $schema) };
+is ($@, "cannot find keytab:$princ\n", ' and object is all gone');
+
+# Test history.
+$object = eval {
+    Wallet::Object::Base->create ('keytab', $princ, $schema, @trace)
+  };
+ok (defined ($object), 'Recreating the object succeeds');
+$output = <<"EOO";
+$date  create
+    by $user from $host
+$date  set owner to ADMIN (1)
+    by $user from $host
+$date  unset owner (was ADMIN (1))
+    by $user from $host
+$date  set owner to ADMIN (1)
+    by $user from $host
+$date  set expires to $now
+    by $user from $host
+$date  unset expires (was $now)
+    by $user from $host
+$date  set expires to $now
+    by $user from $host
+$date  set comment to this is a comment
+    by $user from $host
+$date  unset comment (was this is a comment)
+    by $user from $host
+$date  set comment to this is a comment this is a comment this is a comment this is a comment this is a comment
+    by $user from $host
+$date  set acl_get to ADMIN (1)
+    by $user from $host
+$date  unset acl_get (was ADMIN (1))
+    by $user from $host
+$date  set acl_get to ADMIN (1)
+    by $user from $host
+$date  set acl_store to ADMIN (1)
+    by $user from $host
+$date  unset acl_store (was ADMIN (1))
+    by $user from $host
+$date  set acl_store to ADMIN (1)
+    by $user from $host
+$date  set acl_show to ADMIN (1)
+    by $user from $host
+$date  unset acl_show (was ADMIN (1))
+    by $user from $host
+$date  set acl_show to ADMIN (1)
+    by $user from $host
+$date  set acl_destroy to ADMIN (1)
+    by $user from $host
+$date  unset acl_destroy (was ADMIN (1))
+    by $user from $host
+$date  set acl_destroy to ADMIN (1)
+    by $user from $host
+$date  set acl_flags to ADMIN (1)
+    by $user from $host
+$date  unset acl_flags (was ADMIN (1))
+    by $user from $host
+$date  set acl_flags to ADMIN (1)
+    by $user from $host
+$date  set flag locked
+    by $user from $host
+$date  set flag unchanging
+    by $user from $host
+$date  clear flag locked
+    by $user from $host
+$date  set flag locked
+    by $user from $host
+$date  clear flag locked
+    by $user from $host
+$date  set flag locked
+    by $user from $host
+$date  clear flag locked
+    by $user from $host
+$date  destroy
+    by $user from $host
+$date  create
+    by $user from $host
+EOO
+is ($object->history, $output, ' and the history is correct');
+
+# Clean up.
+$admin->destroy;
+END {
+    unlink 'wallet-db';
+}
diff --git a/perl/t/object/duo.t b/perl/t/object/duo.t
new file mode 100755
index 0000000..4229afe
--- /dev/null
+++ b/perl/t/object/duo.t
@@ -0,0 +1,157 @@
+#!/usr/bin/perl
+#
+# Tests for the Duo integration object implementation.
+#
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2014
+#     The Board of Trustees of the Leland Stanford Junior University
+#
+# See LICENSE for licensing terms.
+
+use strict;
+use warnings;
+
+use POSIX qw(strftime);
+use Test::More;
+
+BEGIN {
+    eval 'use Net::Duo';
+    plan skip_all => 'Net::Duo required for testing duo'
+      if $@;
+    eval 'use Net::Duo::Mock::Agent';
+    plan skip_all => 'Net::Duo::Mock::Agent required for testing duo'
+      if $@;
+}
+
+BEGIN {
+    use_ok('Wallet::Admin');
+    use_ok('Wallet::Config');
+    use_ok('Wallet::Object::Duo');
+}
+
+use lib 't/lib';
+use Util;
+
+# Some global defaults to use.
+my $user = 'admin@EXAMPLE.COM';
+my $host = 'localhost';
+my @trace = ($user, $host, time);
+my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]);
+
+# Flush all output immediately.
+$| = 1;
+
+# Use Wallet::Admin to set up the database.
+db_setup;
+my $admin = eval { Wallet::Admin->new };
+is ($@, '', 'Database connection succeeded');
+is ($admin->reinitialize ($user), 1, 'Database initialization succeeded');
+my $schema = $admin->schema;
+
+# Create a mock object to use for Duo calls.
+my $mock = Net::Duo::Mock::Agent->new ({ key_file => 't/data/duo/keys.json' });
+
+# Test error handling in the absence of configuration.
+my $object = eval {
+    Wallet::Object::Duo->new ('duo', 'test', $schema);
+};
+is ($object, undef, 'Wallet::Object::Duo new with no config failed');
+is ($@, "duo object implementation not configured\n", '...with correct error');
+$object = eval {
+    Wallet::Object::Duo->create ('duo', 'test', $schema, @trace);
+};
+is ($object, undef, 'Wallet::Object::Duo creation with no config failed');
+is ($@, "duo object implementation not configured\n", '...with correct error');
+
+# Set up the Duo configuration.
+$Wallet::Config::DUO_AGENT    = $mock;
+$Wallet::Config::DUO_KEY_FILE = 't/data/duo/keys.json';
+
+# Test creating an integration.
+note ('Test creating an integration');
+my $expected = {
+    name  => 'test',
+    notes => 'Managed by wallet',
+    type  => 'unix',
+};
+$mock->expect (
+    {
+        method        => 'POST',
+        uri           => '/admin/v1/integrations',
+        content       => $expected,
+        response_file => 't/data/duo/integration.json',
+    }
+);
+$object = Wallet::Object::Duo->create ('duo', 'test', $schema, @trace);
+isa_ok ($object, 'Wallet::Object::Duo');
+
+# Check the metadata about the new wallet object.
+$expected = <<"EOO";
+           Type: duo
+           Name: test
+        Duo key: DIRWIH0ZZPV4G88B37VQ
+     Created by: $user
+   Created from: $host
+     Created on: $date
+EOO
+is ($object->show, $expected, 'Show output is correct');
+
+# Test retrieving the integration information.
+note ('Test retrieving an integration');
+$mock->expect (
+    {
+        method        => 'GET',
+        uri           => '/admin/v1/integrations/DIRWIH0ZZPV4G88B37VQ',
+        response_file => 't/data/duo/integration.json',
+    }
+);
+my $data = $object->get (@trace);
+ok (defined ($data), 'Retrieval succeeds');
+$expected = <<'EOO';
+[duo]
+ikey = DIRWIH0ZZPV4G88B37VQ
+skey = QO4ZLqQVRIOZYkHfdPDORfcNf8LeXIbCWwHazY7o
+host = example-admin.duosecurity.com
+EOO
+is ($data, $expected, '...and integration data is correct');
+
+# Ensure that we can't retrieve the object when locked.
+is ($object->flag_set ('locked', @trace), 1,
+    'Setting object to locked succeeds');
+is ($object->get, undef, '...and now get fails');
+is ($object->error, 'cannot get duo:test: object is locked',
+    '...with correct error');
+is ($object->flag_clear ('locked', @trace), 1,
+    '...and clearing locked flag works');
+
+# Create a new object by wallet type and name.
+$object = Wallet::Object::Duo->new ('duo', 'test', $schema);
+
+# Test deleting an integration.  We can't test this entirely properly because
+# currently Net::Duo::Mock::Agent doesn't support stacking multiple expected
+# calls and delete makes two calls.
+note ('Test deleting an integration');
+$mock->expect (
+    {
+        method        => 'GET',
+        uri           => '/admin/v1/integrations/DIRWIH0ZZPV4G88B37VQ',
+        response_file => 't/data/duo/integration.json',
+    }
+);
+TODO: {
+    local $TODO = 'Net::Duo::Mock::Agent not yet capable';
+
+    is ($object->destroy (@trace), 1, 'Duo object deletion succeeded');
+    $object = eval { Wallet::Object::Duo->new ('duo', 'test', $schema) };
+    is ($object, undef, '...and now object cannot be retrieved');
+    is ($@, "cannot find duo:test\n", '...with correct error');
+}
+
+# Clean up.
+$admin->destroy;
+END {
+    unlink ('wallet-db');
+}
+
+# Done testing.
+done_testing ();
diff --git a/perl/t/object/file.t b/perl/t/object/file.t
new file mode 100755
index 0000000..0aecd9d
--- /dev/null
+++ b/perl/t/object/file.t
@@ -0,0 +1,150 @@
+#!/usr/bin/perl -w
+#
+# Tests for the file object implementation.
+#
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2008, 2014
+#     The Board of Trustees of the Leland Stanford Junior University
+#
+# See LICENSE for licensing terms.
+
+use POSIX qw(strftime);
+use Test::More tests => 56;
+
+use Wallet::Admin;
+use Wallet::Config;
+use Wallet::Object::File;
+
+use lib 't/lib';
+use Util;
+
+# Some global defaults to use.
+my $user = 'admin@EXAMPLE.COM';
+my $host = 'localhost';
+my @trace = ($user, $host, time);
+
+# Flush all output immediately.
+$| = 1;
+
+# Use Wallet::Admin to set up the database.
+system ('rm -rf test-files') == 0 or die "cannot remove test-files\n";
+db_setup;
+my $admin = eval { Wallet::Admin->new };
+is ($@, '', 'Database connection succeeded');
+is ($admin->reinitialize ($user), 1, 'Database initialization succeeded');
+my $schema = $admin->schema;
+
+# Use this to accumulate the history traces so that we can check history.
+my $history = '';
+my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]);
+
+# Test error handling in the absence of configuration.
+$object = eval {
+    Wallet::Object::File->create ('file', 'test', $schema, @trace)
+  };
+ok (defined ($object), 'Creating a basic file object succeeds');
+ok ($object->isa ('Wallet::Object::File'), ' and is the right class');
+is ($object->get (@trace), undef, ' and get fails');
+is ($object->error, 'file support not configured', ' with the right error');
+is ($object->store (@trace), undef, ' and store fails');
+is ($object->error, 'file support not configured', ' with the right error');
+is ($object->destroy (@trace), 1, ' but destroy succeeds');
+
+# Set up our configuration.
+mkdir 'test-files' or die "cannot create test-files: $!\n";
+$Wallet::Config::FILE_BUCKET = 'test-files';
+
+# Okay, now we can test.  First, the basic object without store.
+$object = eval {
+    Wallet::Object::File->create ('file', 'test', $schema, @trace)
+  };
+ok (defined ($object), 'Creating a basic file object succeeds');
+ok ($object->isa ('Wallet::Object::File'), ' and is the right class');
+is ($object->get (@trace), undef, ' and get fails');
+is ($object->error, 'cannot get file:test: object has not been stored',
+    ' with the right error');
+is ($object->destroy (@trace), 1, ' but destroying the object succeeds');
+
+# Now store something and be sure that we get something reasonable.
+$object = eval {
+    Wallet::Object::File->create ('file', 'test', $schema, @trace)
+  };
+ok (defined ($object), 'Recreating the object succeeds');
+is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds');
+ok (-d 'test-files/09', ' and the hash bucket was created');
+ok (-f 'test-files/09/test', ' and the file exists');
+is (contents ('test-files/09/test'), 'foo', ' with the right contents');
+is ($object->get (@trace), "foo\n", ' and get returns correctly');
+unlink 'test-files/09/test';
+is ($object->get (@trace), undef, ' and get fails if we delete it');
+is ($object->error, 'cannot get file:test: object has not been stored',
+    ' as if it had not been stored');
+is ($object->store ("bar\n\0baz\n", @trace), 1, ' but storing again works');
+ok (-f 'test-files/09/test', ' and the file exists');
+is (contents ('test-files/09/test'), 'bar', ' with the right contents');
+is ($object->get (@trace), "bar\n\0baz\n", ' and get returns correctly');
+
+# Try exceeding the store size.
+$Wallet::Config::FILE_MAX_SIZE = 1024;
+is ($object->store ('x' x 1024, @trace), 1,
+    ' and storing exactly 1024 characters works');
+is ($object->get (@trace), 'x' x 1024, ' and get returns the right thing');
+is ($object->store ('x' x 1025, @trace), undef,
+    ' but storing 1025 characters fails');
+is ($object->error, 'data exceeds maximum of 1024 bytes',
+    ' with the right error');
+
+# Try storing the empty data object.
+is ($object->store ('', @trace), 1, 'Storing the empty object works');
+is ($object->get (@trace), '', ' and get returns the right thing');
+
+# Test destruction.
+is ($object->destroy (@trace), 1, 'Destroying the object works');
+ok (! -f 'test-files/09/test', ' and the file is gone');
+
+# Now try some aggressive names.
+$object = eval {
+    Wallet::Object::File->create ('file', '../foo', $schema, @trace)
+  };
+ok (defined ($object), 'Creating ../foo succeeds');
+is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds');
+ok (-d 'test-files/39', ' and the hash bucket was created');
+ok (-f 'test-files/39/%2E%2E%2Ffoo', ' and the file exists');
+is (contents ('test-files/39/%2E%2E%2Ffoo'), 'foo',
+    ' with the right contents');
+is ($object->get (@trace), "foo\n", ' and get returns correctly');
+is ($object->destroy (@trace), 1, 'Destroying the object works');
+ok (! -f 'test-files/39/%2E%2E%2Ffoo', ' and the file is gone');
+$object = eval {
+    Wallet::Object::File->create ('file', "\0", $schema, @trace)
+  };
+ok (defined ($object), 'Creating nul succeeds');
+is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds');
+ok (-d 'test-files/93', ' and the hash bucket was created');
+ok (-f 'test-files/93/%00', ' and the file exists');
+is (contents ('test-files/93/%00'), 'foo',
+    ' with the right contents');
+is ($object->get (@trace), "foo\n", ' and get returns correctly');
+is ($object->destroy (@trace), 1, 'Destroying the object works');
+ok (! -f 'test-files/93/%00', ' and the file is gone');
+
+# Test error handling in the file store.
+system ('rm -r test-files') == 0 or die "cannot remove test-files\n";
+$object = eval {
+    Wallet::Object::File->create ('file', 'test', $schema, @trace)
+  };
+ok (defined ($object), 'Recreating the object succeeds');
+is ($object->store ("foo\n", @trace), undef,
+    ' and storing data in it fails');
+like ($object->error, qr/^cannot create file bucket 09: /,
+      ' with the right error');
+is ($object->get (@trace), undef, ' and get fails');
+like ($object->error, qr/^cannot create file bucket 09: /,
+      ' with the right error');
+is ($object->destroy (@trace), 1, ' but destroying the object succeeds');
+
+# Clean up.
+$admin->destroy;
+END {
+    unlink ('wallet-db');
+}
diff --git a/perl/t/object/keytab.t b/perl/t/object/keytab.t
new file mode 100755
index 0000000..127762a
--- /dev/null
+++ b/perl/t/object/keytab.t
@@ -0,0 +1,771 @@
+#!/usr/bin/perl -w
+#
+# Tests for the keytab object implementation.
+#
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2007, 2008, 2009, 2010, 2013, 2014
+#     The Board of Trustees of the Leland Stanford Junior University
+#
+# See LICENSE for licensing terms.
+
+use POSIX qw(strftime);
+use Test::More tests => 141;
+
+BEGIN { $Wallet::Config::KEYTAB_TMP = '.' }
+
+use DBI;
+use Wallet::Admin;
+use Wallet::Config;
+use Wallet::Kadmin;
+use Wallet::Object::Keytab;
+
+use lib 't/lib';
+use Util;
+
+# Mapping of klist -ke encryption type names to the strings that Kerberos uses
+# internally.  It's very annoying to have to maintain this, and it probably
+# breaks with Heimdal.
+my %enctype =
+    ('triple des cbc mode with hmac/sha1'      => 'des3-cbc-sha1',
+     'des cbc mode with crc-32'                => 'des-cbc-crc',
+     'des cbc mode with rsa-md5'               => 'des-cbc-md5',
+     'aes-256 cts mode with 96-bit sha-1 hmac' => 'aes256-cts-hmac-sha1-96',
+     'arcfour with hmac/md5'                   => 'rc4-hmac');
+
+# Some global defaults to use.
+my $user = 'admin@EXAMPLE.COM';
+my $host = 'localhost';
+my @trace = ($user, $host, time);
+
+# Flush all output immediately.
+$| = 1;
+
+# Run a command and throw away the output, returning the exit status.
+sub system_quiet {
+    my ($command, @args) = @_;
+    my $pid = fork;
+    if (not defined $pid) {
+        die "cannot fork: $!\n";
+    } elsif ($pid == 0) {
+        open (STDIN, '<', '/dev/null') or die "cannot reopen stdin: $!\n";
+        open (STDOUT, '>', '/dev/null') or die "cannot reopen stdout: $!\n";
+        open (STDERR, '>', '/dev/null') or die "cannot reopen stderr: $!\n";
+        exec ($command, @args) or die "cannot exec $command: $!\n";
+    } else {
+        waitpid ($pid, 0);
+        return $?;
+    }
+}
+
+# Create a principal out of Kerberos.  Only usable once the configuration has
+# been set up.
+sub create {
+    my ($principal) = @_;
+    my $kadmin = Wallet::Kadmin->new;
+    return $kadmin->create ($principal);
+}
+
+# Destroy a principal out of Kerberos.  Only usable once the configuration has
+# been set up.
+sub destroy {
+    my ($principal) = @_;
+    my $kadmin = Wallet::Kadmin->new;
+    return $kadmin->destroy ($principal);
+}
+
+# Check whether a principal exists.  MIT uses kvno and Heimdal uses kgetcred.
+# Note that the Kerberos type may be different than our local userspace, so
+# don't use the Kerberos type to decide here.  Instead, check for which
+# program is available on the path.
+sub created {
+    my ($principal) = @_;
+    $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
+    local $ENV{KRB5CCNAME} = 'krb5cc_temp';
+    getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL);
+    if (grep { -x "$_/kvno" } split (':', $ENV{PATH})) {
+        return (system_quiet ('kvno', $principal) == 0);
+    } elsif (grep { -x "$_/kgetcred" } split (':', $ENV{PATH})) {
+        return (system_quiet ('kgetcred', $principal) == 0);
+    } else {
+        warn "# No kvno or kgetcred found\n";
+        return;
+    }
+}
+
+# Given keytab data, write it to a file and try to determine the enctypes of
+# the keys present in that file.  Returns the enctypes as a list, with UNKNOWN
+# for encryption types that weren't recognized.  This is an ugly way of doing
+# this for MIT.  Heimdal is much more straightforward, but MIT ktutil doesn't
+# have the needed abilities.
+sub enctypes {
+    my ($keytab) = @_;
+    open (KEYTAB, '>', 'keytab') or die "cannot create keytab: $!\n";
+    print KEYTAB $keytab;
+    close KEYTAB;
+
+    my @enctypes;
+    my $pid = open (KLIST, '-|');
+    if (not defined $pid) {
+        die "cannot fork: $!\n";
+    } elsif ($pid == 0) {
+        open (STDERR, '>', '/dev/null') or die "cannot reopen stderr: $!\n";
+        exec ('klist', '-ke', 'keytab')
+            or die "cannot run klist: $!\n";
+    }
+    local $_;
+    while (<KLIST>) {
+        next unless /^ *\d+ /;
+        my ($string) = /\((.*)\)\s*$/;
+        next unless $string;
+        $enctype = $enctype{lc $string} || 'UNKNOWN';
+        push (@enctypes, $enctype);
+    }
+    close KLIST;
+
+    # If that failed, we may have a Heimdal user space instead, so try ktutil.
+    # If we try this directly, it will just hang with MIT ktutil.
+    if ($? != 0 || !@enctypes) {
+        @enctypes = ();
+        open (KTUTIL, '-|', 'ktutil', '-k', 'keytab', 'list')
+            or die "cannot run ktutil: $!\n";
+        local $_;
+        while (<KTUTIL>) {
+            next unless /^ *\d+ /;
+            my ($string) = /^\s*\d+\s+(\S+)/;
+            next unless $string;
+            push (@enctypes, $string);
+        }
+        close KTUTIL;
+    }
+    unlink 'keytab';
+    return sort @enctypes;
+}
+
+# Use Wallet::Admin to set up the database.
+unlink ('krb5cc_temp', 'krb5cc_test', 'test-acl', 'test-pid');
+db_setup;
+my $admin = eval { Wallet::Admin->new };
+is ($@, '', 'Database connection succeeded');
+is ($admin->reinitialize ($user), 1, 'Database initialization succeeded');
+my $schema = $admin->schema;
+my $dbh = $admin->dbh;
+
+# Use this to accumulate the history traces so that we can check history.
+my $history = '';
+my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]);
+
+# Basic keytab creation and manipulation tests.
+SKIP: {
+    skip 'no keytab configuration', 52 unless -f 't/data/test.keytab';
+
+    # Set up our configuration.
+    $Wallet::Config::KEYTAB_FILE      = 't/data/test.keytab';
+    $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal');
+    $Wallet::Config::KEYTAB_REALM     = contents ('t/data/test.realm');
+    $Wallet::Config::KEYTAB_KRBTYPE   = contents ('t/data/test.krbtype');
+    my $realm = $Wallet::Config::KEYTAB_REALM;
+
+    # Clean up the principals we're going to use.
+    destroy ('wallet/one');
+    destroy ('wallet/two');
+
+    # Don't destroy the user's Kerberos ticket cache.
+    $ENV{KRB5CCNAME} = 'krb5cc_test';
+
+    # Test that object creation without KEYTAB_TMP fails.
+    undef $Wallet::Config::KEYTAB_TMP;
+    $object = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
+      };
+    is ($object, undef, 'Creating keytab without KEYTAB_TMP fails');
+    is ($@, "KEYTAB_TMP configuration variable not set\n",
+        ' with the right error');
+    $Wallet::Config::KEYTAB_TMP = '.';
+
+    # Okay, now we can test.  First, create.
+    $object = eval {
+        Wallet::Object::Keytab->create ('keytab', "wallet\nf", $schema,
+                                        @trace)
+      };
+    is ($object, undef, 'Creating malformed principal fails');
+    if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
+        is ($@, "invalid principal name wallet\nf\n", ' with the right error');
+    } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
+        like ($@, qr/^error adding principal wallet\nf/,
+              ' with the right error');
+    }
+    $object = eval {
+        Wallet::Object::Keytab->create ('keytab', '', $schema, @trace)
+      };
+    is ($object, undef, 'Creating empty principal fails');
+    if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
+        is ($@, "invalid principal name \n", ' with the right error');
+    } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
+        like ($@, qr/^error adding principal \@/, ' with the right error');
+    }
+    $object = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
+      };
+    if (defined ($object)) {
+        ok (defined ($object), 'Creating good principal succeeds');
+    } else {
+        is ($@, '', 'Creating good principal succeeds');
+    }
+    ok ($object->isa ('Wallet::Object::Keytab'), ' and is the right class');
+    ok (created ('wallet/one'), ' and the principal was created');
+    create ('wallet/two');
+    $object = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/two', $schema,
+                                        @trace)
+      };
+    if (defined ($object)) {
+        ok (defined ($object), 'Creating an existing principal succeeds');
+    } else {
+        is ($@, '', 'Creating an existing principal succeeds');
+    }
+    ok ($object->isa ('Wallet::Object::Keytab'), ' and is the right class');
+    is ($object->destroy (@trace), 1, ' and destroying it succeeds');
+    is ($object->error, undef, ' with no error message');
+    ok (! created ('wallet/two'), ' and now it does not exist');
+    my @name = qw(keytab wallet-test/one);
+    $object = eval { Wallet::Object::Keytab->create (@name, $schema, @trace) };
+    is ($object, undef, 'Creation without permissions fails');
+    like ($@, qr{^error adding principal wallet-test/one\@\Q$realm: },
+          ' with the right error');
+
+    # Now, try retrieving the keytab.
+    $object = Wallet::Object::Keytab->new ('keytab', 'wallet/one', $schema);
+    ok (defined ($object), 'Retrieving the object works');
+    ok ($object->isa ('Wallet::Object::Keytab'), ' and is the right type');
+    is ($object->flag_set ('locked', @trace), 1, ' and setting locked works');
+    is ($object->get (@trace), undef, ' and get fails');
+    is ($object->error, "cannot get keytab:wallet/one: object is locked",
+        ' because it is locked');
+    is ($object->flag_clear ('locked', @trace), 1,
+        ' and clearing locked works');
+    my $data = $object->get (@trace);
+    if (defined ($data)) {
+        ok (defined ($data), ' and getting the keytab works');
+    } else {
+        is ($object->error, '', ' and getting the keytab works');
+    }
+    ok (! -f "./keytab.$$", ' and the temporary file was cleaned up');
+    ok (keytab_valid ($data, 'wallet/one'), ' and the keytab is valid');
+
+    # For right now, this is the only backend type that we have for which we
+    # can do a get, so test display of the last download information.
+    my $expected = <<"EOO";
+           Type: keytab
+           Name: wallet/one
+     Created by: $user
+   Created from: $host
+     Created on: $date
+  Downloaded by: $user
+Downloaded from: $host
+  Downloaded on: $date
+EOO
+    is ($object->show, $expected, 'Show output is correct');
+
+    # Test error handling on keytab retrieval.
+  SKIP: {
+        skip 'no kadmin program test for Heimdal', 2
+            if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal';
+        $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file';
+        $data = $object->get (@trace);
+        is ($data, undef, 'Cope with a failure to run kadmin');
+        like ($object->error, qr{^cannot run /some/nonexistent/file: },
+              ' with the right error');
+        $Wallet::Config::KEYTAB_KADMIN = 'kadmin';
+    }
+    destroy ('wallet/one');
+    $data = $object->get (@trace);
+    is ($data, undef, 'Getting a keytab for a nonexistent principal fails');
+    like ($object->error,
+          qr{^error creating keytab for wallet/one\@\Q$realm\E: },
+          ' with the right error');
+    is ($object->destroy (@trace), 1, ' but we can still destroy it');
+
+    # Test principal deletion on object destruction.
+    $object = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
+      };
+    ok (defined ($object), 'Creating good principal succeeds');
+    ok (created ('wallet/one'), ' and the principal was created');
+  SKIP: {
+        skip 'no kadmin program test for Heimdal', 2
+            if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal';
+        $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file';
+        is ($object->destroy (@trace), undef,
+            ' and destroying it with bad kadmin fails');
+        like ($object->error, qr{^cannot run /some/nonexistent/file: },
+              ' with the right error');
+        $Wallet::Config::KEYTAB_KADMIN = 'kadmin';
+    }
+    is ($object->flag_set ('locked', @trace), 1, ' and setting locked works');
+    is ($object->destroy (@trace), undef, ' and destroying it fails');
+    is ($object->error, "cannot destroy keytab:wallet/one: object is locked",
+        ' because it is locked');
+    is ($object->flag_clear ('locked', @trace), 1,
+        ' and clearing locked works');
+    is ($object->destroy (@trace), 1, ' and destroying it succeeds');
+    ok (! created ('wallet/one'), ' and now it does not exist');
+
+    # Test history (which should still work after the object is deleted).
+    $history .= <<"EOO";
+$date  create
+    by $user from $host
+$date  set flag locked
+    by $user from $host
+$date  clear flag locked
+    by $user from $host
+$date  get
+    by $user from $host
+$date  destroy
+    by $user from $host
+$date  create
+    by $user from $host
+$date  set flag locked
+    by $user from $host
+$date  clear flag locked
+    by $user from $host
+$date  destroy
+    by $user from $host
+EOO
+    is ($object->history, $history, 'History is correct to this point');
+
+    # Test configuration errors.
+    undef $Wallet::Config::KEYTAB_FILE;
+    $object = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
+      };
+    is ($object, undef, 'Creating with bad configuration fails');
+    is ($@, "keytab object implementation not configured\n",
+        ' with the right error');
+    $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab';
+    undef $Wallet::Config::KEYTAB_PRINCIPAL;
+    $object = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
+      };
+    is ($object, undef, ' likewise with another missing variable');
+    is ($@, "keytab object implementation not configured\n",
+        ' with the right error');
+    $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal');
+    undef $Wallet::Config::KEYTAB_REALM;
+    $object = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
+      };
+    is ($object, undef, ' and another');
+    is ($@, "keytab object implementation not configured\n",
+        ' with the right error');
+    $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm');
+    undef $Wallet::Config::KEYTAB_KRBTYPE;
+    $object = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
+      };
+    is ($object, undef, ' and another');
+    is ($@, "keytab object implementation not configured\n",
+        ' with the right error');
+    $Wallet::Config::KEYTAB_KRBTYPE = 'Active Directory';
+    $object = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
+      };
+    is ($object, undef, ' and one set to an invalid value');
+    is ($@, "unknown KEYTAB_KRBTYPE setting: Active Directory\n",
+        ' with the right error');
+    $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype');
+}
+
+# Tests for unchanging support.  Skip these if we don't have a keytab or if we
+# can't find remctld.
+SKIP: {
+    skip 'no keytab configuration', 31 unless -f 't/data/test.keytab';
+
+    # Set up our configuration.
+    $Wallet::Config::KEYTAB_FILE      = 't/data/test.keytab';
+    $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal');
+    $Wallet::Config::KEYTAB_REALM     = contents ('t/data/test.realm');
+    $Wallet::Config::KEYTAB_KRBTYPE   = contents ('t/data/test.krbtype');
+    $Wallet::Config::KEYTAB_TMP       = '.';
+    my $realm = $Wallet::Config::KEYTAB_REALM;
+    my $principal = $Wallet::Config::KEYTAB_PRINCIPAL;
+
+    # Create the objects for testing and set the unchanging flag.
+    my $one = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
+      };
+    ok (defined ($one), 'Creating wallet/one succeeds');
+    is ($one->flag_set ('unchanging', @trace), 1, ' and setting unchanging');
+    my $two = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/two', $schema,
+                                        @trace);
+      };
+    ok (defined ($two), 'Creating wallet/two succeeds');
+    is ($two->flag_set ('unchanging', @trace), 1, ' and setting unchanging');
+
+    # Finally we can test.  First the MIT Kerberos tests.
+  SKIP: {
+        skip 'skipping MIT unchanging tests for Heimdal', 16
+            if (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'heimdal');
+
+        # We need remctld and Net::Remctl.
+        my @path = (split (':', $ENV{PATH}), '/usr/local/sbin', '/usr/sbin');
+        my ($remctld) = grep { -x $_ } map { "$_/remctld" } @path;
+        skip 'remctld not found', 16 unless $remctld;
+        eval { require Net::Remctl };
+        skip 'Net::Remctl not available', 16 if $@;
+
+        # Now spawn our remctld server and get a ticket cache.
+        remctld_spawn ($remctld, $principal, 't/data/test.keytab',
+                       't/data/keytab.conf');
+        $ENV{KRB5CCNAME} = 'krb5cc_test';
+        getcreds ('t/data/test.keytab', $principal);
+        $ENV{KRB5CCNAME} = 'krb5cc_good';
+
+        # Do the unchanging tests for MIT Kerberos.
+        is ($one->get (@trace), undef, 'Get without configuration fails');
+        is ($one->error, 'keytab unchanging support not configured',
+            ' with the right error');
+        $Wallet::Config::KEYTAB_REMCTL_CACHE = 'krb5cc_test';
+        is ($one->get (@trace), undef, ' and still fails without host');
+        is ($one->error, 'keytab unchanging support not configured',
+            ' with the right error');
+        $Wallet::Config::KEYTAB_REMCTL_HOST = 'localhost';
+        $Wallet::Config::KEYTAB_REMCTL_PRINCIPAL = $principal;
+        $Wallet::Config::KEYTAB_REMCTL_PORT = 14373;
+        is ($one->get (@trace), undef, ' and still fails without ACL');
+        is ($one->error,
+            "cannot retrieve keytab for wallet/one\@$realm: Access denied",
+            ' with the right error');
+        open (ACL, '>', 'test-acl') or die "cannot create test-acl: $!\n";
+        print ACL "$principal\n";
+        close ACL;
+        is ($one->get (@trace), 'Keytab for wallet/one', 'Now get works');
+        is ($ENV{KRB5CCNAME}, 'krb5cc_good',
+            ' and we did not nuke the cache name');
+        is ($one->get (@trace), 'Keytab for wallet/one',
+            ' and we get the same thing the second time');
+        is ($one->flag_clear ('unchanging', @trace), 1,
+            'Clearing the unchanging flag works');
+        my $data = $one->get (@trace);
+        ok (defined ($data), ' and getting the keytab works');
+        ok (keytab_valid ($data, 'wallet/one'), ' and the keytab is valid');
+        is ($two->get (@trace), undef, 'Get for wallet/two does not work');
+        is ($two->error,
+            "cannot retrieve keytab for wallet/two\@$realm: bite me",
+            ' with the right error');
+        is ($one->destroy (@trace), 1, 'Destroying wallet/one works');
+        is ($two->destroy (@trace), 1, ' as does destroying wallet/two');
+        remctld_stop;
+        unlink 'krb5cc_good';
+    }
+
+    # Now Heimdal.  Since the keytab contains timestamps, before testing for
+    # equality we have to substitute out the timestamps.
+  SKIP: {
+        skip 'skipping Heimdal unchanging tests for MIT', 11
+            if (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'mit');
+        my $data = $one->get (@trace);
+        ok (defined $data, 'Get of unchanging keytab works');
+        ok (keytab_valid ($data, 'wallet/one'), ' and the keytab is valid');
+        my $second = $one->get (@trace);
+        ok (defined $second, ' and second retrieval also works');
+        $data =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g;
+        $second =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g;
+        ok (keytab_valid ($second, 'wallet/one'), ' and the keytab is valid');
+        ok (keytab_valid ($data, 'wallet/one'), ' as is the first keytab');
+        is ($one->flag_clear ('unchanging', @trace), 1,
+            'Clearing the unchanging flag works');
+        $data = $one->get (@trace);
+        ok (defined ($data), ' and getting the keytab works');
+        ok (keytab_valid ($data, 'wallet/one'), ' and the keytab is valid');
+        $data =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g;
+        ok ($data ne $second, ' and the new keytab is different');
+        is ($one->destroy (@trace), 1, 'Destroying wallet/one works');
+        is ($two->destroy (@trace), 1, ' as does destroying wallet/two');
+    }
+
+    # Check that history has been updated correctly.
+    $history .= <<"EOO";
+$date  create
+    by $user from $host
+$date  set flag unchanging
+    by $user from $host
+$date  get
+    by $user from $host
+$date  get
+    by $user from $host
+$date  clear flag unchanging
+    by $user from $host
+$date  get
+    by $user from $host
+$date  destroy
+    by $user from $host
+EOO
+    is ($one->history, $history, 'History is correct to this point');
+}
+
+# Tests for synchronization support.  This code is deactivated at present
+# since no synchronization targets are supported, but we want to still test
+# the basic stub code.
+SKIP: {
+    skip 'no keytab configuration', 18 unless -f 't/data/test.keytab';
+
+    # Test setting synchronization attributes, which can also be done without
+    # configuration.
+    my $one = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
+      };
+    ok (defined ($one), 'Creating wallet/one succeeds');
+    my $expected = <<"EOO";
+           Type: keytab
+           Name: wallet/one
+     Created by: $user
+   Created from: $host
+     Created on: $date
+EOO
+    is ($one->show, $expected, 'Show output displays no attributes');
+    is ($one->attr ('foo', [ 'bar' ], @trace), undef,
+        'Setting unknown attribute fails');
+    is ($one->error, 'unknown attribute foo', ' with the right error');
+    my @targets = $one->attr ('foo');
+    is (scalar (@targets), 0, ' and getting an unknown attribute fails');
+    is ($one->error, 'unknown attribute foo', ' with the right error');
+    is ($one->attr ('sync', [ 'kaserver' ], @trace), undef,
+        ' and setting an unknown sync target fails');
+    is ($one->error, 'unsupported synchronization target kaserver',
+        ' with the right error');
+    is ($one->attr ('sync', [ 'kaserver', 'bar' ], @trace), undef,
+        ' and setting two targets fails');
+    is ($one->error, 'only one synchronization target supported',
+        ' with the right error');
+
+    # Create a synchronization manually so that we can test the display and
+    # removal code.
+    my $sql = "insert into keytab_sync (ks_name, ks_target) values
+        ('wallet/one', 'kaserver')";
+    $dbh->do ($sql);
+    @targets = $one->attr ('sync');
+    is (scalar (@targets), 1, ' and now one target is set');
+    is ($targets[0], 'kaserver', ' and it is correct');
+    is ($one->error, undef, ' and there is no error');
+    $expected = <<"EOO";
+           Type: keytab
+           Name: wallet/one
+    Synced with: kaserver
+     Created by: $user
+   Created from: $host
+     Created on: $date
+EOO
+    is ($one->show, $expected, ' and show now displays the attribute');
+    $history .= <<"EOO";
+$date  create
+    by $user from $host
+EOO
+    is ($one->history, $history, ' and history is correct for attributes');
+    is ($one->attr ('sync', [], @trace), 1,
+        'Removing the kaserver sync attribute works');
+    is ($one->destroy (@trace),1, ' and then destroying wallet/one works');
+    $history .= <<"EOO";
+$date  remove kaserver from attribute sync
+    by $user from $host
+$date  destroy
+    by $user from $host
+EOO
+    is ($one->history, $history, ' and history is correct for removal');
+}
+
+# Tests for enctype restriction.
+SKIP: {
+    skip 'no keytab configuration', 36 unless -f 't/data/test.keytab';
+
+    # Set up our configuration.
+    $Wallet::Config::KEYTAB_FILE      = 't/data/test.keytab';
+    $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal');
+    $Wallet::Config::KEYTAB_REALM     = contents ('t/data/test.realm');
+    $Wallet::Config::KEYTAB_KRBTYPE   = contents ('t/data/test.krbtype');
+    $Wallet::Config::KEYTAB_TMP       = '.';
+    my $realm = $Wallet::Config::KEYTAB_REALM;
+    my $principal = $Wallet::Config::KEYTAB_PRINCIPAL;
+
+    # Create an object for testing and determine the enctypes we have to work
+    # with.
+    my $one = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
+      };
+    if (defined ($one)) {
+        ok (1, 'Creating wallet/one succeeds');
+    } else {
+        is ($@, '', 'Creating wallet/one succeeds');
+    }
+    my $keytab = $one->get (@trace);
+    ok (defined ($keytab), ' and retrieving the keytab works');
+    my @enctypes = grep { $_ ne 'UNKNOWN' } enctypes ($keytab);
+    $history .= <<"EOO";
+$date  create
+    by $user from $host
+$date  get
+    by $user from $host
+EOO
+    is ($one->history, $history, ' and history is still correct');
+
+    # No enctypes we recognize?
+    skip 'no recognized enctypes', 34 unless @enctypes;
+
+    # Set those encryption types and make sure we get back a limited keytab.
+    is ($one->attr ('enctypes', [ @enctypes ], @trace), 1,
+        'Setting enctypes works');
+    is ($one->error, undef, ' with no error');
+    for my $enctype (@enctypes) {
+        $history .= "$date  add $enctype to attribute enctypes\n";
+        $history .= "    by $user from $host\n";
+    }
+    my @values = $one->attr ('enctypes');
+    is ("@values", "@enctypes", ' and we get back the right enctype list');
+    my $eshow = join ("\n" . (' ' x 17), @enctypes);
+    $eshow =~ s/\s+\z/\n/;
+    $expected = <<"EOO";
+           Type: keytab
+           Name: wallet/one
+       Enctypes: $eshow
+     Created by: $user
+   Created from: $host
+     Created on: $date
+  Downloaded by: $user
+Downloaded from: $host
+  Downloaded on: $date
+EOO
+    is ($one->show, $expected, ' and show now displays the enctype list');
+    $keytab = $one->get (@trace);
+    ok (defined ($keytab), ' and retrieving the keytab still works');
+    @values = enctypes ($keytab);
+    is ("@values", "@enctypes", ' and the keytab has the right keys');
+    is ($one->attr ('enctypes', [ 'foo-bar' ], @trace), undef,
+        'Setting an unrecognized enctype fails');
+    is ($one->error, 'unknown encryption type foo-bar',
+        ' with the right error message');
+    is ($one->show, $expected, ' and we did rollback properly');
+    $history .= <<"EOO";
+$date  get
+    by $user from $host
+EOO
+    is ($one->history, $history, 'History is correct to this point');
+
+    # Now, try testing limiting the enctypes to just one.
+  SKIP: {
+        skip 'insufficient recognized enctypes', 14 unless @enctypes > 1;
+
+        is ($one->attr ('enctypes', [ $enctypes[0] ], @trace), 1,
+            'Setting a single enctype works');
+        for my $enctype (@enctypes) {
+            next if $enctype eq $enctypes[0];
+            $history .= "$date  remove $enctype from attribute enctypes\n";
+            $history .= "    by $user from $host\n";
+        }
+        @values = $one->attr ('enctypes');
+        is ("@values", $enctypes[0], ' and we get back the right value');
+        $keytab = $one->get (@trace);
+        ok (defined ($keytab), ' and retrieving the keytab still works');
+        if (defined ($keytab)) {
+            @values = enctypes ($keytab);
+            is ("@values", $enctypes[0], ' and it has the right enctype');
+        } else {
+            ok (0, ' and it has the right keytab');
+        }
+        is ($one->attr ('enctypes', [ $enctypes[1] ], @trace), 1,
+            'Setting a different single enctype works');
+        @values = $one->attr ('enctypes');
+        is ("@values", $enctypes[1], ' and we get back the right value');
+        $keytab = $one->get (@trace);
+        ok (defined ($keytab), ' and retrieving the keytab still works');
+        @values = enctypes ($keytab);
+        is ("@values", $enctypes[1], ' and it has the right enctype');
+        is ($one->attr ('enctypes', [ @enctypes[0..1] ], @trace), 1,
+            'Setting two enctypes works');
+        @values = $one->attr ('enctypes');
+        is ("@values", "@enctypes[0..1]", ' and we get back the right values');
+        $keytab = $one->get (@trace);
+        ok (defined ($keytab), ' and retrieving the keytab still works');
+        @values = enctypes ($keytab);
+        is ("@values", "@enctypes[0..1]", ' and it has the right enctypes');
+
+        # Check the history trace.  Put back all the enctypes for consistent
+        # status whether or not we skipped this section.
+        $history .= <<"EOO";
+$date  get
+    by $user from $host
+$date  remove $enctypes[0] from attribute enctypes
+    by $user from $host
+$date  add $enctypes[1] to attribute enctypes
+    by $user from $host
+$date  get
+    by $user from $host
+$date  add $enctypes[0] to attribute enctypes
+    by $user from $host
+$date  get
+    by $user from $host
+EOO
+        is ($one->attr ('enctypes', [ @enctypes ], @trace), 1,
+            'Restoring all enctypes works');
+        for my $enctype (@enctypes) {
+            next if $enctype eq $enctypes[0];
+            next if $enctype eq $enctypes[1];
+            $history .= "$date  add $enctype to attribute enctypes\n";
+            $history .= "    by $user from $host\n";
+        }
+        is ($one->history, $history, 'History is correct to this point');
+    }
+
+    # Test clearing enctypes.
+    is ($one->attr ('enctypes', [], @trace), 1, 'Clearing enctypes works');
+    for my $enctype (@enctypes) {
+        $history .= "$date  remove $enctype from attribute enctypes\n";
+        $history .= "    by $user from $host\n";
+    }
+    @values = $one->attr ('enctypes');
+    ok (@values == 0, ' and now there are no enctypes');
+    is ($one->error, undef, ' and no error');
+
+    # Test deleting enctypes on object destruction.
+    is ($one->attr ('enctypes', [ $enctypes[0] ], @trace), 1,
+        'Setting a single enctype works');
+    is ($one->destroy (@trace), 1, ' and destroying the object works');
+    $one = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+                                        @trace)
+      };
+    ok (defined ($one), ' as does recreating it');
+    @values = $one->attr ('enctypes');
+    ok (@values == 0, ' and now there are no enctypes');
+    is ($one->error, undef, ' and no error');
+
+    # All done.  Clean up and check history.
+    is ($one->destroy (@trace), 1, 'Destroying wallet/one works');
+    $history .= <<"EOO";
+$date  add $enctypes[0] to attribute enctypes
+    by $user from $host
+$date  destroy
+    by $user from $host
+$date  create
+    by $user from $host
+$date  destroy
+    by $user from $host
+EOO
+    is ($one->history, $history, 'History is correct to this point');
+}
+
+# Clean up.
+$admin->destroy;
+END {
+    unlink ('wallet-db', 'krb5cc_temp', 'krb5cc_test', 'test-acl', 'test-pid');
+}
diff --git a/perl/t/object/wa-keyring.t b/perl/t/object/wa-keyring.t
new file mode 100755
index 0000000..8d8e1fe
--- /dev/null
+++ b/perl/t/object/wa-keyring.t
@@ -0,0 +1,184 @@
+#!/usr/bin/perl
+#
+# Tests for the WebAuth keyring object implementation.
+#
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2013, 2014
+#     The Board of Trustees of the Leland Stanford Junior University
+#
+# See LICENSE for licensing terms.
+
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+    eval 'use WebAuth 3.06 qw(WA_KEY_AES WA_AES_128)';
+    plan skip_all => 'WebAuth 3.06 required for testing wa-keyring'
+      if $@;
+}
+
+use POSIX qw(strftime);
+use WebAuth::Key 1.01 ();
+use WebAuth::Keyring 1.02 ();
+
+BEGIN {
+    plan tests => 68;
+    use_ok('Wallet::Admin');
+    use_ok('Wallet::Config');
+    use_ok('Wallet::Object::WAKeyring');
+}
+
+use lib 't/lib';
+use Util;
+
+# Some global defaults to use.
+my $user = 'admin@EXAMPLE.COM';
+my $host = 'localhost';
+my @trace = ($user, $host, time);
+
+# Flush all output immediately.
+$| = 1;
+
+# Use Wallet::Admin to set up the database.
+system ('rm -rf test-keyrings') == 0 or die "cannot remove test-keyrings\n";
+db_setup;
+my $admin = eval { Wallet::Admin->new };
+is ($@, '', 'Database connection succeeded');
+is ($admin->reinitialize ($user), 1, 'Database initialization succeeded');
+my $schema = $admin->schema;
+
+# Create a WebAuth context to use.
+my $wa = WebAuth->new;
+
+# Test error handling in the absence of configuration.
+my $object = eval {
+    Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace)
+  };
+ok (defined ($object), 'Creating a basic WebAuth keyring object succeeds');
+ok ($object->isa ('Wallet::Object::WAKeyring'), ' and is the right class');
+is ($object->get (@trace), undef, ' and get fails');
+is ($object->error, 'WebAuth keyring support not configured',
+    ' with the right error');
+is ($object->store (@trace), undef, ' and store fails');
+is ($object->error, 'WebAuth keyring support not configured',
+    ' with the right error');
+is ($object->destroy (@trace), 1, ' but destroy succeeds');
+
+# Set up our configuration.
+mkdir 'test-keyrings' or die "cannot create test-keyrings: $!\n";
+$Wallet::Config::WAKEYRING_BUCKET = 'test-keyrings';
+
+# Okay, now we can test.  First, the basic object without store.
+$object = eval {
+    Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace)
+  };
+ok (defined ($object), 'Creating a basic WebAuth keyring object succeeds');
+ok ($object->isa ('Wallet::Object::WAKeyring'), ' and is the right class');
+my $data = $object->get (@trace);
+ok ($data, ' and get succeeds');
+my $keyring = WebAuth::Keyring->decode ($wa, $data);
+ok ($keyring->isa ('WebAuth::Keyring'), ' and resulting keyring decodes');
+my @entries = $keyring->entries;
+is (scalar (@entries), 3, ' and has three entries');
+is ($entries[0]->creation, 0, 'First has good creation');
+is ($entries[0]->key->type, WA_KEY_AES, ' and key type');
+is ($entries[0]->key->length, WA_AES_128, ' and key length');
+is ($entries[0]->valid_after, 0, ' and validity');
+ok ((time - $entries[1]->creation) < 2, 'Second has good creation');
+is ($entries[1]->key->type, WA_KEY_AES, ' and key type');
+is ($entries[1]->key->length, WA_AES_128, ' and key length');
+ok (($entries[1]->valid_after - time) <= 60 * 60 * 24,
+    ' and validity (upper)');
+ok (($entries[1]->valid_after - time) > 60 * 60 * 24 - 2,
+    ' and validity (lower)');
+ok ((time - $entries[2]->creation) < 2, 'Third has good creation');
+is ($entries[2]->key->type, WA_KEY_AES, ' and key type');
+is ($entries[2]->key->length, WA_AES_128, ' and key length');
+ok (($entries[2]->valid_after - time) <= 2 * 60 * 60 * 24,
+    ' and validity (upper)');
+ok (($entries[2]->valid_after - time) > 2 * 60 * 60 * 24 - 2,
+    ' and validity (lower)');
+my $data2 = $object->get (@trace);
+is ($data2, $data, 'Getting the object again returns the same data');
+is ($object->error, undef, ' with no error');
+is ($object->destroy (@trace), 1, 'Destroying the object succeeds');
+
+# Now store something and be sure that we get something reasonable.
+$object = eval {
+    Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace)
+  };
+ok (defined ($object), 'Recreating the object succeeds');
+my $key = WebAuth::Key->new ($wa, WA_KEY_AES, WA_AES_128);
+$keyring = WebAuth::Keyring->new ($wa, $key);
+$data = $keyring->encode;
+is ($object->store ($data, @trace), 1, ' and storing data in it succeeds');
+ok (-d 'test-keyrings/09', ' and the hash bucket was created');
+ok (-f 'test-keyrings/09/test', ' and the file exists');
+is (contents ('test-keyrings/09/test'), $data, ' with the right contents');
+$data = $object->get (@trace);
+$keyring = WebAuth::Keyring->decode ($wa, $data);
+ok ($keyring->isa ('WebAuth::Keyring'), ' and get returns a valid keyring');
+@entries = $keyring->entries;
+is (scalar (@entries), 2, ' and has three entries');
+is ($entries[0]->creation, 0, 'First has good creation');
+is ($entries[0]->key->type, WA_KEY_AES, ' and key type');
+is ($entries[0]->key->length, WA_AES_128, ' and key length');
+is ($entries[0]->valid_after, 0, ' and validity');
+is ($entries[0]->key->data, $key->data, ' and matches the original key');
+ok ((time - $entries[1]->creation) < 2, 'Second has good creation');
+is ($entries[1]->key->type, WA_KEY_AES, ' and key type');
+is ($entries[1]->key->length, WA_AES_128, ' and key length');
+ok (($entries[1]->valid_after - time) <= 2 * 60 * 60 * 24,
+    ' and validity (upper)');
+ok (($entries[1]->valid_after - time) > 2 * 60 * 60 * 24 - 2,
+    ' and validity (lower)');
+
+# Test pruning.  Add another old key and a couple of more current keys to the
+# current keyring.
+$key = WebAuth::Key->new ($wa, WA_KEY_AES, WA_AES_128);
+$keyring->add (0, 0, $key);
+$key = WebAuth::Key->new ($wa, WA_KEY_AES, WA_AES_128);
+$keyring->add (time - 24 * 60 * 60, time - 24 * 60 * 60, $key);
+$key = WebAuth::Key->new ($wa, WA_KEY_AES, WA_AES_128);
+$keyring->add (time, time, $key);
+$data = $keyring->encode;
+is ($object->store ($data, @trace), 1, 'Storing modified keyring succeeds');
+$data = $object->get (@trace);
+$keyring = WebAuth::Keyring->decode ($wa, $data);
+ok ($keyring->isa ('WebAuth::Keyring'), ' and get returns a valid keyring');
+@entries = $keyring->entries;
+is (scalar (@entries), 3, ' and has three entries');
+ok ((time - $entries[0]->creation) < 2, 'First has good creation');
+ok (($entries[0]->valid_after - time) <= 2 * 60 * 60 * 24,
+    ' and validity (upper)');
+ok (($entries[0]->valid_after - time) > 2 * 60 * 60 * 24 - 2,
+    ' and validity (lower)');
+ok ((time - $entries[1]->creation) < 24 * 60 * 60 + 2,
+    'Second has good creation');
+ok ((time - $entries[1]->valid_after) <= 60 * 60 * 24 + 2,
+    ' and validity');
+ok ((time - $entries[2]->creation) < 2, 'Third has good creation');
+ok ((time - $entries[2]->valid_after) < 2, ' and validity');
+is ($object->destroy (@trace), 1, 'Destroying the object succeeds');
+
+# Test error handling in the file store.
+system ('rm -r test-keyrings') == 0 or die "cannot remove test-keyrings\n";
+$object = eval {
+    Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace)
+  };
+ok (defined ($object), 'Recreating the object succeeds');
+is ($object->get (@trace), undef, ' but retrieving it fails');
+like ($object->error, qr/^cannot create keyring bucket 09: /,
+      ' with the right error');
+is ($object->store ("foo\n", @trace), undef, ' and store fails');
+like ($object->error, qr/^cannot create keyring bucket 09: /,
+      ' with the right error');
+is ($object->destroy (@trace), 1, ' but destroying the object succeeds');
+
+# Clean up.
+$admin->destroy;
+END {
+    unlink ('wallet-db');
+}