summaryrefslogtreecommitdiff
path: root/perl/t
diff options
context:
space:
mode:
Diffstat (limited to 'perl/t')
-rw-r--r--perl/t/data/duo/integration.json11
-rw-r--r--perl/t/data/duo/keys.json5
-rw-r--r--perl/t/data/perl.conf7
-rwxr-xr-xperl/t/docs/pod-spelling.t66
-rwxr-xr-xperl/t/docs/pod.t65
-rwxr-xr-xperl/t/general/acl.t (renamed from perl/t/acl.t)22
-rwxr-xr-xperl/t/general/admin.t (renamed from perl/t/admin.t)65
-rwxr-xr-xperl/t/general/config.t (renamed from perl/t/config.t)9
-rwxr-xr-xperl/t/general/init.t (renamed from perl/t/init.t)13
-rwxr-xr-xperl/t/general/report.t (renamed from perl/t/report.t)15
-rwxr-xr-xperl/t/general/server.t (renamed from perl/t/server.t)53
-rw-r--r--perl/t/lib/Util.pm5
-rwxr-xr-xperl/t/object/base.t (renamed from perl/t/object.t)25
-rwxr-xr-xperl/t/object/duo.t157
-rwxr-xr-xperl/t/object/file.t (renamed from perl/t/file.t)15
-rwxr-xr-xperl/t/object/keytab.t (renamed from perl/t/keytab.t)42
-rwxr-xr-xperl/t/object/wa-keyring.t (renamed from perl/t/wa-keyring.t)9
-rwxr-xr-xperl/t/pod-spelling.t74
-rwxr-xr-xperl/t/pod.t15
-rwxr-xr-xperl/t/policy/stanford.t (renamed from perl/t/stanford-naming.t)15
-rwxr-xr-xperl/t/style/minimum-version.t47
-rwxr-xr-xperl/t/style/strict.t56
-rwxr-xr-xperl/t/util/kadmin.t (renamed from perl/t/kadmin.t)8
-rwxr-xr-xperl/t/verifier/basic.t (renamed from perl/t/verifier.t)23
-rwxr-xr-xperl/t/verifier/ldap-attr.t (renamed from perl/t/verifier-ldap-attr.t)11
-rwxr-xr-xperl/t/verifier/netdb.t (renamed from perl/t/verifier-netdb.t)18
26 files changed, 625 insertions, 226 deletions
diff --git a/perl/t/data/duo/integration.json b/perl/t/data/duo/integration.json
new file mode 100644
index 0000000..6e569d6
--- /dev/null
+++ b/perl/t/data/duo/integration.json
@@ -0,0 +1,11 @@
+{
+ "enroll_policy": "enroll",
+ "greeting": "",
+ "groups_allowed": [],
+ "integration_key": "DIRWIH0ZZPV4G88B37VQ",
+ "name": "Integration for UNIX PAM",
+ "notes": "",
+ "secret_key": "QO4ZLqQVRIOZYkHfdPDORfcNf8LeXIbCWwHazY7o",
+ "type": "unix",
+ "visual_style": "default"
+}
diff --git a/perl/t/data/duo/keys.json b/perl/t/data/duo/keys.json
new file mode 100644
index 0000000..0de11ff
--- /dev/null
+++ b/perl/t/data/duo/keys.json
@@ -0,0 +1,5 @@
+{
+ "integration_key": "VWFQIFMA9E79ZFG0ABIQ",
+ "secret_key": "BAbja87NB8AmzlgalGAm09abNqpGZVva985al1zF",
+ "api_hostname": "example-admin.duosecurity.com"
+}
diff --git a/perl/t/data/perl.conf b/perl/t/data/perl.conf
new file mode 100644
index 0000000..ca05568
--- /dev/null
+++ b/perl/t/data/perl.conf
@@ -0,0 +1,7 @@
+# Configuration for Perl tests. -*- perl -*-
+
+# Default minimum version requirement.
+$MINIMUM_VERSION = '5.008';
+
+# File must end with this line.
+1;
diff --git a/perl/t/docs/pod-spelling.t b/perl/t/docs/pod-spelling.t
new file mode 100755
index 0000000..6debd42
--- /dev/null
+++ b/perl/t/docs/pod-spelling.t
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+#
+# Check for spelling errors in POD documentation.
+#
+# The canonical version of this file is maintained in the rra-c-util package,
+# which can be found at <http://www.eyrie.org/~eagle/software/rra-c-util/>.
+#
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2013, 2014
+# The Board of Trustees of the Leland Stanford Junior University
+#
+# Permission is hereby granted, free of charge, to any person obtaining a
+# copy of this software and associated documentation files (the "Software"),
+# to deal in the Software without restriction, including without limitation
+# the rights to use, copy, modify, merge, publish, distribute, sublicense,
+# and/or sell copies of the Software, and to permit persons to whom the
+# Software is furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
+# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+# DEALINGS IN THE SOFTWARE.
+
+use 5.006;
+use strict;
+use warnings;
+
+use lib 't/lib';
+
+use Test::More;
+use Test::RRA qw(skip_unless_author use_prereq);
+
+# Only run this test for the module author since the required stopwords are
+# too sensitive to the exact spell-checking program and dictionary.
+skip_unless_author('Spelling tests');
+
+# Load prerequisite modules.
+use_prereq('Test::Spelling');
+
+# Check all POD in the Perl distribution. Add the examples directory if it
+# exists. Also add any files in usr/bin or usr/sbin, which are widely used in
+# Stanford-internal packages.
+my @files = all_pod_files();
+if (-d 'examples') {
+ push(@files, all_pod_files('examples'));
+}
+for my $dir (qw(usr/bin usr/sbin)) {
+ if (-d $dir) {
+ push(@files, glob("$dir/*"));
+ }
+}
+
+# We now have a list of all files to check, so output a plan and run the
+# tests. We can't use all_pod_files_spelling_ok because it refuses to check
+# non-Perl files and Stanford-internal packages have a lot of shell scripts
+# with POD documentation.
+plan tests => scalar(@files);
+for my $file (@files) {
+ pod_file_spelling_ok($file);
+}
diff --git a/perl/t/docs/pod.t b/perl/t/docs/pod.t
new file mode 100755
index 0000000..674ce30
--- /dev/null
+++ b/perl/t/docs/pod.t
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+#
+# Check all POD documents for POD formatting errors.
+#
+# The canonical version of this file is maintained in the rra-c-util package,
+# which can be found at <http://www.eyrie.org/~eagle/software/rra-c-util/>.
+#
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2012, 2013, 2014
+# The Board of Trustees of the Leland Stanford Junior University
+#
+# Permission is hereby granted, free of charge, to any person obtaining a
+# copy of this software and associated documentation files (the "Software"),
+# to deal in the Software without restriction, including without limitation
+# the rights to use, copy, modify, merge, publish, distribute, sublicense,
+# and/or sell copies of the Software, and to permit persons to whom the
+# Software is furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
+# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+# DEALINGS IN THE SOFTWARE.
+
+use 5.006;
+use strict;
+use warnings;
+
+use lib 't/lib';
+
+use Test::More;
+use Test::RRA qw(skip_unless_automated use_prereq);
+
+# Skip this test for normal user installs, although pod2man may still fail.
+skip_unless_automated('POD syntax tests');
+
+# Load prerequisite modules.
+use_prereq('Test::Pod');
+
+# Check all POD in the Perl distribution. Add the examples directory if it
+# exists. Also add any files in usr/bin or usr/sbin, which are widely used in
+# Stanford-internal packages.
+my @files = all_pod_files();
+if (-d 'examples') {
+ push(@files, all_pod_files('examples'));
+}
+for my $dir (qw(usr/bin usr/sbin)) {
+ if (-d $dir) {
+ push(@files, glob("$dir/*"));
+ }
+}
+
+# We now have a list of all files to check, so output a plan and run the
+# tests. We can't use all_pod_files_ok because it refuses to check non-Perl
+# files and Stanford-internal packages have a lot of shell scripts with POD
+# documentation.
+plan tests => scalar(@files);
+for my $file (@files) {
+ pod_file_ok($file);
+}
diff --git a/perl/t/acl.t b/perl/t/general/acl.t
index 26b4903..1dd5c53 100755
--- a/perl/t/acl.t
+++ b/perl/t/general/acl.t
@@ -1,13 +1,16 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
#
# Tests for the wallet ACL API.
#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2007, 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 => 101;
@@ -60,7 +63,7 @@ ok ($acl->isa ('Wallet::ACL'), ' and the right class');
is ($acl->name, 'test', ' and the right name');
# Test rename.
-if ($acl->rename ('example')) {
+if ($acl->rename ('example', @trace)) {
ok (1, 'Renaming the ACL');
} else {
is ($acl->error, '', 'Renaming the ACL');
@@ -80,7 +83,8 @@ ok (defined ($acl), ' and it can still found by ID');
is ($@, '', ' with no exceptions');
is ($acl->name, 'example', ' and the right name');
is ($acl->id, 2, ' and the right ID');
-ok (! $acl->rename ('ADMIN'), ' but renaming to an existing name fails');
+ok (! $acl->rename ('ADMIN', @trace),
+ ' but renaming to an existing name fails');
like ($acl->error, qr/^cannot rename ACL 2 to ADMIN: /,
' with the right error');
@@ -192,6 +196,8 @@ my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]);
my $history = <<"EOO";
$date create
by $admin from $host
+$date rename from test
+ by $admin from $host
$date add krb5 $user1
by $admin from $host
$date add krb5 $user2
@@ -223,8 +229,10 @@ $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');
-is ($acl->id, 3, ' and a new ID');
+like ($acl->id, qr{\A[23]\z}, ' and an ID of 2 or 3');
# Clean up.
$setup->destroy;
-unlink 'wallet-db';
+END {
+ unlink 'wallet-db';
+}
diff --git a/perl/t/admin.t b/perl/t/general/admin.t
index a11b9b2..7c62932 100755
--- a/perl/t/admin.t
+++ b/perl/t/general/admin.t
@@ -2,13 +2,16 @@
#
# Tests for wallet administrative interface.
#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2009, 2010, 2011
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2008, 2009, 2010, 2011, 2013, 2014
# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
-use Test::More tests => 23;
+use strict;
+use warnings;
+
+use Test::More tests => 26;
use Wallet::Admin;
use Wallet::Report;
@@ -44,7 +47,7 @@ is ($admin->register_object ('base', 'Wallet::Object::Base'), 1,
'Registering Wallet::Object::Base works');
is ($admin->register_object ('base', 'Wallet::Object::Base'), undef,
' and cannot be registered twice');
-$server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') };
+my $server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') };
is ($@, '', 'Creating a server instance did not die');
is ($server->create ('base', 'service/admin'), 1,
' and creating base:service/admin succeeds');
@@ -57,22 +60,50 @@ 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.
+# Test re-initialization of the database.
$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');
+
+# Test an upgrade. Reinitialize to an older version, then test upgrade to the
+# current version.
+SKIP: {
+ my @path = (split (':', $ENV{PATH}));
+ my ($sqlite) = grep { -x $_ } map { "$_/sqlite3" } @path;
+ skip 'sqlite3 not found', 5 unless $sqlite;
+
+ # Delete all tables and then redump them straight from the SQL file to
+ # avoid getting the version table.
+ unlink 'wallet-db';
+ my $status = system ('sqlite3', 'wallet-db',
+ '.read sql/Wallet-Schema-0.07-SQLite.sql');
+ is ($status, 0, 'Reinstalling database from non-versioned SQL succeds');
+
+ # Upgrade to 0.08.
+ $Wallet::Schema::VERSION = '0.08';
+ $admin = eval { Wallet::Admin->new };
+ my $retval = $admin->upgrade;
+ is ($retval, 1, ' and performing an upgrade to 0.08 succeeds');
+ my $sql = "select version from dbix_class_schema_versions order by"
+ . " version DESC";
+ my $version = $admin->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');
+
+ # Upgrade to 0.09.
+ $Wallet::Schema::VERSION = '0.09';
+ $admin = eval { Wallet::Admin->new };
+ $retval = $admin->upgrade;
+ is ($retval, 1, ' and performing an upgrade to 0.09 succeeds');
+ $sql = "select version from dbix_class_schema_versions order by"
+ . " version DESC";
+ $version = $admin->dbh->selectall_arrayref ($sql);
+ is ($version->[0][0], '0.09', ' and the schema version is correct');
+}
# Clean up.
is ($admin->destroy, 1, 'Destruction succeeds');
-unlink 'wallet-db';
+END {
+ unlink 'wallet-db';
+}
diff --git a/perl/t/config.t b/perl/t/general/config.t
index 543e5d6..bc200de 100755
--- a/perl/t/config.t
+++ b/perl/t/general/config.t
@@ -1,13 +1,16 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
#
# Tests for the wallet server configuration.
#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2010
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2008, 2010, 2014
# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
+use strict;
+use warnings;
+
use Test::More tests => 6;
# Silence warnings since we're not using use.
diff --git a/perl/t/init.t b/perl/t/general/init.t
index 142f54c..58b9a4c 100755
--- a/perl/t/init.t
+++ b/perl/t/general/init.t
@@ -1,13 +1,16 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
#
# Tests for database initialization.
#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2007, 2008, 2014
# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
+use strict;
+use warnings;
+
use Test::More tests => 18;
use Wallet::ACL;
@@ -53,4 +56,6 @@ is ($admin->destroy, 1, 'Destroying the database works');
$acl = eval { Wallet::ACL->new ('ADMIN', $admin->schema) };
like ($@, qr/^cannot search for ACL ADMIN: /,
' and now the database is gone');
-unlink 'wallet-db';
+END {
+ unlink 'wallet-db';
+}
diff --git a/perl/t/report.t b/perl/t/general/report.t
index a6b85df..8d348ed 100755
--- a/perl/t/report.t
+++ b/perl/t/general/report.t
@@ -1,13 +1,16 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
#
# Tests for the wallet reporting interface.
#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2009, 2010
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2008, 2009, 2010, 2014
# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
+use strict;
+use warnings;
+
use Test::More tests => 197;
use Wallet::Admin;
@@ -39,7 +42,7 @@ is ($acls[0][0], 1, ' and that is ACL ID 1');
is ($acls[0][1], 'ADMIN', ' with the right name');
# Create an object.
-$server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') };
+my $server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') };
is ($@, '', 'Creating a server instance did not die');
is ($server->create ('base', 'service/admin'), 1,
' and creating base:service/admin succeeds');
@@ -324,5 +327,7 @@ is ($report->error, undef, ' and no error');
# Clean up.
$admin->destroy;
-unlink 'wallet-db';
system ('rm -r test-files') == 0 or die "cannot remove test-files\n";
+END {
+ unlink 'wallet-db';
+}
diff --git a/perl/t/server.t b/perl/t/general/server.t
index 4afda51..b270733 100755
--- a/perl/t/server.t
+++ b/perl/t/general/server.t
@@ -1,13 +1,16 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
#
# Tests for the wallet server API.
#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2010, 2011, 2012, 2013
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2007, 2008, 2010, 2011, 2012, 2013, 2014
# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
+use strict;
+use warnings;
+
use Test::More tests => 382;
use POSIX qw(strftime);
@@ -33,7 +36,7 @@ is ($@, '', 'Database initialization did not die');
is ($setup->reinitialize ($admin), 1, 'Database initialization succeeded');
# Now test the new method.
-$server = eval { Wallet::Server->new (@trace) };
+my $server = eval { Wallet::Server->new (@trace) };
is ($@, '', 'Reopening with new did not die');
ok ($server->isa ('Wallet::Server'), ' and returned the right class');
my $schema = $server->schema;
@@ -51,18 +54,8 @@ is ($server->acl_show ('ADMIN'),
is ($server->acl_show (1),
"Members of ACL ADMIN (id: 1) are:\n krb5 $admin\n",
' including by number');
-my $history = <<"EOO";
-DATE create
- by $admin from $host
-DATE add krb5 $admin
- by $admin from $host
-EOO
-my $result = $server->acl_history ('ADMIN');
-$result =~ s/^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d/DATE/gm;
-is ($result, $history, ' and displaying history works');
-$result = $server->acl_history (1);
-$result =~ s/^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d/DATE/gm;
-is ($result, $history, ' including by number');
+is ($server->acl_history ('ADMIN'), '', ' and initial history is empty');
+is ($server->acl_history (1), '', ' 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');
@@ -79,14 +72,14 @@ like ($server->error, qr/^cannot create ACL ADMIN: /,
' and returns a good error');
is ($server->acl_create ('user2'), 1, 'Create another ACL');
is ($server->acl_create ('both'), 1, ' and one for both users');
-is ($server->acl_create ('test'), 1, ' and an empty one');
-is ($server->acl_create ('test2'), 1, ' and another test one');
+is ($server->acl_create ('test2'), 1, ' and an empty one');
+is ($server->acl_create ('test'), 1, ' and another test one');
is ($server->acl_rename ('empty', 'test'), undef,
'Cannot rename nonexistent ACL');
is ($server->error, 'ACL empty not found', ' and returns the right error');
is ($server->acl_rename ('test', 'test2'), undef,
' and cannot rename to an existing name');
-like ($server->error, qr/^cannot rename ACL 5 to test2: /,
+like ($server->error, qr/^cannot rename ACL 6 to test2: /,
' and returns the right error');
is ($server->acl_rename ('test', 'empty'), 1, 'Renaming does work');
is ($server->acl_rename ('test', 'empty'), undef, ' but not twice');
@@ -114,7 +107,7 @@ is ($server->acl_add ('both', 'krb5', $user2), 1,
is ($server->acl_show ('both'),
"Members of ACL both (id: 4) are:\n krb5 $user1\n krb5 $user2\n",
' and show returns the correct result');
-$history = <<"EOO";
+my $history = <<"EOO";
DATE create
by $admin from $host
DATE add krb5 $user1
@@ -122,7 +115,7 @@ DATE add krb5 $user1
DATE add krb5 $user2
by $admin from $host
EOO
-$result = $server->acl_history ('both');
+my $result = $server->acl_history ('both');
$result =~ s/^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d/DATE/gm;
is ($result, $history, ' as does history');
is ($server->acl_add ('empty', 'krb5', $user1), 1, ' and another to empty');
@@ -135,19 +128,19 @@ is ($server->error, 'ACL test not found', ' and returns the right error');
is ($server->acl_remove ('empty', 'krb5', $user2), undef,
' and removing an entry not there fails');
is ($server->error,
- "cannot remove krb5:$user2 from 5: entry not found in ACL",
+ "cannot remove krb5:$user2 from 6: entry not found in ACL",
' and returns the right error');
is ($server->acl_show ('empty'),
- "Members of ACL empty (id: 5) are:\n krb5 $user1\n",
+ "Members of ACL empty (id: 6) are:\n krb5 $user1\n",
' and show returns the correct status');
is ($server->acl_remove ('empty', 'krb5', $user1), 1,
' but removing a good one works');
is ($server->acl_remove ('empty', 'krb5', $user1), undef,
' but does not work twice');
is ($server->error,
- "cannot remove krb5:$user1 from 5: entry not found in ACL",
+ "cannot remove krb5:$user1 from 6: entry not found in ACL",
' and returns the right error');
-is ($server->acl_show ('empty'), "Members of ACL empty (id: 5) are:\n",
+is ($server->acl_show ('empty'), "Members of ACL empty (id: 6) are:\n",
' and show returns the correct status');
# Make sure we can't cripple the ADMIN ACL.
@@ -434,11 +427,11 @@ DATE unset acl_store (was ADMIN (1))
by $admin from $host
DATE set owner to ADMIN (1)
by $admin from $host
-DATE set acl_get to empty (5)
+DATE set acl_get to empty (6)
by $admin from $host
-DATE set acl_store to empty (5)
+DATE set acl_store to empty (6)
by $admin from $host
-DATE unset acl_store (was empty (5))
+DATE unset acl_store (was empty (6))
by $admin from $host
DATE unset owner (was ADMIN (1))
by $admin from $host
@@ -1020,7 +1013,9 @@ is ($server->acl_destroy ('test-naming'), 1, 'Destroying it succeeds');
# Clean up.
$setup->destroy;
-unlink 'wallet-db';
+END {
+ unlink 'wallet-db';
+}
# Now test handling of some configuration errors.
undef $Wallet::Config::DB_DRIVER;
diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm
index 3e606fe..187e483 100644
--- a/perl/t/lib/Util.pm
+++ b/perl/t/lib/Util.pm
@@ -1,7 +1,7 @@
# Utility class for wallet tests.
#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2007, 2008, 2014
# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
@@ -10,6 +10,7 @@ package Util;
require 5.006;
use strict;
+use warnings;
use vars qw(@ISA @EXPORT $VERSION);
use Wallet::Config;
diff --git a/perl/t/object.t b/perl/t/object/base.t
index 5eb6941..ee9ff4b 100755
--- a/perl/t/object.t
+++ b/perl/t/object/base.t
@@ -1,13 +1,16 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
#
# Tests for the basic object implementation.
#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2011
+# 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;
@@ -67,7 +70,7 @@ if ($object->owner ('ADMIN', @trace)) {
} else {
is ($object->error, '', ' and setting it to ADMIN works');
}
-is ($object->owner, $acl->id, ' at which point it is ADMIN');
+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');
@@ -125,7 +128,7 @@ for my $type (qw/get store show destroy flags/) {
} else {
is ($object->error, '', ' and setting it to ADMIN (numeric) works');
}
- is ($object->acl ($type), $acl->id, ' at which point it is ADMIN');
+ 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');
@@ -135,8 +138,8 @@ for my $type (qw/get store show destroy flags/) {
is ($object->error, '', ' and clearing it works');
}
is ($object->acl ($type), undef, ' at which point it is cleared');
- is ($object->acl ($type, $acl->id, @trace), 1,
- ' and setting it again works');
+ is ($object->acl ($type, $acl->name, @trace), 1,
+ ' and setting it again by name works');
}
# Flags.
@@ -186,7 +189,7 @@ is ($object->error, "cannot store keytab:${princ}: object is locked",
is ($object->owner ('', @trace), undef, ' and setting owner fails');
is ($object->error, "cannot modify keytab:${princ}: object is locked",
' for the same reason');
-is ($object->owner, 1, ' but retrieving the owner works');
+is ($object->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');
@@ -195,7 +198,7 @@ for my $acl (qw/get store show destroy flags/) {
is ($object->acl ($acl, '', @trace), undef, " and setting $acl ACL fails");
is ($object->error, "cannot modify keytab:${princ}: object is locked",
' for the same reason');
- is ($object->acl ($acl), 1, " but retrieving $acl ACL works");
+ is ($object->acl ($acl), 'ADMIN', " but retrieving $acl ACL works");
}
is ($object->flag_check ('locked'), 1, ' and checking flags works');
@flags = $object->flag_list;
@@ -348,4 +351,6 @@ is ($object->history, $output, ' and the history is correct');
# Clean up.
$admin->destroy;
-unlink 'wallet-db';
+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/file.t b/perl/t/object/file.t
index 5cb7c35..201f46d 100755
--- a/perl/t/file.t
+++ b/perl/t/object/file.t
@@ -1,13 +1,16 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
#
# Tests for the file object implementation.
#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008
+# 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;
@@ -39,7 +42,7 @@ my $history = '';
my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]);
# Test error handling in the absence of configuration.
-$object = eval {
+my $object = eval {
Wallet::Object::File->create ('file', 'test', $schema, @trace)
};
ok (defined ($object), 'Creating a basic file object succeeds');
@@ -145,4 +148,6 @@ is ($object->destroy (@trace), 1, ' but destroying the object succeeds');
# Clean up.
$admin->destroy;
-unlink ('wallet-db');
+END {
+ unlink ('wallet-db');
+}
diff --git a/perl/t/keytab.t b/perl/t/object/keytab.t
index f89b2c6..69db438 100755
--- a/perl/t/keytab.t
+++ b/perl/t/object/keytab.t
@@ -1,15 +1,18 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
#
# Tests for the keytab object implementation.
#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2009, 2010, 2013
+# 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 => 139;
+use Test::More tests => 141;
BEGIN { $Wallet::Config::KEYTAB_TMP = '.' }
@@ -117,14 +120,14 @@ sub enctypes {
next unless /^ *\d+ /;
my ($string) = /\((.*)\)\s*$/;
next unless $string;
- $enctype = $enctype{lc $string} || 'UNKNOWN';
+ 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) {
+ if ($? != 0 || !@enctypes) {
@enctypes = ();
open (KTUTIL, '-|', 'ktutil', '-k', 'keytab', 'list')
or die "cannot run ktutil: $!\n";
@@ -174,7 +177,7 @@ SKIP: {
# Test that object creation without KEYTAB_TMP fails.
undef $Wallet::Config::KEYTAB_TMP;
- $object = eval {
+ my $object = eval {
Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
@trace)
};
@@ -386,7 +389,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', 31 unless -f 't/data/test.keytab';
+ skip 'no keytab configuration', 32 unless -f 't/data/test.keytab';
# Set up our configuration.
$Wallet::Config::KEYTAB_FILE = 't/data/test.keytab';
@@ -471,7 +474,7 @@ SKIP: {
# Now Heimdal. Since the keytab contains timestamps, before testing for
# equality we have to substitute out the timestamps.
SKIP: {
- skip 'skipping Heimdal unchanging tests for MIT', 10
+ 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');
@@ -480,7 +483,8 @@ SKIP: {
ok (defined $second, ' and second retrieval also works');
$data =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g;
$second =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g;
- is ($data, $second, ' and the keytab matches');
+ 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);
@@ -585,7 +589,7 @@ EOO
# Tests for enctype restriction.
SKIP: {
- skip 'no keytab configuration', 36 unless -f 't/data/test.keytab';
+ skip 'no keytab configuration', 37 unless -f 't/data/test.keytab';
# Set up our configuration.
$Wallet::Config::KEYTAB_FILE = 't/data/test.keytab';
@@ -619,18 +623,12 @@ EOO
is ($one->history, $history, ' and history is still correct');
# No enctypes we recognize?
- skip 'no recognized enctypes', 33 unless @enctypes;
-
- # We can test. Add the enctypes we recognized to the enctypes table so
- # that we'll be allowed to use them.
- for my $enctype (@enctypes) {
- my $sql = 'insert into enctypes (en_name) values (?)';
- $dbh->do ($sql, undef, $enctype);
- }
+ 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";
@@ -639,7 +637,7 @@ EOO
is ("@values", "@enctypes", ' and we get back the right enctype list');
my $eshow = join ("\n" . (' ' x 17), @enctypes);
$eshow =~ s/\s+\z/\n/;
- $expected = <<"EOO";
+ my $expected = <<"EOO";
Type: keytab
Name: wallet/one
Enctypes: $eshow
@@ -771,4 +769,6 @@ EOO
# Clean up.
$admin->destroy;
-unlink ('wallet-db', 'krb5cc_temp', 'krb5cc_test', 'test-acl', 'test-pid');
+END {
+ unlink ('wallet-db', 'krb5cc_temp', 'krb5cc_test', 'test-acl', 'test-pid');
+}
diff --git a/perl/t/wa-keyring.t b/perl/t/object/wa-keyring.t
index 7ba5723..4a3bd48 100755
--- a/perl/t/wa-keyring.t
+++ b/perl/t/object/wa-keyring.t
@@ -2,8 +2,8 @@
#
# Tests for the WebAuth keyring object implementation.
#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2013
+# 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.
@@ -19,7 +19,6 @@ BEGIN {
if $@;
}
-use POSIX qw(strftime);
use WebAuth::Key 1.01 ();
use WebAuth::Keyring 1.02 ();
@@ -179,4 +178,6 @@ is ($object->destroy (@trace), 1, ' but destroying the object succeeds');
# Clean up.
$admin->destroy;
-unlink ('wallet-db');
+END {
+ unlink ('wallet-db');
+}
diff --git a/perl/t/pod-spelling.t b/perl/t/pod-spelling.t
deleted file mode 100755
index 6d9f7b0..0000000
--- a/perl/t/pod-spelling.t
+++ /dev/null
@@ -1,74 +0,0 @@
-#!/usr/bin/perl -w
-#
-# Check for spelling errors in POD documentation
-#
-# Checks all POD files in the tree for spelling problems using Pod::Spell and
-# either aspell or ispell. aspell is preferred. This test is disabled unless
-# RRA_MAINTAINER_TESTS is set, since spelling dictionaries vary too much
-# between environments.
-#
-# Copyright 2008, 2009 Russ Allbery <rra@stanford.edu>
-#
-# See LICENSE for licensing terms.
-
-use strict;
-use Test::More;
-
-# Skip all spelling tests unless the maintainer environment variable is set.
-plan skip_all => 'Spelling tests only run for maintainer'
- unless $ENV{RRA_MAINTAINER_TESTS};
-
-# Load required Perl modules.
-eval 'use Test::Pod 1.00';
-plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@;
-eval 'use Pod::Spell';
-plan skip_all => 'Pod::Spell required to test POD spelling' if $@;
-
-# Locate a spell-checker. hunspell is not currently supported due to its lack
-# of support for contractions (at least in the version in Debian).
-my @spell;
-my %options = (aspell => [ qw(-d en_US --home-dir=./ list) ],
- ispell => [ qw(-d american -l -p /dev/null) ]);
-SEARCH: for my $program (qw/aspell ispell/) {
- for my $dir (split ':', $ENV{PATH}) {
- if (-x "$dir/$program") {
- @spell = ("$dir/$program", @{ $options{$program} });
- }
- last SEARCH if @spell;
- }
-}
-plan skip_all => 'aspell or ispell required to test POD spelling'
- unless @spell;
-
-# Prerequisites are satisfied, so we're going to do some testing. Figure out
-# what POD files we have and from that develop our plan.
-$| = 1;
-my @pod = all_pod_files ();
-plan tests => scalar @pod;
-
-# Finally, do the checks.
-for my $pod (@pod) {
- my $child = open (CHILD, '-|');
- if (not defined $child) {
- die "Cannot fork: $!\n";
- } elsif ($child == 0) {
- my $pid = open (SPELL, '|-', @spell) or die "Cannot run @spell: $!\n";
- open (POD, '<', $pod) or die "Cannot open $pod: $!\n";
- my $parser = Pod::Spell->new;
- $parser->parse_from_filehandle (\*POD, \*SPELL);
- close POD;
- close SPELL;
- exit ($? >> 8);
- } else {
- my @words = <CHILD>;
- close CHILD;
- SKIP: {
- skip "@spell failed for $pod", 1 unless $? == 0;
- for (@words) {
- s/^\s+//;
- s/\s+$//;
- }
- is ("@words", '', $pod);
- }
- }
-}
diff --git a/perl/t/pod.t b/perl/t/pod.t
deleted file mode 100755
index dc5f468..0000000
--- a/perl/t/pod.t
+++ /dev/null
@@ -1,15 +0,0 @@
-#!/usr/bin/perl -w
-#
-# Test POD formatting for the wallet Perl modules.
-#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2010
-# The Board of Trustees of the Leland Stanford Junior University
-#
-# See LICENSE for licensing terms.
-
-use strict;
-use Test::More;
-eval 'use Test::Pod 1.00';
-plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@;
-all_pod_files_ok ();
diff --git a/perl/t/stanford-naming.t b/perl/t/policy/stanford.t
index 3b9ea60..555086c 100755
--- a/perl/t/stanford-naming.t
+++ b/perl/t/policy/stanford.t
@@ -6,8 +6,8 @@
# 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
+# 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.
@@ -16,7 +16,7 @@ use 5.008;
use strict;
use warnings;
-use Test::More tests => 99;
+use Test::More tests => 101;
use lib 't/lib';
use Util;
@@ -31,11 +31,12 @@ BEGIN {
# 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);
+ group-example-01/cgi afs/testcell.stanford.edu);
# Various invalid keytab names.
my @INVALID_KEYTABS = qw(example host/example service/example.stanford.edu
- thisistoolong/cgi not-valid/cgi unknown/example.stanford.edu);
+ thisistoolong/cgi not-valid/cgi unknown/example.stanford.edu
+ afs/testcell);
# Various valid file names.
my @VALID_FILES = qw(htpasswd/example.stanford.edu/web
@@ -254,4 +255,6 @@ for my $type (qw(htpasswd ssh-rsa ssh-dsa ssl-key tivoli-key)) {
# Clean up.
$setup->destroy;
-unlink 'wallet-db';
+END {
+ unlink 'wallet-db';
+}
diff --git a/perl/t/style/minimum-version.t b/perl/t/style/minimum-version.t
new file mode 100755
index 0000000..e4eeafd
--- /dev/null
+++ b/perl/t/style/minimum-version.t
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+#
+# Check that too-new features of Perl are not being used.
+#
+# The canonical version of this file is maintained in the rra-c-util package,
+# which can be found at <http://www.eyrie.org/~eagle/software/rra-c-util/>.
+#
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2013, 2014
+# The Board of Trustees of the Leland Stanford Junior University
+#
+# Permission is hereby granted, free of charge, to any person obtaining a
+# copy of this software and associated documentation files (the "Software"),
+# to deal in the Software without restriction, including without limitation
+# the rights to use, copy, modify, merge, publish, distribute, sublicense,
+# and/or sell copies of the Software, and to permit persons to whom the
+# Software is furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
+# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+# DEALINGS IN THE SOFTWARE.
+
+use 5.006;
+use strict;
+use warnings;
+
+use lib 't/lib';
+
+use Test::More;
+use Test::RRA qw(skip_unless_automated use_prereq);
+use Test::RRA::Config qw($MINIMUM_VERSION);
+
+# Skip for normal user installs since this doesn't affect functionality.
+skip_unless_automated('Minimum version tests');
+
+# Load prerequisite modules.
+use_prereq('Test::MinimumVersion');
+
+# Check all files in the Perl distribution.
+all_minimum_version_ok($MINIMUM_VERSION);
diff --git a/perl/t/style/strict.t b/perl/t/style/strict.t
new file mode 100755
index 0000000..7137b15
--- /dev/null
+++ b/perl/t/style/strict.t
@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+#
+# Test Perl code for strict, warnings, and syntax.
+#
+# The canonical version of this file is maintained in the rra-c-util package,
+# which can be found at <http://www.eyrie.org/~eagle/software/rra-c-util/>.
+#
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2013, 2014
+# The Board of Trustees of the Leland Stanford Junior University
+#
+# Permission is hereby granted, free of charge, to any person obtaining a
+# copy of this software and associated documentation files (the "Software"),
+# to deal in the Software without restriction, including without limitation
+# the rights to use, copy, modify, merge, publish, distribute, sublicense,
+# and/or sell copies of the Software, and to permit persons to whom the
+# Software is furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
+# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+# DEALINGS IN THE SOFTWARE.
+
+use 5.006;
+use strict;
+use warnings;
+
+use lib 't/lib';
+
+use File::Spec;
+use Test::RRA qw(skip_unless_automated use_prereq);
+
+# Skip for normal user installs since this doesn't affect functionality.
+skip_unless_automated('Strictness tests');
+
+# Load prerequisite modules.
+use_prereq('Test::Strict');
+
+# Test everything in the distribution directory except the Build and
+# Makefile.PL scripts generated by Module::Build. We also want to check use
+# warnings.
+$Test::Strict::TEST_SKIP = ['Build', 'Makefile.PL'];
+$Test::Strict::TEST_WARNINGS = 1;
+all_perl_files_ok(File::Spec->curdir);
+
+# Hack to suppress "used only once" warnings.
+END {
+ $Test::Strict::TEST_SKIP = [];
+ $Test::Strict::TEST_WARNINGS = 0;
+}
diff --git a/perl/t/kadmin.t b/perl/t/util/kadmin.t
index 8eabc6b..db94780 100755
--- a/perl/t/kadmin.t
+++ b/perl/t/util/kadmin.t
@@ -1,14 +1,16 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
#
# Tests for the kadmin object implementation.
#
# Written by Jon Robertson <jonrober@stanford.edu>
-# Copyright 2009, 2010, 2012, 2013
+# Copyright 2009, 2010, 2012, 2013, 2014
# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
-use POSIX qw(strftime);
+use strict;
+use warnings;
+
use Test::More tests => 34;
BEGIN { $Wallet::Config::KEYTAB_TMP = '.' }
diff --git a/perl/t/verifier.t b/perl/t/verifier/basic.t
index 75f1afa..ce44d44 100755
--- a/perl/t/verifier.t
+++ b/perl/t/verifier/basic.t
@@ -1,13 +1,16 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
#
# Tests for the basic wallet ACL verifiers.
#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2010
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2007, 2008, 2010, 2014
# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
+use strict;
+use warnings;
+
use Test::More tests => 57;
use Wallet::ACL::Base;
@@ -23,22 +26,22 @@ use Util;
my $verifier = Wallet::ACL::Base->new;
ok (defined $verifier, 'Wallet::ACL::Base creation');
ok ($verifier->isa ('Wallet::ACL::Base'), ' and class verification');
-is ($verifier->check ('rra@stanford.edu', 'rra@stanford.edu'), 0,
+is ($verifier->check ('eagle@eyrie.org', 'eagle@eyrie.org'), 0,
'Default check declines');
is ($verifier->error, undef, 'No error set');
$verifier = Wallet::ACL::Krb5->new;
ok (defined $verifier, 'Wallet::ACL::Krb5 creation');
ok ($verifier->isa ('Wallet::ACL::Krb5'), ' and class verification');
-is ($verifier->check ('rra@stanford.edu', 'rra@stanford.edu'), 1,
+is ($verifier->check ('eagle@eyrie.org', 'eagle@eyrie.org'), 1,
'Simple check');
-is ($verifier->check ('rra@stanford.edu', 'thoron@stanford.edu'), 0,
+is ($verifier->check ('eagle@eyrie.org', 'thoron@stanford.edu'), 0,
'Simple failure');
is ($verifier->error, undef, 'No error set');
-is ($verifier->check (undef, 'rra@stanford.edu'), undef,
+is ($verifier->check (undef, 'eagle@eyrie.org'), undef,
'Undefined principal');
is ($verifier->error, 'no principal specified', ' and right error');
-is ($verifier->check ('rra@stanford.edu', ''), undef, 'Empty ACL');
+is ($verifier->check ('eagle@eyrie.org', ''), undef, 'Empty ACL');
is ($verifier->error, 'malformed krb5 ACL', ' and right error');
$verifier = Wallet::ACL::Krb5::Regex->new;
@@ -51,9 +54,9 @@ is ($verifier->error, undef, 'No error set');
is ($verifier->check (undef, '^rra@stanford\.edu\z'), undef,
'Undefined principal');
is ($verifier->error, 'no principal specified', ' and right error');
-is ($verifier->check ('rra@stanford.edu', ''), undef, 'Empty ACL');
+is ($verifier->check ('eagle@eyrie.org', ''), undef, 'Empty ACL');
is ($verifier->error, 'no ACL specified', ' and right error');
-is ($verifier->check ('rra@stanford.edu', '(rra'), undef, 'Malformed regex');
+is ($verifier->check ('eagle@eyrie.org', '(rra'), undef, 'Malformed regex');
is ($verifier->error, 'malformed krb5-regex ACL', ' and right error');
# Tests for the NetDB verifiers. Skip these if we don't have a keytab or if
diff --git a/perl/t/verifier-ldap-attr.t b/perl/t/verifier/ldap-attr.t
index 41d6737..3c132e2 100755
--- a/perl/t/verifier-ldap-attr.t
+++ b/perl/t/verifier/ldap-attr.t
@@ -1,16 +1,19 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
#
# 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
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2012, 2013, 2014
# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
+use strict;
+use warnings;
+
use Test::More;
use lib 't/lib';
@@ -44,7 +47,7 @@ package main;
# Determine the local principal.
my $klist = `klist 2>&1` || '';
SKIP: {
- skip "tests useful only with Stanford Kerberos tickets", 4
+ skip "tests useful only with Stanford Kerberos tickets", 9
unless ($klist =~ /[Pp]rincipal: \S+\@stanford\.edu$/m);
# Set up our configuration.
diff --git a/perl/t/verifier-netdb.t b/perl/t/verifier/netdb.t
index 398cc6a..7048ef9 100755
--- a/perl/t/verifier-netdb.t
+++ b/perl/t/verifier/netdb.t
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
#
# Tests for the NetDB wallet ACL verifiers.
#
@@ -6,13 +6,16 @@
# access to the NetDB role server and will be skipped in all other
# environments.
#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008
+# 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 Test::More tests => 4;
+use strict;
+use warnings;
+
+use Test::More tests => 5;
use Wallet::ACL::NetDB;
@@ -26,8 +29,8 @@ my $user = 'rra@stanford.edu';
# Determine the local principal.
my $klist = `klist 2>&1` || '';
SKIP: {
- skip "tests useful only with Stanford Kerberos tickets", 4
- unless ($klist =~ /^Default principal: \S+\@stanford\.edu$/m);
+ skip "tests useful only with Stanford Kerberos tickets", 5
+ unless ($klist =~ /^(Default p|\s+P)rincipal: \S+\@stanford\.edu$/m);
# Set up our configuration.
$Wallet::Config::NETDB_REALM = 'stanford.edu';
@@ -35,8 +38,9 @@ SKIP: {
$Wallet::Config::NETDB_REMCTL_HOST = $netdb;
# Finally, we can test.
- $verifier = eval { Wallet::ACL::NetDB->new };
+ my $verifier = eval { Wallet::ACL::NetDB->new };
ok (defined $verifier, ' and now creation succeeds');
+ is ($@, q{}, ' with no errors');
ok ($verifier->isa ('Wallet::ACL::NetDB'), ' and returns the right class');
is ($verifier->check ($user, $host), 1, "Checking $host succeeds");
is ($verifier->check ('test-user@stanford.edu', $host), 0,