summaryrefslogtreecommitdiff
path: root/perl/t
diff options
context:
space:
mode:
Diffstat (limited to 'perl/t')
-rwxr-xr-xperl/t/acl.t29
-rwxr-xr-xperl/t/admin.t24
-rwxr-xr-xperl/t/config.t3
-rw-r--r--perl/t/data/README10
-rwxr-xr-xperl/t/file.t17
-rwxr-xr-xperl/t/init.t9
-rwxr-xr-xperl/t/kadmin.t9
-rwxr-xr-xperl/t/keytab.t70
-rw-r--r--perl/t/lib/Util.pm9
-rwxr-xr-xperl/t/object.t52
-rwxr-xr-xperl/t/pod.t3
-rwxr-xr-xperl/t/report.t5
-rwxr-xr-xperl/t/schema.t73
-rwxr-xr-xperl/t/server.t86
-rwxr-xr-xperl/t/stanford-naming.t257
-rwxr-xr-xperl/t/verifier-ldap-attr.t73
-rwxr-xr-xperl/t/verifier-netdb.t3
-rwxr-xr-xperl/t/verifier.t3
-rwxr-xr-xperl/t/wa-keyring.t175
19 files changed, 748 insertions, 162 deletions
diff --git a/perl/t/acl.t b/perl/t/acl.t
index f169eb5..26b4903 100755
--- a/perl/t/acl.t
+++ b/perl/t/acl.t
@@ -3,7 +3,8 @@
# Tests for the wallet ACL API.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
@@ -29,30 +30,30 @@ db_setup;
my $setup = eval { Wallet::Admin->new };
is ($@, '', 'Database connection succeeded');
is ($setup->reinitialize ($setup), 1, 'Database initialization succeeded');
-my $dbh = $setup->dbh;
+my $schema = $setup->schema;
# Test create and new.
-my $acl = eval { Wallet::ACL->create ('test', $dbh, @trace) };
+my $acl = eval { Wallet::ACL->create ('test', $schema, @trace) };
ok (defined ($acl), 'ACL creation');
is ($@, '', ' with no exceptions');
ok ($acl->isa ('Wallet::ACL'), ' and the right class');
is ($acl->name, 'test', ' and the right name');
is ($acl->id, 2, ' and the right ID');
-$acl = eval { Wallet::ACL->create (3, $dbh, @trace) };
+$acl = eval { Wallet::ACL->create (3, $schema, @trace) };
ok (!defined ($acl), 'Creating with a numeric name');
is ($@, "ACL name may not be all numbers\n", ' with the right error message');
-$acl = eval { Wallet::ACL->create ('test', $dbh, @trace) };
+$acl = eval { Wallet::ACL->create ('test', $schema, @trace) };
ok (!defined ($acl), 'Creating a duplicate object');
like ($@, qr/^cannot create ACL test: /, ' with the right error message');
-$acl = eval { Wallet::ACL->new ('test2', $dbh) };
+$acl = eval { Wallet::ACL->new ('test2', $schema) };
ok (!defined ($acl), 'Searching for a non-existent ACL');
is ($@, "ACL test2 not found\n", ' with the right error message');
-$acl = eval { Wallet::ACL->new ('test', $dbh) };
+$acl = eval { Wallet::ACL->new ('test', $schema) };
ok (defined ($acl), 'Searching for the test ACL by name');
is ($@, '', ' with no exceptions');
ok ($acl->isa ('Wallet::ACL'), ' and the right class');
is ($acl->id, 2, ' and the right ID');
-$acl = eval { Wallet::ACL->new (2, $dbh) };
+$acl = eval { Wallet::ACL->new (2, $schema) };
ok (defined ($acl), 'Searching for the test ACL by ID');
is ($@, '', ' with no exceptions');
ok ($acl->isa ('Wallet::ACL'), ' and the right class');
@@ -66,15 +67,15 @@ if ($acl->rename ('example')) {
}
is ($acl->name, 'example', ' and the new name is right');
is ($acl->id, 2, ' and the ID did not change');
-$acl = eval { Wallet::ACL->new ('test', $dbh) };
+$acl = eval { Wallet::ACL->new ('test', $schema) };
ok (!defined ($acl), ' and it cannot be found under the old name');
is ($@, "ACL test not found\n", ' with the right error message');
-$acl = eval { Wallet::ACL->new ('example', $dbh) };
+$acl = eval { Wallet::ACL->new ('example', $schema) };
ok (defined ($acl), ' and it can be found with the new name');
is ($@, '', ' with no exceptions');
is ($acl->name, 'example', ' and the right name');
is ($acl->id, 2, ' and the right ID');
-$acl = eval { Wallet::ACL->new (2, $dbh) };
+$acl = eval { Wallet::ACL->new (2, $schema) };
ok (defined ($acl), ' and it can still found by ID');
is ($@, '', ' with no exceptions');
is ($acl->name, 'example', ' and the right name');
@@ -212,13 +213,13 @@ if ($acl->destroy (@trace)) {
} else {
is ($acl->error, '', 'Destroying the ACL works');
}
-$acl = eval { Wallet::ACL->new ('example', $dbh) };
+$acl = eval { Wallet::ACL->new ('example', $schema) };
ok (!defined ($acl), ' and now cannot be found');
is ($@, "ACL example not found\n", ' with the right error message');
-$acl = eval { Wallet::ACL->new (2, $dbh) };
+$acl = eval { Wallet::ACL->new (2, $schema) };
ok (!defined ($acl), ' or by ID');
is ($@, "ACL 2 not found\n", ' with the right error message');
-$acl = eval { Wallet::ACL->create ('example', $dbh, @trace) };
+$acl = eval { Wallet::ACL->create ('example', $schema, @trace) };
ok (defined ($acl), ' and creating another with the same name works');
is ($@, '', ' with no exceptions');
is ($acl->name, 'example', ' and the right name');
diff --git a/perl/t/admin.t b/perl/t/admin.t
index 074dbc6..a11b9b2 100755
--- a/perl/t/admin.t
+++ b/perl/t/admin.t
@@ -3,16 +3,18 @@
# Tests for wallet administrative interface.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008, 2009, 2010, 2011
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
-use Test::More tests => 16;
+use Test::More tests => 23;
use Wallet::Admin;
use Wallet::Report;
use Wallet::Schema;
use Wallet::Server;
+use DBI;
use lib 't/lib';
use Util;
@@ -24,6 +26,8 @@ is ($@, '', 'Wallet::Admin creation did not die');
ok ($admin->isa ('Wallet::Admin'), ' and returned the right class');
is ($admin->initialize ('admin@EXAMPLE.COM'), 1,
' and initialization succeeds');
+is ($admin->upgrade, 1, ' and upgrade succeeds (should do nothing)');
+is ($admin->error, undef, ' and there is no error');
# We have an empty database, so we should see no objects and one ACL.
my $report = Wallet::Report->new;
@@ -53,6 +57,22 @@ is ($admin->register_verifier ('base', 'Wallet::ACL::Base'), undef,
is ($server->acl_add ('ADMIN', 'base', 'foo'), 1,
' and adding a base ACL now works');
+# Test an upgrade. Reinitialize to an older version, then test upgrade to
+# the current version.
+$Wallet::Schema::VERSION = '0.07';
+is ($admin->reinitialize ('admin@EXAMPLE.COM'), 1,
+ ' and re-initialization succeeds');
+$Wallet::Schema::VERSION = '0.08';
+my $retval = $admin->upgrade;
+is ($retval, 1, 'Performing an upgrade succeeds');
+my $dbh = $admin->dbh;
+my $sql = "select version from dbix_class_schema_versions order by version "
+ ."DESC";
+$version = $dbh->selectall_arrayref ($sql);
+is (@$version, 2, ' and versions table has correct number of rows');
+is (@{ $version->[0] }, 1, ' and correct number of columns');
+is ($version->[0][0], '0.08', ' and the schema version is correct');
+
# Clean up.
is ($admin->destroy, 1, 'Destruction succeeds');
unlink 'wallet-db';
diff --git a/perl/t/config.t b/perl/t/config.t
index 6b9f226..543e5d6 100755
--- a/perl/t/config.t
+++ b/perl/t/config.t
@@ -3,7 +3,8 @@
# Tests for the wallet server configuration.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008, 2010
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
diff --git a/perl/t/data/README b/perl/t/data/README
index d250d33..4ceccff 100644
--- a/perl/t/data/README
+++ b/perl/t/data/README
@@ -58,3 +58,13 @@ also need to be configured in your local krb.conf (but not krb.realms).
The test process will create the principals wallet.one and wallet.two and
on success will clean up after itself. If the test fails, they may be
left behind in the AFS kaserver.
+
+-----
+
+Copyright 2007, 2009, 2013
+ The Board of Trustees of the Leland Stanford Junior University
+
+Copying and distribution of this file, with or without modification, are
+permitted in any medium without royalty provided the copyright notice and
+this notice are preserved. This file is offered as-is, without any
+warranty.
diff --git a/perl/t/file.t b/perl/t/file.t
index a821c4f..5cb7c35 100755
--- a/perl/t/file.t
+++ b/perl/t/file.t
@@ -3,7 +3,8 @@
# Tests for the file object implementation.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
@@ -31,7 +32,7 @@ db_setup;
my $admin = eval { Wallet::Admin->new };
is ($@, '', 'Database connection succeeded');
is ($admin->reinitialize ($user), 1, 'Database initialization succeeded');
-my $dbh = $admin->dbh;
+my $schema = $admin->schema;
# Use this to accumulate the history traces so that we can check history.
my $history = '';
@@ -39,7 +40,7 @@ my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]);
# Test error handling in the absence of configuration.
$object = eval {
- Wallet::Object::File->create ('file', 'test', $dbh, @trace)
+ Wallet::Object::File->create ('file', 'test', $schema, @trace)
};
ok (defined ($object), 'Creating a basic file object succeeds');
ok ($object->isa ('Wallet::Object::File'), ' and is the right class');
@@ -55,7 +56,7 @@ $Wallet::Config::FILE_BUCKET = 'test-files';
# Okay, now we can test. First, the basic object without store.
$object = eval {
- Wallet::Object::File->create ('file', 'test', $dbh, @trace)
+ Wallet::Object::File->create ('file', 'test', $schema, @trace)
};
ok (defined ($object), 'Creating a basic file object succeeds');
ok ($object->isa ('Wallet::Object::File'), ' and is the right class');
@@ -66,7 +67,7 @@ is ($object->destroy (@trace), 1, ' but destroying the object succeeds');
# Now store something and be sure that we get something reasonable.
$object = eval {
- Wallet::Object::File->create ('file', 'test', $dbh, @trace)
+ Wallet::Object::File->create ('file', 'test', $schema, @trace)
};
ok (defined ($object), 'Recreating the object succeeds');
is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds');
@@ -103,7 +104,7 @@ ok (! -f 'test-files/09/test', ' and the file is gone');
# Now try some aggressive names.
$object = eval {
- Wallet::Object::File->create ('file', '../foo', $dbh, @trace)
+ Wallet::Object::File->create ('file', '../foo', $schema, @trace)
};
ok (defined ($object), 'Creating ../foo succeeds');
is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds');
@@ -115,7 +116,7 @@ is ($object->get (@trace), "foo\n", ' and get returns correctly');
is ($object->destroy (@trace), 1, 'Destroying the object works');
ok (! -f 'test-files/39/%2E%2E%2Ffoo', ' and the file is gone');
$object = eval {
- Wallet::Object::File->create ('file', "\0", $dbh, @trace)
+ Wallet::Object::File->create ('file', "\0", $schema, @trace)
};
ok (defined ($object), 'Creating nul succeeds');
is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds');
@@ -130,7 +131,7 @@ ok (! -f 'test-files/93/%00', ' and the file is gone');
# Test error handling in the file store.
system ('rm -r test-files') == 0 or die "cannot remove test-files\n";
$object = eval {
- Wallet::Object::File->create ('file', 'test', $dbh, @trace)
+ Wallet::Object::File->create ('file', 'test', $schema, @trace)
};
ok (defined ($object), 'Recreating the object succeeds');
is ($object->store ("foo\n", @trace), undef,
diff --git a/perl/t/init.t b/perl/t/init.t
index 213aedf..142f54c 100755
--- a/perl/t/init.t
+++ b/perl/t/init.t
@@ -3,7 +3,8 @@
# Tests for database initialization.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
@@ -24,7 +25,7 @@ is ($admin->initialize ('admin@EXAMPLE.COM'), 1,
' and initialization succeeds');
# Check whether the database entries that should be created were.
-my $acl = eval { Wallet::ACL->new ('ADMIN', $admin->dbh) };
+my $acl = eval { Wallet::ACL->new ('ADMIN', $admin->schema) };
is ($@, '', 'Retrieving ADMIN ACL successful');
ok ($acl->isa ('Wallet::ACL'), ' and is the right class');
my @entries = $acl->list;
@@ -38,7 +39,7 @@ is ($admin->reinitialize ('admin@EXAMPLE.ORG'), 1,
'Reinitialization succeeded');
# Now repeat the database content checks.
-$acl = eval { Wallet::ACL->new ('ADMIN', $admin->dbh) };
+$acl = eval { Wallet::ACL->new ('ADMIN', $admin->schema) };
is ($@, '', 'Retrieving ADMIN ACL successful');
ok ($acl->isa ('Wallet::ACL'), ' and is the right class');
@entries = $acl->list;
@@ -49,7 +50,7 @@ is ($entries[0][1], 'admin@EXAMPLE.ORG', ' with the right user');
# Test cleanup.
is ($admin->destroy, 1, 'Destroying the database works');
-$acl = eval { Wallet::ACL->new ('ADMIN', $admin->dbh) };
+$acl = eval { Wallet::ACL->new ('ADMIN', $admin->schema) };
like ($@, qr/^cannot search for ACL ADMIN: /,
' and now the database is gone');
unlink 'wallet-db';
diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t
index a1f2876..8eabc6b 100755
--- a/perl/t/kadmin.t
+++ b/perl/t/kadmin.t
@@ -3,12 +3,13 @@
# Tests for the kadmin object implementation.
#
# Written by Jon Robertson <jonrober@stanford.edu>
-# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2009, 2010, 2012, 2013
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
use POSIX qw(strftime);
-use Test::More tests => 32;
+use Test::More tests => 34;
BEGIN { $Wallet::Config::KEYTAB_TMP = '.' }
@@ -72,7 +73,7 @@ SKIP: {
# implementation is configured. This retests some things that are also tested
# by the keytab test, but specifically through the Wallet::Kadmin API.
SKIP: {
- skip 'no keytab configuration', 14 unless -f 't/data/test.keytab';
+ skip 'no keytab configuration', 16 unless -f 't/data/test.keytab';
# Set up our configuration.
$Wallet::Config::KEYTAB_FILE = 't/data/test.keytab';
@@ -90,10 +91,12 @@ SKIP: {
is ($@, '', ' and there is no error');
is ($kadmin->destroy ('wallet/one'), 1, 'Deleting wallet/one works');
is ($kadmin->exists ('wallet/one'), 0, ' and it does not exist');
+ is ($kadmin->error, undef, ' with no error message');
# Create the principal and check that keytab returns something. We'll
# check the details of the return in the keytab check.
is ($kadmin->create ('wallet/one'), 1, 'Creating wallet/one works');
+ is ($kadmin->error, undef, ' with no error message');
is ($kadmin->exists ('wallet/one'), 1, ' and it now exists');
my $data = $kadmin->keytab_rekey ('wallet/one');
ok (defined ($data), ' and retrieving a keytab works');
diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index fabdc5b..f89b2c6 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -3,16 +3,17 @@
# Tests for the keytab object implementation.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2009, 2010
-# Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2009, 2010, 2013
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
use POSIX qw(strftime);
-use Test::More tests => 135;
+use Test::More tests => 139;
BEGIN { $Wallet::Config::KEYTAB_TMP = '.' }
+use DBI;
use Wallet::Admin;
use Wallet::Config;
use Wallet::Kadmin;
@@ -146,6 +147,7 @@ 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.
@@ -173,7 +175,8 @@ SKIP: {
# Test that object creation without KEYTAB_TMP fails.
undef $Wallet::Config::KEYTAB_TMP;
$object = eval {
- Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+ Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+ @trace)
};
is ($object, undef, 'Creating keytab without KEYTAB_TMP fails');
is ($@, "KEYTAB_TMP configuration variable not set\n",
@@ -182,7 +185,8 @@ SKIP: {
# Okay, now we can test. First, create.
$object = eval {
- Wallet::Object::Keytab->create ('keytab', "wallet\nf", $dbh, @trace)
+ Wallet::Object::Keytab->create ('keytab', "wallet\nf", $schema,
+ @trace)
};
is ($object, undef, 'Creating malformed principal fails');
if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
@@ -192,7 +196,7 @@ SKIP: {
' with the right error');
}
$object = eval {
- Wallet::Object::Keytab->create ('keytab', '', $dbh, @trace)
+ Wallet::Object::Keytab->create ('keytab', '', $schema, @trace)
};
is ($object, undef, 'Creating empty principal fails');
if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
@@ -201,7 +205,8 @@ SKIP: {
like ($@, qr/^error adding principal \@/, ' with the right error');
}
$object = eval {
- Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+ Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+ @trace)
};
if (defined ($object)) {
ok (defined ($object), 'Creating good principal succeeds');
@@ -212,7 +217,8 @@ SKIP: {
ok (created ('wallet/one'), ' and the principal was created');
create ('wallet/two');
$object = eval {
- Wallet::Object::Keytab->create ('keytab', 'wallet/two', $dbh, @trace)
+ Wallet::Object::Keytab->create ('keytab', 'wallet/two', $schema,
+ @trace)
};
if (defined ($object)) {
ok (defined ($object), 'Creating an existing principal succeeds');
@@ -224,13 +230,13 @@ SKIP: {
is ($object->error, undef, ' with no error message');
ok (! created ('wallet/two'), ' and now it does not exist');
my @name = qw(keytab wallet-test/one);
- $object = eval { Wallet::Object::Keytab->create (@name, $dbh, @trace) };
+ $object = eval { Wallet::Object::Keytab->create (@name, $schema, @trace) };
is ($object, undef, 'Creation without permissions fails');
like ($@, qr{^error adding principal wallet-test/one\@\Q$realm: },
' with the right error');
# Now, try retrieving the keytab.
- $object = Wallet::Object::Keytab->new ('keytab', 'wallet/one', $dbh);
+ $object = Wallet::Object::Keytab->new ('keytab', 'wallet/one', $schema);
ok (defined ($object), 'Retrieving the object works');
ok ($object->isa ('Wallet::Object::Keytab'), ' and is the right type');
is ($object->flag_set ('locked', @trace), 1, ' and setting locked works');
@@ -283,7 +289,8 @@ EOO
# Test principal deletion on object destruction.
$object = eval {
- Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+ Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+ @trace)
};
ok (defined ($object), 'Creating good principal succeeds');
ok (created ('wallet/one'), ' and the principal was created');
@@ -332,7 +339,8 @@ EOO
# Test configuration errors.
undef $Wallet::Config::KEYTAB_FILE;
$object = eval {
- Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+ Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+ @trace)
};
is ($object, undef, 'Creating with bad configuration fails');
is ($@, "keytab object implementation not configured\n",
@@ -340,7 +348,8 @@ EOO
$Wallet::Config::KEYTAB_FILE = 't/data/test.keytab';
undef $Wallet::Config::KEYTAB_PRINCIPAL;
$object = eval {
- Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+ Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+ @trace)
};
is ($object, undef, ' likewise with another missing variable');
is ($@, "keytab object implementation not configured\n",
@@ -348,7 +357,8 @@ EOO
$Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal');
undef $Wallet::Config::KEYTAB_REALM;
$object = eval {
- Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+ Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+ @trace)
};
is ($object, undef, ' and another');
is ($@, "keytab object implementation not configured\n",
@@ -356,14 +366,16 @@ EOO
$Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm');
undef $Wallet::Config::KEYTAB_KRBTYPE;
$object = eval {
- Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+ Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+ @trace)
};
is ($object, undef, ' and another');
is ($@, "keytab object implementation not configured\n",
' with the right error');
$Wallet::Config::KEYTAB_KRBTYPE = 'Active Directory';
$object = eval {
- Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+ Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+ @trace)
};
is ($object, undef, ' and one set to an invalid value');
is ($@, "unknown KEYTAB_KRBTYPE setting: Active Directory\n",
@@ -374,7 +386,7 @@ EOO
# Tests for unchanging support. Skip these if we don't have a keytab or if we
# can't find remctld.
SKIP: {
- skip 'no keytab configuration', 27 unless -f 't/data/test.keytab';
+ skip 'no keytab configuration', 31 unless -f 't/data/test.keytab';
# Set up our configuration.
$Wallet::Config::KEYTAB_FILE = 't/data/test.keytab';
@@ -387,27 +399,29 @@ SKIP: {
# Create the objects for testing and set the unchanging flag.
my $one = eval {
- Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+ Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+ @trace)
};
ok (defined ($one), 'Creating wallet/one succeeds');
is ($one->flag_set ('unchanging', @trace), 1, ' and setting unchanging');
my $two = eval {
- Wallet::Object::Keytab->create ('keytab', 'wallet/two', $dbh, @trace);
+ Wallet::Object::Keytab->create ('keytab', 'wallet/two', $schema,
+ @trace);
};
ok (defined ($two), 'Creating wallet/two succeeds');
is ($two->flag_set ('unchanging', @trace), 1, ' and setting unchanging');
# Finally we can test. First the MIT Kerberos tests.
SKIP: {
- skip 'skipping MIT unchanging tests for Heimdal', 12
+ skip 'skipping MIT unchanging tests for Heimdal', 16
if (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'heimdal');
# We need remctld and Net::Remctl.
my @path = (split (':', $ENV{PATH}), '/usr/local/sbin', '/usr/sbin');
my ($remctld) = grep { -x $_ } map { "$_/remctld" } @path;
- skip 'remctld not found', 12 unless $remctld;
+ skip 'remctld not found', 16 unless $remctld;
eval { require Net::Remctl };
- skip 'Net::Remctl not available', 12 if $@;
+ skip 'Net::Remctl not available', 16 if $@;
# Now spawn our remctld server and get a ticket cache.
remctld_spawn ($remctld, $principal, 't/data/test.keytab',
@@ -441,7 +455,7 @@ SKIP: {
' and we get the same thing the second time');
is ($one->flag_clear ('unchanging', @trace), 1,
'Clearing the unchanging flag works');
- my $data = $object->get (@trace);
+ my $data = $one->get (@trace);
ok (defined ($data), ' and getting the keytab works');
ok (keytab_valid ($data, 'wallet/one'), ' and the keytab is valid');
is ($two->get (@trace), undef, 'Get for wallet/two does not work');
@@ -451,6 +465,7 @@ SKIP: {
is ($one->destroy (@trace), 1, 'Destroying wallet/one works');
is ($two->destroy (@trace), 1, ' as does destroying wallet/two');
remctld_stop;
+ unlink 'krb5cc_good';
}
# Now Heimdal. Since the keytab contains timestamps, before testing for
@@ -506,7 +521,8 @@ SKIP: {
# Test setting synchronization attributes, which can also be done without
# configuration.
my $one = eval {
- Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+ Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+ @trace)
};
ok (defined ($one), 'Creating wallet/one succeeds');
my $expected = <<"EOO";
@@ -583,7 +599,8 @@ SKIP: {
# Create an object for testing and determine the enctypes we have to work
# with.
my $one = eval {
- Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+ Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+ @trace)
};
if (defined ($one)) {
ok (1, 'Creating wallet/one succeeds');
@@ -729,7 +746,8 @@ EOO
'Setting a single enctype works');
is ($one->destroy (@trace), 1, ' and destroying the object works');
$one = eval {
- Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+ Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
+ @trace)
};
ok (defined ($one), ' as does recreating it');
@values = $one->attr ('enctypes');
diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm
index 44a4d21..3e606fe 100644
--- a/perl/t/lib/Util.pm
+++ b/perl/t/lib/Util.pm
@@ -1,7 +1,8 @@
# Utility class for wallet tests.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
@@ -45,6 +46,7 @@ sub contents {
# for testing by default, but support t/data/test.database as a configuration
# file to use another database backend.
sub db_setup {
+ $Wallet::Config::DB_DDL_DIRECTORY = 'sql/';
if (-f 't/data/test.database') {
open (DB, '<', 't/data/test.database')
or die "cannot open t/data/test.database: $!";
@@ -60,6 +62,10 @@ sub db_setup {
$Wallet::Config::DB_USER = $user if $user;
$Wallet::Config::DB_PASSWORD = $password if $password;
} else {
+
+ # If we have a new SQLite db by default, disable version checking.
+ $ENV{DBIC_NO_VERSION_CHECK} = 1;
+
$Wallet::Config::DB_DRIVER = 'SQLite';
$Wallet::Config::DB_INFO = 'wallet-db';
unlink 'wallet-db';
@@ -74,6 +80,7 @@ sub db_setup {
sub getcreds {
my ($file, $principal) = @_;
my @commands = (
+ "kinit --no-afslog -k -t $file $principal >/dev/null 2>&1 </dev/null",
"kinit -k -t $file $principal >/dev/null 2>&1 </dev/null",
"kinit -t $file $principal >/dev/null 2>&1 </dev/null",
"kinit -T /bin/true -k -K $file $principal >/dev/null 2>&1 </dev/null",
diff --git a/perl/t/object.t b/perl/t/object.t
index 3949786..5eb6941 100755
--- a/perl/t/object.t
+++ b/perl/t/object.t
@@ -3,12 +3,13 @@
# Tests for the basic object implementation.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2011
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
use POSIX qw(strftime);
-use Test::More tests => 131;
+use Test::More tests => 137;
use Wallet::ACL;
use Wallet::Admin;
@@ -29,26 +30,26 @@ db_setup;
my $admin = eval { Wallet::Admin->new };
is ($@, '', 'Database connection succeeded');
is ($admin->reinitialize ($user), 1, 'Database initialization succeeded');
-my $dbh = $admin->dbh;
+my $schema = $admin->schema;
# Okay, now we have a database. Test create and new. We make believe this is
# a keytab object; it won't matter for what we're doing.
my $object = eval {
- Wallet::Object::Base->create ('keytab', $princ, $dbh, @trace)
+ Wallet::Object::Base->create ('keytab', $princ, $schema, @trace)
};
is ($@, '', 'Object creation did not die');
ok ($object->isa ('Wallet::Object::Base'), ' and returned the right class');
my $other = eval {
- Wallet::Object::Base->create ('keytab', $princ, $dbh, @trace)
+ Wallet::Object::Base->create ('keytab', $princ, $schema, @trace)
};
like ($@, qr/^cannot create object \Qkeytab:$princ: /, 'Repeating fails');
-$other = eval { Wallet::Object::Base->create ('', $princ, $dbh, @trace) };
+$other = eval { Wallet::Object::Base->create ('', $princ, $schema, @trace) };
is ($@, "invalid object type\n", 'Using an empty type fails');
-$other = eval { Wallet::Object::Base->create ('keytab', '', $dbh, @trace) };
+$other = eval { Wallet::Object::Base->create ('keytab', '', $schema, @trace) };
is ($@, "invalid object name\n", ' as does an empty name');
-$object = eval { Wallet::Object::Base->new ('keytab', "a$princ", $dbh) };
+$object = eval { Wallet::Object::Base->new ('keytab', "a$princ", $schema) };
is ($@, "cannot find keytab:a$princ\n", 'Searching for unknown object fails');
-$object = eval { Wallet::Object::Base->new ('keytab', $princ, $dbh) };
+$object = eval { Wallet::Object::Base->new ('keytab', $princ, $schema) };
is ($@, '', 'Object new did not die');
ok ($object->isa ('Wallet::Object::Base'), ' and returned the right class');
@@ -57,7 +58,7 @@ is ($object->type, 'keytab', 'Type accessor works');
is ($object->name, $princ, 'Name accessor works');
# We'll use this for later tests.
-my $acl = Wallet::ACL->new ('ADMIN', $dbh);
+my $acl = Wallet::ACL->new ('ADMIN', $schema);
# Owner.
is ($object->owner, undef, 'Owner is not set to start');
@@ -99,6 +100,23 @@ if ($object->expires ('', @trace)) {
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");
@@ -203,6 +221,8 @@ my $output = <<"EOO";
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
@@ -223,6 +243,8 @@ $output = <<"EOO";
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
@@ -244,12 +266,12 @@ if ($object->destroy (@trace)) {
} else {
is ($object->error, '', 'Destroy is successful');
}
-$object = eval { Wallet::Object::Base->new ('keytab', $princ, $dbh) };
+$object = eval { Wallet::Object::Base->new ('keytab', $princ, $schema) };
is ($@, "cannot find keytab:$princ\n", ' and object is all gone');
# Test history.
$object = eval {
- Wallet::Object::Base->create ('keytab', $princ, $dbh, @trace)
+ Wallet::Object::Base->create ('keytab', $princ, $schema, @trace)
};
ok (defined ($object), 'Recreating the object succeeds');
$output = <<"EOO";
@@ -267,6 +289,12 @@ $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))
diff --git a/perl/t/pod.t b/perl/t/pod.t
index c467b82..dc5f468 100755
--- a/perl/t/pod.t
+++ b/perl/t/pod.t
@@ -3,7 +3,8 @@
# Test POD formatting for the wallet Perl modules.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2010
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
diff --git a/perl/t/report.t b/perl/t/report.t
index 363db20..a6b85df 100755
--- a/perl/t/report.t
+++ b/perl/t/report.t
@@ -3,7 +3,8 @@
# Tests for the wallet reporting interface.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008, 2009, 2010
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
@@ -145,7 +146,7 @@ is (scalar (@lines), 1, 'Searching for objects owned by ADMIN finds one');
is ($lines[0][0], 'base', ' and it has the right type');
is ($lines[0][1], 'service/admin', ' and the right name');
@lines = $report->objects ('owner', 'null');
-is (scalar (@lines), 1, 'Searching for objects with no set ownerfinds one');
+is (scalar (@lines), 1, 'Searching for objects with no set owner finds one');
is ($lines[0][0], 'base', ' and it has the right type');
is ($lines[0][1], 'service/null', ' and the right name');
@lines = $report->objects ('acl', 'ADMIN');
diff --git a/perl/t/schema.t b/perl/t/schema.t
deleted file mode 100755
index 40759db..0000000
--- a/perl/t/schema.t
+++ /dev/null
@@ -1,73 +0,0 @@
-#!/usr/bin/perl -w
-#
-# Tests for the wallet schema class.
-#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
-#
-# See LICENSE for licensing terms.
-
-use Test::More tests => 8;
-
-use DBI;
-use Wallet::Config;
-use Wallet::Schema;
-
-use lib 't/lib';
-use Util;
-
-my $schema = Wallet::Schema->new;
-ok (defined $schema, 'Wallet::Schema creation');
-ok ($schema->isa ('Wallet::Schema'), ' and class verification');
-my @sql = $schema->sql;
-ok (@sql > 0, 'sql() returns something');
-is (scalar (@sql), 29, ' and returns the right number of statements');
-
-# Connect to a database and test create.
-db_setup;
-my $connect = "DBI:${Wallet::Config::DB_DRIVER}:${Wallet::Config::DB_INFO}";
-my $user = $Wallet::Config::DB_USER;
-my $password = $Wallet::Config::DB_PASSWORD;
-$dbh = DBI->connect ($connect, $user, $password);
-if (not defined $dbh) {
- die "cannot connect to database $connect: $DBI::errstr\n";
-}
-$dbh->{RaiseError} = 1;
-$dbh->{PrintError} = 0;
-eval { $schema->create ($dbh) };
-is ($@, '', "create() doesn't die");
-
-# Test dropping the database.
-eval { $schema->drop ($dbh) };
-is ($@, '', "drop() doesn't die");
-
-# Make sure all the tables are gone.
-SKIP: {
- if (lc ($Wallet::Config::DB_DRIVER) eq 'sqlite') {
- my $sql = "select name from sqlite_master where type = 'table'";
- my $sth = $dbh->prepare ($sql);
- $sth->execute;
- my ($table, @tables);
- while (defined ($table = $sth->fetchrow_array)) {
- push (@tables, $table) unless $table =~ /^sqlite_/;
- }
- is ("@tables", '', ' and there are no tables in the database');
- } elsif (lc ($Wallet::Config::DB_DRIVER) eq 'mysql') {
- my $sql = "show tables";
- my $sth = $dbh->prepare ($sql);
- $sth->execute;
- my ($table, @tables);
- while (defined ($table = $sth->fetchrow_array)) {
- push (@tables, $table);
- }
- is ("@tables", '', ' and there are no tables in the database');
- } else {
- skip 1;
- }
-}
-eval { $schema->create ($dbh) };
-is ($@, '', ' and we can run create again');
-
-# Clean up.
-eval { $schema->drop ($dbh) };
-unlink 'wallet-db';
diff --git a/perl/t/server.t b/perl/t/server.t
index ed92d6e..4afda51 100755
--- a/perl/t/server.t
+++ b/perl/t/server.t
@@ -3,11 +3,12 @@
# Tests for the wallet server API.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2010, 2011, 2012, 2013
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
-use Test::More tests => 355;
+use Test::More tests => 382;
use POSIX qw(strftime);
use Wallet::Admin;
@@ -35,8 +36,8 @@ is ($setup->reinitialize ($admin), 1, 'Database initialization succeeded');
$server = eval { Wallet::Server->new (@trace) };
is ($@, '', 'Reopening with new did not die');
ok ($server->isa ('Wallet::Server'), ' and returned the right class');
-my $dbh = $server->dbh;
-ok (defined ($dbh), ' and returns a defined database handle');
+my $schema = $server->schema;
+ok (defined ($schema), ' and returns a defined schema object');
# Allow creation of base objects for testing purposes.
$setup->register_object ('base', 'Wallet::Object::Base');
@@ -65,7 +66,9 @@ is ($result, $history, ' including by number');
is ($server->acl_create (3), undef, 'Cannot create ACL with a numeric name');
is ($server->error, 'ACL name may not be all numbers',
' and returns the right error');
+is ($server->acl_check ('user1'), 0, 'user1 ACL does not exist');
is ($server->acl_create ('user1'), 1, 'Can create regular ACL');
+is ($server->acl_check ('user1'), 1, 'user1 now exists');
is ($server->acl_show ('user1'), "Members of ACL user1 (id: 2) are:\n",
' and show works');
is ($server->acl_create ('user1'), undef, ' but not twice');
@@ -94,8 +97,10 @@ is ($server->acl_history ('test'), undef, ' and history fails');
is ($server->error, 'ACL test not found', ' and returns the right error');
is ($server->acl_destroy ('test'), undef, 'Destroying the old name fails');
is ($server->error, 'ACL test not found', ' and returns the right error');
-is ($server->acl_destroy ('test2'), 1, ' but destroying another one works');
+is ($server->acl_check ('test2'), 1, ' but the other ACL exists');
+is ($server->acl_destroy ('test2'), 1, ' and destroying it works');
is ($server->acl_destroy ('test2'), undef, ' but not twice');
+is ($server->acl_check ('test2'), 0, ' and now it does not exist');
is ($server->error, 'ACL test2 not found', ' and returns the right error');
is ($server->acl_add ('user1', 'krb4', $user1), undef,
'Adding with a bad scheme fails');
@@ -199,6 +204,24 @@ is ($server->check ('base', 'service/test'), 0,
is ($server->destroy ('base', 'service/test'), undef, ' but not twice');
is ($server->error, 'cannot find base:service/test', ' with the right error');
+# Test manipulating comments.
+is ($server->comment ('base', 'service/test'), undef,
+ 'Retrieving comment on an unknown object fails');
+is ($server->error, 'cannot find base:service/test', ' with the right error');
+is ($server->comment ('base', 'service/test', 'this is a comment'), undef,
+ ' and setting it also fails');
+is ($server->error, 'cannot find base:service/test', ' with the right error');
+is ($server->comment ('base', 'service/admin'), undef,
+ 'Retrieving comment for the right object returns undef');
+is ($server->error, undef, ' but there is no error');
+is ($server->comment ('base', 'service/admin', 'this is a comment'), 1,
+ ' and we can set it');
+is ($server->comment ('base', 'service/admin'), 'this is a comment',
+ ' and get the value back');
+is ($server->comment ('base', 'service/admin', ''), 1, ' and clear it');
+is ($server->comment ('base', 'service/admin'), undef, ' and now it is gone');
+is ($server->error, undef, ' and still no error');
+
# Test manipulating expires.
my $now = strftime ('%Y-%m-%d %T', localtime time);
is ($server->expires ('base', 'service/test'), undef,
@@ -393,6 +416,10 @@ is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1,
$history = <<"EOO";
DATE create
by $admin from $host
+DATE set comment to this is a comment
+ by $admin from $host
+DATE unset comment (was this is a comment)
+ by $admin from $host
DATE set expires to $now
by $admin from $host
DATE unset expires (was $now)
@@ -470,10 +497,6 @@ is ($server->create ('base', 'service/test'), undef,
' nor can we create objects');
is ($server->error, "$user1 not authorized to create base:service/test",
' with error');
-is ($server->destroy ('base', 'service/user1'), undef,
- ' or destroy objects');
-is ($server->error, "$user1 not authorized to destroy base:service/user1",
- ' with error');
is ($server->owner ('base', 'service/user1', 'user2'), undef,
' or set the owner');
is ($server->error,
@@ -510,12 +533,15 @@ is ($server->store ('base', 'service/user1', 'stuff'), undef,
is ($server->error,
"cannot store base:service/user1: object type is immutable",
' and the method is called');
+is ($server->comment ('base', 'service/user1', 'this is a comment'), 1,
+ ' and set a comment');
$show = $server->show ('base', 'service/user1');
$show =~ s/(Created on:) [\d-]+ [\d:]+$/$1 0/m;
$expected = <<"EOO";
Type: base
Name: service/user1
Owner: user1
+ Comment: this is a comment
Created by: $admin
Created from: $host
Created on: 0
@@ -529,6 +555,8 @@ DATE create
by $admin from $host
DATE set owner to user1 (2)
by $admin from $host
+DATE set comment to this is a comment
+ by $user1 from $host
EOO
$seen = $server->history ('base', 'service/user1');
$seen =~ s/^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d/DATE/gm;
@@ -566,6 +594,11 @@ is ($server->attr ('base', 'service/user2', 'foo', ''), undef,
is ($server->error,
"$user1 not authorized to set attributes for base:service/user2",
' with the right error');
+is ($server->comment ('base', 'service/user2', 'this is a comment'), undef,
+ ' and set comment');
+is ($server->error,
+ "$user1 not authorized to set comment for base:service/user2",
+ ' with the right error');
# And only some things on an object we own with some ACLs.
$result = eval { $server->get ('base', 'service/both') };
@@ -702,8 +735,27 @@ is ($server->history ('base', 'service/user1'), undef,
' or see history for it');
is ($server->error, "$user2 not authorized to show base:service/user1",
' with the right error');
+is ($server->comment ('base', 'service/user1', 'this is a comment'), undef,
+ ' or set a comment for it');
+is ($server->error,
+ "$user2 not authorized to set comment for base:service/user1",
+ ' with the right error');
-# And only some things on an object we own with some ACLs.
+# Test that setting a comment is controlled by the owner but retrieving it is
+# controlled by the show ACL.
+$result = eval { $server->get ('base', 'service/both') };
+is ($result, undef, 'We can get an object we jointly own');
+is ($@, "Do not instantiate Wallet::Object::Base directly\n",
+ ' and the method is called');
+is ($server->comment ('base', 'service/both', 'this is a comment'), 1,
+ ' and can set a comment on it');
+is ($server->error, undef, ' with no error');
+is ($server->comment ('base', 'service/both'), undef,
+ ' but cannot see the comment on it');
+is ($server->error, "$user2 not authorized to show base:service/both",
+ ' with the right error');
+
+# And can only do some things on an object we own with some ACLs.
$result = eval { $server->get ('base', 'service/both') };
is ($result, undef, 'We can get an object we jointly own');
is ($@, "Do not instantiate Wallet::Object::Base directly\n",
@@ -745,6 +797,12 @@ is ($server->store ('base', 'service/both', 'stuff'), undef,
' or store it');
is ($server->error, 'cannot find base:service/both', ' because it is gone');
+# Switch back to user1 and test destroy.
+$server = eval { Wallet::Server->new ($user1, $host) };
+is ($@, '', 'Switching users works');
+is ($server->destroy ('base', 'service/user1'), 1,
+ 'Destroy of an object we own with no destroy ACLs works');
+
# Test default ACLs on object creation.
#
# Create a default_acl sub that permits $user2 to create service/default with
@@ -780,8 +838,10 @@ sub default_owner {
}
package main;
-# We're still user2, so we should now be able to create service/default. Make
-# sure we can and that the ACLs all look good.
+# Switch back to user2, so we should now be able to create service/default.
+# Make sure we can and that the ACLs all look good.
+$server = eval { Wallet::Server->new ($user2, $host) };
+is ($@, '', 'Switching users works');
is ($server->create ('base', 'service/default'), undef,
'Creating an object with the default ACL fails');
is ($server->error, "$user2 not authorized to create base:service/default",
@@ -974,5 +1034,5 @@ is ($@, "database connection information not configured\n",
' or if DB_INFO is not set');
$Wallet::Config::DB_INFO = 't';
$server = eval { Wallet::Server->new ($user2, $host) };
-like ($@, qr/^cannot connect to database: /,
+like ($@, qr/unable to open database file/,
' or if the database connection fails');
diff --git a/perl/t/stanford-naming.t b/perl/t/stanford-naming.t
new file mode 100755
index 0000000..3b9ea60
--- /dev/null
+++ b/perl/t/stanford-naming.t
@@ -0,0 +1,257 @@
+#!/usr/bin/perl
+#
+# Tests for the Stanford naming policy.
+#
+# The naming policy code is included primarily an example for non-Stanford
+# sites, but it's used at Stanford and this test suite is used to verify
+# behavior at Stanford.
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2013
+# The Board of Trustees of the Leland Stanford Junior University
+#
+# See LICENSE for licensing terms.
+
+use 5.008;
+use strict;
+use warnings;
+
+use Test::More tests => 99;
+
+use lib 't/lib';
+use Util;
+
+# Load the naming policy module.
+BEGIN {
+ use_ok('Wallet::Admin');
+ use_ok('Wallet::Policy::Stanford', qw(default_owner verify_name));
+ use_ok('Wallet::Server');
+}
+
+# Various valid keytab names.
+my @VALID_KEYTABS = qw(host/example.stanford.edu HTTP/example.stanford.edu
+ service/example example/cgi class-example01/cgi dept-01example/cgi
+ group-example-01/cgi);
+
+# Various invalid keytab names.
+my @INVALID_KEYTABS = qw(example host/example service/example.stanford.edu
+ thisistoolong/cgi not-valid/cgi unknown/example.stanford.edu);
+
+# Various valid file names.
+my @VALID_FILES = qw(htpasswd/example.stanford.edu/web
+ password-ipmi/example.stanford.edu
+ password-root/example.stanford.edu
+ password-tivoli/example.stanford.edu
+ ssh-dsa/example.stanford.edu
+ ssh-rsa/example.stanford.edu
+ ssl-key/example.stanford.edu
+ ssl-key/example.stanford.edu/mysql
+ ssl-keypair/example.stanford.edu
+ ssl-keypair/example.stanford.edu/mysql
+ tivoli-key/example.stanford.edu
+ config/its-idg/example/foo
+ db/its-idg/example/s_foo
+ gpg-key/its-idg/debian
+ password/its-idg/example/backup
+ properties/its-idg/accounts
+ properties/its-idg/accounts/sponsorship
+ ssl-keystore/its-idg/accounts
+ ssl-keystore/its-idg/accounts/sponsorship
+ ssl-pkcs12/its-idg/accounts
+ ssl-pkcs12/its-idg/accounts/sponsorship);
+
+# Various valid legacy file names.
+my @VALID_LEGACY_FILES = qw(apps-example-config-file crcsg-example-db-s_example
+ idg-debian-gpg-key idg-devnull-password-root sulair-accounts-properties
+ idg-accounts-ssl-keystore idg-accounts-ssl-pkcs12
+ crcsg-example-htpasswd-web sulair-example-password-ipmi
+ sulair-example-password-root sulair-example-password-tivoli
+ sulair-example-ssh-dsa sulair-example-ssh-rsa idg-mdm-ssl-key
+ idg-openafs-tivoli-key);
+
+# Various invalid file names.
+my @INVALID_FILES = qw(unknown foo-example-ssh-rsa idg-accounts-foo !!bad
+ htpasswd/example.stanford.edu htpasswd/example password-root/example
+ password-root/example.stanford.edu/foo ssh-foo/example.stanford.edu
+ tivoli-key/example.stanford.edu/foo tivoli-key config config/its-idg
+ config/its-idg/example db/its-idg/example password/its-idg/example
+ its-idg/password/example properties//accounts properties/its-idg/
+ ssl-keystore/idg/accounts);
+
+# Global variables for the wallet server setup.
+my $ADMIN = 'admin@EXAMPLE.COM';
+my $HOST = 'localhost';
+my @TRACE = ($ADMIN, $HOST);
+
+# Start by testing lots of straightforward naming validity.
+for my $name (@VALID_KEYTABS) {
+ is(verify_name('keytab', $name), undef, "Valid keytab $name");
+}
+for my $name (@INVALID_KEYTABS) {
+ isnt(verify_name('keytab', $name), undef, "Invalid keytab $name");
+}
+for my $name (@VALID_FILES) {
+ is(verify_name('file', $name), undef, "Valid file $name");
+}
+for my $name (@VALID_LEGACY_FILES) {
+ is(verify_name('file', $name), undef, "Valid file $name");
+}
+for my $name (@INVALID_FILES) {
+ isnt(verify_name('file', $name), undef, "Invalid file $name");
+}
+
+# Now we need an actual database. Use Wallet::Admin to set it up.
+db_setup;
+my $setup = eval { Wallet::Admin->new };
+is($@, q{}, 'Database initialization did not die');
+is($setup->reinitialize($ADMIN), 1, 'Database initialization succeeded');
+my $server = eval { Wallet::Server->new(@TRACE) };
+is($@, q{}, 'Server creation did not die');
+
+# Create a host/example.stanford.edu ACL that uses the netdb ACL type.
+is($server->acl_create('host/example.stanford.edu'), 1, 'Created netdb ACL');
+is(
+ $server->acl_add('host/example.stanford.edu', 'netdb',
+ 'example.stanford.edu'),
+ 1,
+ '...with netdb ACL line'
+);
+is(
+ $server->acl_add('host/example.stanford.edu', 'krb5',
+ 'host/example.stanford.edu@stanford.edu'),
+ 1,
+ '...and krb5 ACL line'
+);
+
+# Likewise for host/foo.example.edu with the netdb-root ACL type.
+is($server->acl_create('host/foo.stanford.edu'), 1, 'Created netdb-root ACL');
+is(
+ $server->acl_add('host/foo.stanford.edu', 'netdb-root',
+ 'foo.stanford.edu'),
+ 1,
+ '...with netdb-root ACL line'
+);
+is(
+ $server->acl_add('host/foo.stanford.edu', 'krb5',
+ 'host/foo.stanford.edu@stanford.edu'),
+ 1,
+ '...and krb5 ACL line'
+);
+
+# Create a group/its-idg ACL, which will be used for autocreation of file
+# objects.
+is($server->acl_create('group/its-idg'), 1, 'Created group/its-idg ACL');
+is($server->acl_add('group/its-idg', 'krb5', $ADMIN), 1, '...with member');
+
+# Now we can test default ACLs. First, without a root instance.
+local $ENV{REMOTE_USER} = $ADMIN;
+is_deeply(
+ [default_owner('keytab', 'host/bar.stanford.edu')],
+ [
+ 'host/bar.stanford.edu',
+ ['netdb', 'bar.stanford.edu'],
+ ['krb5', 'host/bar.stanford.edu@stanford.edu']
+ ],
+ 'Correct default owner for host-based keytab'
+);
+is_deeply(
+ [default_owner('keytab', 'HTTP/example.stanford.edu')],
+ [
+ 'host/example.stanford.edu',
+ ['netdb', 'example.stanford.edu'],
+ ['krb5', 'host/example.stanford.edu@stanford.edu']
+ ],
+ '...and when netdb ACL already exists'
+);
+is_deeply(
+ [default_owner('keytab', 'webauth/foo.stanford.edu')],
+ [
+ 'host/foo.stanford.edu',
+ ['netdb-root', 'foo.stanford.edu'],
+ ['krb5', 'host/foo.stanford.edu@stanford.edu']
+ ],
+ '...and when netdb-root ACL already exists'
+);
+
+# Now with a root instance.
+local $ENV{REMOTE_USER} = 'admin/root@stanford.edu';
+is_deeply(
+ [default_owner('keytab', 'host/bar.stanford.edu')],
+ [
+ 'host/bar.stanford.edu',
+ ['netdb-root', 'bar.stanford.edu'],
+ ['krb5', 'host/bar.stanford.edu@stanford.edu']
+ ],
+ 'Correct default owner for host-based keytab for /root'
+);
+is_deeply(
+ [default_owner('keytab', 'HTTP/example.stanford.edu')],
+ [
+ 'host/example.stanford.edu',
+ ['netdb-root', 'example.stanford.edu'],
+ ['krb5', 'host/example.stanford.edu@stanford.edu']
+ ],
+ '...and when netdb ACL already exists'
+);
+is_deeply(
+ [default_owner('keytab', 'webauth/foo.stanford.edu')],
+ [
+ 'host/foo.stanford.edu',
+ ['netdb-root', 'foo.stanford.edu'],
+ ['krb5', 'host/foo.stanford.edu@stanford.edu']
+ ],
+ '...and when netdb-root ACL already exists'
+);
+
+# Check for a type that isn't host-based.
+is(default_owner('keytab', 'service/foo'), undef,
+ 'No default owner for service/foo');
+
+# Check for an unknown object type.
+is(default_owner('unknown', 'foo'), undef,
+ 'No default owner for unknown type');
+
+# Check for autocreation mappings for host-based file objects.
+is_deeply(
+ [default_owner('file', 'ssl-key/example.stanford.edu')],
+ [
+ 'host/example.stanford.edu',
+ ['netdb-root', 'example.stanford.edu'],
+ ['krb5', 'host/example.stanford.edu@stanford.edu']
+ ],
+ 'Default owner for file ssl-key/example.stanford.edu',
+);
+is_deeply(
+ [default_owner('file', 'ssl-key/example.stanford.edu/mysql')],
+ [
+ 'host/example.stanford.edu',
+ ['netdb-root', 'example.stanford.edu'],
+ ['krb5', 'host/example.stanford.edu@stanford.edu']
+ ],
+ 'Default owner for file ssl-key/example.stanford.edu/mysql',
+);
+
+# Check for a file object that isn't host-based.
+is_deeply(
+ [default_owner('file', 'config/its-idg/example/foo')],
+ ['group/its-idg', ['krb5', $ADMIN]],
+ 'Default owner for file config/its-idg/example/foo',
+);
+
+# Check for legacy autocreation mappings for file objects.
+for my $type (qw(htpasswd ssh-rsa ssh-dsa ssl-key tivoli-key)) {
+ my $name = "idg-example-$type";
+ is_deeply(
+ [default_owner('file', $name)],
+ [
+ 'host/example.stanford.edu',
+ ['netdb-root', 'example.stanford.edu'],
+ ['krb5', 'host/example.stanford.edu@stanford.edu']
+ ],
+ "Default owner for file $name",
+ );
+}
+
+# Clean up.
+$setup->destroy;
+unlink 'wallet-db';
diff --git a/perl/t/verifier-ldap-attr.t b/perl/t/verifier-ldap-attr.t
new file mode 100755
index 0000000..41d6737
--- /dev/null
+++ b/perl/t/verifier-ldap-attr.t
@@ -0,0 +1,73 @@
+#!/usr/bin/perl -w
+#
+# Tests for the LDAP attribute ACL verifier.
+#
+# This test can only be run by someone local to Stanford with appropriate
+# access to the LDAP server and will be skipped in all other environments.
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2012, 2013
+# The Board of Trustees of the Leland Stanford Junior University
+#
+# See LICENSE for licensing terms.
+
+use Test::More;
+
+use lib 't/lib';
+use Util;
+
+# Skip all spelling tests unless the maintainer environment variable is set.
+plan skip_all => 'LDAP verifier tests only run for maintainer'
+ unless $ENV{RRA_MAINTAINER_TESTS};
+
+# Declare a plan.
+plan tests => 10;
+
+require_ok ('Wallet::ACL::LDAP::Attribute');
+
+my $host = 'ldap.stanford.edu';
+my $base = 'cn=people,dc=stanford,dc=edu';
+my $filter = 'uid';
+my $user = 'rra@stanford.edu';
+my $attr = 'suPrivilegeGroup';
+my $value = 'stanford:stanford';
+
+# Remove the realm from principal names.
+package Wallet::Config;
+sub ldap_map_principal {
+ my ($principal) = @_;
+ $principal =~ s/\@.*//;
+ return $principal;
+}
+package main;
+
+# Determine the local principal.
+my $klist = `klist 2>&1` || '';
+SKIP: {
+ skip "tests useful only with Stanford Kerberos tickets", 4
+ unless ($klist =~ /[Pp]rincipal: \S+\@stanford\.edu$/m);
+
+ # Set up our configuration.
+ $Wallet::Config::LDAP_HOST = $host;
+ $Wallet::Config::LDAP_CACHE = $ENV{KRB5CCNAME};
+ $Wallet::Config::LDAP_BASE = $base;
+ $Wallet::Config::LDAP_FILTER_ATTR = $filter;
+
+ # Finally, we can test.
+ my $verifier = eval { Wallet::ACL::LDAP::Attribute->new };
+ isa_ok ($verifier, 'Wallet::ACL::LDAP::Attribute');
+ is ($verifier->check ($user, "$attr=$value"), 1,
+ "Checking $attr=$value succeeds");
+ is ($verifier->error, undef, '...with no error');
+ is ($verifier->check ($user, "$attr=BOGUS"), 0,
+ "Checking $attr=BOGUS fails");
+ is ($verifier->error, undef, '...with no error');
+ is ($verifier->check ($user, "BOGUS=$value"), undef,
+ "Checking BOGUS=$value fails with error");
+ is ($verifier->error,
+ 'cannot check LDAP attribute BOGUS for rra: Undefined attribute type',
+ '...with correct error');
+ is ($verifier->check ('user-does-not-exist', "$attr=$value"), 0,
+ "Checking for nonexistent user fails");
+ is ($verifier->error, undef, '...with no error');
+}
diff --git a/perl/t/verifier-netdb.t b/perl/t/verifier-netdb.t
index 6bd4e73..398cc6a 100755
--- a/perl/t/verifier-netdb.t
+++ b/perl/t/verifier-netdb.t
@@ -7,7 +7,8 @@
# environments.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
diff --git a/perl/t/verifier.t b/perl/t/verifier.t
index f56f5fa..75f1afa 100755
--- a/perl/t/verifier.t
+++ b/perl/t/verifier.t
@@ -3,7 +3,8 @@
# Tests for the basic wallet ACL verifiers.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2010
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
diff --git a/perl/t/wa-keyring.t b/perl/t/wa-keyring.t
new file mode 100755
index 0000000..3011d54
--- /dev/null
+++ b/perl/t/wa-keyring.t
@@ -0,0 +1,175 @@
+#!/usr/bin/perl
+#
+# Tests for the WebAuth keyring object implementation.
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2013
+# 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 => 68;
+use WebAuth 3.06 qw(WA_KEY_AES WA_AES_128);
+use WebAuth::Key 1.01 ();
+use WebAuth::Keyring 1.02 ();
+
+BEGIN {
+ 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;
+unlink ('wallet-db');
generated by cgit v1.2.3 (git 2.39.1) at 2025-02-06 06:24:51 +0000