Merge tag 'upstream/1.1' into debian

Upstream version 1.1

Conflicts:
	NEWS
	README
	client/keytab.c
	perl/lib/Wallet/ACL.pm
	perl/sql/Wallet-Schema-0.08-PostgreSQL.sql
	perl/t/general/admin.t
	perl/t/verifier/ldap-attr.t

Change-Id: I1a1dc09b97c9258e61f1c8877d0837193c8ae2c6

5 files changed, 1623 insertions, 0 deletions

diff --git a/perl/t/object/base.t b/perl/t/object/base.t
new file mode 100755
index 0000000..ee9ff4b
--- /dev/null
+++ b/perl/t/object/base.t
@@ -0,0 +1,356 @@
+#!/usr/bin/perl
+#
+# 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 strict;
+use warnings;
+
+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->name, ' 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->name, ' 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->name, @trace), 1,
+        ' and setting it again by name 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, 'ADMIN', ' 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), 'ADMIN', " 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..201f46d
--- /dev/null
+++ b/perl/t/object/file.t
@@ -0,0 +1,153 @@
+#!/usr/bin/perl
+#
+# 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 strict;
+use warnings;
+
+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.
+my $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..69db438
--- /dev/null
+++ b/perl/t/object/keytab.t
@@ -0,0 +1,774 @@
+#!/usr/bin/perl
+#
+# 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 strict;
+use warnings;
+
+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;
+        my $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;
+    my $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', 32 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', 37 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/;
+    my $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..4a3bd48
--- /dev/null
+++ b/perl/t/object/wa-keyring.t
@@ -0,0 +1,183 @@
+#!/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 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');
+}