diff options
Diffstat (limited to 'perl/t')
-rw-r--r-- | perl/t/data/duo/integration.json | 11 | ||||
-rw-r--r-- | perl/t/data/duo/keys.json | 5 | ||||
-rw-r--r-- | perl/t/data/perl.conf | 7 | ||||
-rwxr-xr-x | perl/t/docs/pod-spelling.t | 66 | ||||
-rwxr-xr-x | perl/t/docs/pod.t | 65 | ||||
-rwxr-xr-x | perl/t/general/acl.t (renamed from perl/t/acl.t) | 22 | ||||
-rwxr-xr-x | perl/t/general/admin.t (renamed from perl/t/admin.t) | 65 | ||||
-rwxr-xr-x | perl/t/general/config.t (renamed from perl/t/config.t) | 9 | ||||
-rwxr-xr-x | perl/t/general/init.t (renamed from perl/t/init.t) | 13 | ||||
-rwxr-xr-x | perl/t/general/report.t (renamed from perl/t/report.t) | 15 | ||||
-rwxr-xr-x | perl/t/general/server.t (renamed from perl/t/server.t) | 53 | ||||
-rw-r--r-- | perl/t/lib/Util.pm | 5 | ||||
-rwxr-xr-x | perl/t/object/base.t (renamed from perl/t/object.t) | 25 | ||||
-rwxr-xr-x | perl/t/object/duo.t | 157 | ||||
-rwxr-xr-x | perl/t/object/file.t (renamed from perl/t/file.t) | 15 | ||||
-rwxr-xr-x | perl/t/object/keytab.t (renamed from perl/t/keytab.t) | 42 | ||||
-rwxr-xr-x | perl/t/object/wa-keyring.t (renamed from perl/t/wa-keyring.t) | 9 | ||||
-rwxr-xr-x | perl/t/pod-spelling.t | 74 | ||||
-rwxr-xr-x | perl/t/pod.t | 15 | ||||
-rwxr-xr-x | perl/t/policy/stanford.t (renamed from perl/t/stanford-naming.t) | 15 | ||||
-rwxr-xr-x | perl/t/style/minimum-version.t | 47 | ||||
-rwxr-xr-x | perl/t/style/strict.t | 56 | ||||
-rwxr-xr-x | perl/t/util/kadmin.t (renamed from perl/t/kadmin.t) | 8 | ||||
-rwxr-xr-x | perl/t/verifier/basic.t (renamed from perl/t/verifier.t) | 23 | ||||
-rwxr-xr-x | perl/t/verifier/ldap-attr.t (renamed from perl/t/verifier-ldap-attr.t) | 11 | ||||
-rwxr-xr-x | perl/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, |