From 574a9c0456c182831b3d01a4d7ee0c737b91b107 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Jun 2009 14:39:39 -0700 Subject: Remove Subversion Id strings --- tests/server/admin-t.in | 1 - tests/server/backend-t.in | 1 - tests/server/pod-t.in | 1 - 3 files changed, 3 deletions(-) (limited to 'tests/server') diff --git a/tests/server/admin-t.in b/tests/server/admin-t.in index be40880..44ea1fe 100644 --- a/tests/server/admin-t.in +++ b/tests/server/admin-t.in @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # Tests for the wallet-admin dispatch code. # diff --git a/tests/server/backend-t.in b/tests/server/backend-t.in index e1518d8..773a002 100644 --- a/tests/server/backend-t.in +++ b/tests/server/backend-t.in @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # Tests for the wallet-backend dispatch code. # diff --git a/tests/server/pod-t.in b/tests/server/pod-t.in index fd939a5..4973d23 100644 --- a/tests/server/pod-t.in +++ b/tests/server/pod-t.in @@ -1,5 +1,4 @@ #!/usr/bin/perl -# $Id$ # # tests/server/pod-t -- Test POD formatting for client documentation. # -- cgit v1.2.3 From e455057f2fe19dd27ee1b03083454eceb07d3043 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Jun 2009 16:37:52 -0700 Subject: Update tests to reflect suppression of store data in logging --- tests/server/backend-t.in | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'tests/server') diff --git a/tests/server/backend-t.in b/tests/server/backend-t.in index 773a002..0c6ac60 100644 --- a/tests/server/backend-t.in +++ b/tests/server/backend-t.in @@ -3,7 +3,8 @@ # Tests for the wallet-backend dispatch code. # # Written by Russ Allbery -# Copyright 2006, 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2006, 2007, 2008, 2009 +# Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -338,7 +339,11 @@ for my $command (qw/autocreate create destroy setacl setattr store/) { is ($out, "$new\n$method type name$extra\n", ' and ran the right method'); ($out, $err) = run_backend ($command, 'error', 'name', @extra); - $ran = "$command error name" . (@extra ? " @extra" : ''); + if ($command eq 'store') { + $ran = "$command error name"; + } else { + $ran = "$command error name" . (@extra ? " @extra" : ''); + } is ($err, "error count $error\n", "Command $command ran with errors"); is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count" . " $error\n", ' and syslog correct'); -- cgit v1.2.3 From c2cde5918af1882ee63324fd9e09f07c8e6e5cc9 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Jun 2009 16:39:08 -0700 Subject: Add owners report Add a new report owners command to wallet-admin and corresponding report_owners() method to Wallet::Admin, which returns all ACL lines on owner ACLs for matching objects. --- NEWS | 4 ++++ perl/Wallet/Admin.pm | 47 ++++++++++++++++++++++++++++++++++++++++-- perl/t/admin.t | 55 +++++++++++++++++++++++++++++++++++++++++++++++-- server/wallet-admin | 39 ++++++++++++++++++++++++++++++++++- tests/server/admin-t.in | 45 +++++++++++++++++++++++++++++++--------- 5 files changed, 175 insertions(+), 15 deletions(-) (limited to 'tests/server') diff --git a/NEWS b/NEWS index e16c630..ab0828b 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,10 @@ wallet 0.10 (unreleased) Fix logging in wallet-backend and the remctl configuration to not log the data passed to store. + Add a new report owners command to wallet-admin and corresponding + report_owners() method to Wallet::Admin, which returns all ACL lines + on owner ACLs for matching objects. + wallet 0.9 (2008-04-24) The wallet command-line client now reads the data for store from a diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index 3a2f687..c11c3d4 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -1,7 +1,7 @@ # Wallet::Admin -- Wallet system administrative interface. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -22,7 +22,7 @@ use Wallet::Schema; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.02'; +$VERSION = '0.03'; ############################################################################## # Constructor, destructor, and accessors @@ -171,6 +171,38 @@ sub list_acls { } } +# Returns a report of all ACL lines contained in owner ACLs for matching +# objects. Objects are specified by type and name, which may be SQL wildcard +# expressions. Each list member will be a pair of ACL scheme and ACL +# identifier, with duplicates removed. On error and for no matching entries, +# the empty list will be returned. To distinguish between an empty return and +# an error, call error(), which will return undef if there was no error. +sub report_owners { + my ($self, $type, $name) = @_; + undef $self->{error}; + my @lines; + eval { + my $sql = 'select distinct ae_scheme, ae_identifier from acl_entries, + acls, objects where ae_id = ac_id and ac_id = ob_owner and + ob_type like ? and ob_name like ? order by ae_scheme, + ae_identifier'; + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute ($type, $name); + my $object; + while (defined ($object = $sth->fetchrow_arrayref)) { + push (@lines, [ @$object ]); + } + $self->{dbh}->commit; + }; + if ($@) { + $self->error ("cannot report on owners: $@"); + $self->{dbh}->rollback; + return; + } else { + return @lines; + } +} + ############################################################################## # Object registration ############################################################################## @@ -335,6 +367,17 @@ be deleted and a fresh set of wallet database tables will be created. This method is equivalent to calling destroy() followed by initialize(). Returns true on success and false on failure. +=item report_owners(TYPE, NAME) + +Returns a list of all ACL lines contained in owner ACLs for objects +matching TYPE and NAME, which are interpreted as SQL patterns using C<%> +as a wildcard. The return value is a list of references to pairs of +schema and identifier, with duplicates removed. + +Returns the empty list on failure. To distinguish between this and no +matches, the caller should call error(). error() is guaranteed to return +the error message if there was an error and undef if there was no error. + =back =head1 SEE ALSO diff --git a/perl/t/admin.t b/perl/t/admin.t index 7a8b8ae..8804f34 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -3,11 +3,11 @@ # t/admin.t -- Tests for wallet administrative interface. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. -use Test::More tests => 29; +use Test::More tests => 57; use Wallet::Admin; use Wallet::Schema; @@ -73,6 +73,57 @@ is ($acls[0][1], 'ADMIN', ' and the first name is still the same'); is ($acls[1][0], 3, ' but the second ID has changed'); is ($acls[1][1], 'second', ' and the second name is correct'); +# Currently, we have no owners, so we should get an empty owner report. +my @lines = $admin->report_owners ('%', '%'); +is (scalar (@lines), 0, 'Owner report is currently empty'); +is ($admin->error, undef, ' and there is no error'); + +# Set an owner and make sure we now see something in the report. +is ($server->owner ('base', 'service/admin', 'ADMIN'), 1, + 'Setting an owner works'); +@lines = $admin->report_owners ('%', '%'); +is (scalar (@lines), 1, ' and now there is one owner in the report'); +is ($lines[0][0], 'krb5', ' with the right scheme'); +is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); +@lines = $admin->report_owners ('keytab', '%'); +is (scalar (@lines), 0, 'Owners of keytabs is empty'); +is ($admin->error, undef, ' with no error'); +@lines = $admin->report_owners ('base', 'foo/%'); +is (scalar (@lines), 0, 'Owners of base foo/* objects is empty'); +is ($admin->error, undef, ' with no error'); + +# Create a second object with the same owner. +is ($server->create ('base', 'service/foo'), 1, + 'Creating base:service/foo succeeds'); +is ($server->owner ('base', 'service/foo', 'ADMIN'), 1, + ' and setting the owner to the same value works'); +@lines = $admin->report_owners ('base', 'service/%'); +is (scalar (@lines), 1, ' and there is still owner in the report'); +is ($lines[0][0], 'krb5', ' with the right scheme'); +is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); + +# Change the owner of the second object to an empty ACL. +is ($server->owner ('base', 'service/foo', 'second'), 1, + ' and changing the owner to an empty ACL works'); +@lines = $admin->report_owners ('base', '%'); +is (scalar (@lines), 1, ' and there is still owner in the report'); +is ($lines[0][0], 'krb5', ' with the right scheme'); +is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); + +# Add a few things to the second ACL to see what happens. +is ($server->acl_add ('second', 'base', 'foo'), 1, + 'Adding an ACL line to the new ACL works'); +is ($server->acl_add ('second', 'base', 'bar'), 1, + ' and adding another ACL line to the new ACL works'); +@lines = $admin->report_owners ('base', '%'); +is (scalar (@lines), 3, ' and now there are three owners in the report'); +is ($lines[0][0], 'base', ' first has the right scheme'); +is ($lines[0][1], 'bar', ' and the right identifier'); +is ($lines[1][0], 'base', ' second has the right scheme'); +is ($lines[1][1], 'foo', ' and the right identifier'); +is ($lines[2][0], 'krb5', ' third has the right scheme'); +is ($lines[2][1], 'admin@EXAMPLE.COM', ' and the right identifier'); + # Clean up. is ($admin->destroy, 1, 'Destruction succeeds'); unlink 'wallet-db'; diff --git a/server/wallet-admin b/server/wallet-admin index 0daa986..b5674c5 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -3,7 +3,7 @@ # wallet-admin -- Wallet server administrative commands. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -64,6 +64,22 @@ sub command { } else { die "only objects or acls are supported for list\n"; } + } elsif ($command eq 'report') { + die "too few arguments to report\n" if @args < 1; + my $report = shift @args; + if ($report eq 'owners') { + die "too many arguments to report owners\n" if @args > 2; + die "too few arguments to report owners\n" if @args < 2; + my @lines = $admin->report_owners (@args); + if (!@lines and $admin->error) { + die $admin->error, "\n"; + } + for my $line (@lines) { + print join (' ', @$line), "\n"; + } + } else { + die "unknown report type $report\n"; + } } elsif ($command eq 'register') { die "too many arguments to register\n" if @args > 3; die "too few arguments to register\n" if @args < 3; @@ -168,6 +184,27 @@ default as part of database initialization, so this command is used primarily to register local implementations of additional object types or ACL schemes. +=item report [ ... ] + +Runs a wallet report. The currently supported report types are: + +=over 4 + +=item report owners + +Returns a list of all ACL lines in owner ACLs for all objects matching +both and . These can be the type or name of +objects or they can be patterns using C<%> as the wildcard character +following the normal rules of SQL patterns. + +The output will be one line per ACL line in the form: + + + +with duplicates suppressed. + +=back + =back =head1 SEE ALSO diff --git a/tests/server/admin-t.in b/tests/server/admin-t.in index 44ea1fe..3e84022 100644 --- a/tests/server/admin-t.in +++ b/tests/server/admin-t.in @@ -3,12 +3,12 @@ # Tests for the wallet-admin dispatch code. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. use strict; -use Test::More tests => 54; +use Test::More tests => 64; # Create a dummy class for Wallet::Admin that prints what method was called # with its arguments and returns data for testing. @@ -71,6 +71,13 @@ sub register_verifier { return 1; } +sub report_owners { + shift; + print "report_owners @_\n"; + return if ($error or $empty); + return ([ krb5 => 'admin@EXAMPLE.COM' ]); +} + # Back to the main package and the actual test suite. Lie about whether the # Wallet::Admin package has already been loaded. package main; @@ -98,10 +105,11 @@ is ($err, "unknown command foo\n", 'Unknown command'); is ($out, "new\n", ' and nothing ran'); # Check too few and too many arguments for every command. -my %commands = (destroy => [0, 0], - initialize => [1, 1], - list => [1, 1], - register => [3, 3]); +my %commands = (destroy => [0, 0], + initialize => [1, 1], + list => [1, 1], + register => [3, 3], + report => [1, -1]); for my $command (sort keys %commands) { my ($min, $max) = @{ $commands{$command} }; if ($min > 0) { @@ -110,10 +118,12 @@ for my $command (sort keys %commands) { "Too few arguments for $command"); is ($out, "new\n", ' and nothing ran'); } - ($out, $err) = run_admin ($command, ('foo') x ($max + 1)); - is ($err, "too many arguments to $command\n", - "Too many arguments for $command"); - is ($out, "new\n", ' and nothing ran'); + if ($max >= 0) { + ($out, $err) = run_admin ($command, ('foo') x ($max + 1)); + is ($err, "too many arguments to $command\n", + "Too many arguments for $command"); + is ($out, "new\n", ' and nothing ran'); + } } # Test destroy. @@ -179,6 +189,15 @@ is ($err, '', 'Register succeeds for verifier'); is ($out, "new\nregister_verifier foo Foo::Verifier\n", ' and returns the right outout'); +# Test report. +($out, $err) = run_admin ('report', 'foo'); +is ($err, "unknown report type foo\n", 'Report requires a known report'); +is ($out, "new\n", ' and nothing was run'); +($out, $err) = run_admin ('report', 'owners', '%', '%'); +is ($err, '', 'Report succeeds for owners'); +is ($out, "new\nreport_owners % %\nkrb5 admin\@EXAMPLE.COM\n", + ' and returns the right output'); + # Test error handling. $Wallet::Admin::error = 1; ($out, $err) = run_admin ('destroy'); @@ -204,6 +223,9 @@ is ($out, "new\nregister_object foo Foo::Object\n", is ($err, "some error\n", 'Error handling succeeds for register verifier'); is ($out, "new\nregister_verifier foo Foo::Verifier\n", ' and calls the right methods'); +($out, $err) = run_admin ('report', 'owners', 'foo', 'bar'); +is ($err, "some error\n", 'Error handling succeeds for report owners'); +is ($out, "new\nreport_owners foo bar\n", ' and calls the right methods'); # Test empty lists. $Wallet::Admin::error = 0; @@ -214,3 +236,6 @@ is ($out, "new\nlist_objects\n", ' and calls the right methods'); ($out, $err) = run_admin ('list', 'acls'); is ($err, '', 'list acls runs with an empty list and no errors'); is ($out, "new\nlist_acls\n", ' and calls the right methods'); +($out, $err) = run_admin ('report', 'owners', 'foo', 'bar'); +is ($err, '', 'report owners runs with an empty list and no errors'); +is ($out, "new\nreport_owners foo bar\n", ' and calls the right methods'); -- cgit v1.2.3 From 865a91bebe112076965b823e32a853d9b0b20181 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 19 Jan 2010 22:48:48 -0800 Subject: Adjust server/admin test for the new list arguments --- tests/server/admin-t.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'tests/server') diff --git a/tests/server/admin-t.in b/tests/server/admin-t.in index 3e84022..11d2883 100644 --- a/tests/server/admin-t.in +++ b/tests/server/admin-t.in @@ -107,7 +107,7 @@ is ($out, "new\n", ' and nothing ran'); # Check too few and too many arguments for every command. my %commands = (destroy => [0, 0], initialize => [1, 1], - list => [1, 1], + list => [1, 4], register => [3, 3], report => [1, -1]); for my $command (sort keys %commands) { -- cgit v1.2.3 From 04b875599b1d4559dbcd356726035416081c6b48 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 28 Jan 2010 00:07:16 -0800 Subject: Improved and fixed tests related to Pod and KDC type Added a fix to the Pod tests to change the order of the arguments in a skip statement to the correct order. Also added tests for the KEYTAB_KRBTYPE value in the keytab tests, and changed the Wallet::Kadmin module to standardize the errors returned with no keytab set and add new error for keytab set but not a valid value. --- perl/Wallet/Kadmin.pm | 5 ++++- perl/t/keytab.t | 23 ++++++++++++++++++++--- tests/server/pod-t.in | 2 +- 3 files changed, 25 insertions(+), 5 deletions(-) (limited to 'tests/server') diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 95859a9..501bc37 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -32,7 +32,10 @@ $VERSION = '0.03'; sub new { my ($class) = @_; my ($kadmin); - if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + if (!defined $Wallet::Config::KEYTAB_KRBTYPE + || !$Wallet::Config::KEYTAB_KRBTYPE) { + die "keytab object implementation not configured\n"; + } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { require Wallet::Kadmin::MIT; $kadmin = Wallet::Kadmin::MIT->new (); } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 7745290..ab5b19d 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -8,7 +8,7 @@ # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 208 +use Test::More tests => 212 ; use Wallet::Admin; @@ -387,6 +387,21 @@ EOO is ($@, "keytab object implementation not configured\n", ' with the right error'); $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); + undef $Wallet::Config::KEYTAB_KRBTYPE; + $object = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) + }; + is ($object, undef, ' and another'); + is ($@, "keytab object implementation not configured\n", + ' with the right error'); + $Wallet::Config::KEYTAB_KRBTYPE = 'Active Directory'; + $object = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) + }; + is ($object, undef, ' and one set to an invalid value'); + is ($@, "keytab krb server type not set to a valid value\n", + ' with the right error'); + $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); } # Tests for unchanging support. Skip these if we don't have a keytab or if we @@ -403,6 +418,7 @@ SKIP: { $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal'); $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); + $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); $Wallet::Config::KEYTAB_TMP = '.'; my $realm = $Wallet::Config::KEYTAB_REALM; my $principal = $Wallet::Config::KEYTAB_PRINCIPAL; @@ -581,6 +597,7 @@ EOO $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal'); $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); + $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); $Wallet::Config::KEYTAB_TMP = '.'; $Wallet::Config::KEYTAB_AFS_KASETKEY = '../kasetkey/kasetkey'; my $realm = $Wallet::Config::KEYTAB_REALM; @@ -707,8 +724,7 @@ EOO # Tests for enctype restriction. SKIP: { - unless (-f 't/data/test.keytab' - && $Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + unless (-f 't/data/test.keytab') { skip 'no keytab configuration', 36; } @@ -716,6 +732,7 @@ SKIP: { $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal'); $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); + $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); $Wallet::Config::KEYTAB_TMP = '.'; my $realm = $Wallet::Config::KEYTAB_REALM; my $principal = $Wallet::Config::KEYTAB_PRINCIPAL; diff --git a/tests/server/pod-t.in b/tests/server/pod-t.in index 4973d23..4575ecb 100644 --- a/tests/server/pod-t.in +++ b/tests/server/pod-t.in @@ -15,7 +15,7 @@ plan tests => $total; eval 'use Test::Pod 1.00'; SKIP: { - skip $total, 'Test::Pod 1.00 required for testing POD' if $@; + skip 'Test::Pod 1.00 required for testing POD', $total if $@; for my $file (@files) { pod_file_ok ("@abs_top_srcdir@/server/$file", "server/$file"); } -- cgit v1.2.3 From ff2d5ac3c63af9833d884d4840c772e60e45da7d Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 19:55:12 -0800 Subject: Use the $SOURCE and $BUILD test suite variables Now that runtests has been updated to a version that sets $SOURCE and $BUILD, use that in the test cases rather than Autoconf substitutions. --- tests/client/full-t.in | 20 ++++++++++---------- tests/client/pod-t.in | 4 ++-- tests/client/prompt-t.in | 28 +++++++++++++--------------- tests/server/admin-t.in | 4 ++-- tests/server/backend-t.in | 4 ++-- tests/server/keytab-t.in | 9 ++++----- tests/server/pod-t.in | 6 +++--- 7 files changed, 36 insertions(+), 39 deletions(-) (limited to 'tests/server') diff --git a/tests/client/full-t.in b/tests/client/full-t.in index 3240563..a4ca19d 100644 --- a/tests/client/full-t.in +++ b/tests/client/full-t.in @@ -1,23 +1,23 @@ #!/usr/bin/perl -w # -# tests/client/full-t -- End-to-end tests for the wallet client. +# End-to-end tests for the wallet client. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. # Point to our server configuration. This must be done before Wallet::Config # is loaded, and it's pulled in as a prerequisite for Wallet::Admin. -BEGIN { $ENV{WALLET_CONFIG} = '@abs_top_srcdir@/tests/data/wallet.conf' } +BEGIN { $ENV{WALLET_CONFIG} = "$ENV{SOURCE}/data/wallet.conf" } BEGIN { our $total = 53 } use Test::More tests => $total; -use lib '@abs_top_srcdir@/perl'; +use lib "$ENV{SOURCE}/../perl"; use Wallet::Admin; -use lib '@abs_top_srcdir@/perl/t/lib'; +use lib "$ENV{SOURCE}/../perl/t/lib"; use Util; # Make a call to the wallet client. Takes the principal used by the server @@ -33,9 +33,9 @@ sub wallet { or die "cannot create wallet.out: $!\n"; open (STDERR, '>', 'wallet.err') or die "cannot create wallet.err: $!\n"; - exec ('@abs_top_builddir@/client/wallet', '-k', $principal, '-p', + exec ("$ENV{BUILD}/../client/wallet", '-k', $principal, '-p', '14373', '-s', 'localhost', @command) - or die "cannot run @abs_top_builddir@/client/wallet: $!\n"; + or die "cannot run $ENV{BUILD}/client/wallet: $!\n"; } else { waitpid ($pid, 0); } @@ -53,19 +53,19 @@ sub wallet { SKIP: { skip 'no keytab configuration', $total - unless -f '@abs_top_builddir@/tests/data/test.keytab'; + unless -f "$ENV{BUILD}/data/test.keytab"; my $remctld = '@REMCTLD@'; skip 'remctld not found', $total unless $remctld; # Spawn remctld and get local tickets. Don't destroy the user's Kerberos # ticket cache. unlink ('krb5cc_test', 'test-pid'); - my $principal = contents ('@abs_top_builddir@/tests/data/test.principal'); + my $principal = contents ("$ENV{BUILD}/data/test.principal"); remctld_spawn ($remctld, $principal, '@abs_top_builddir@/tests/data/test.keytab', '@abs_top_builddir@/tests/data/full.conf'); $ENV{KRB5CCNAME} = 'krb5cc_test'; - getcreds ('@abs_top_builddir@/tests/data/test.keytab', $principal); + getcreds ("$ENV{BUILD}/data/test.keytab", $principal); # Use Wallet::Admin to set up the database. db_setup; diff --git a/tests/client/pod-t.in b/tests/client/pod-t.in index db995f7..9963567 100644 --- a/tests/client/pod-t.in +++ b/tests/client/pod-t.in @@ -3,7 +3,7 @@ # Test POD formatting for client documentation. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -17,6 +17,6 @@ eval 'use Test::Pod 1.00'; SKIP: { skip $total, 'Test::Pod 1.00 required for testing POD' if $@; for my $file (@files) { - pod_file_ok ("@abs_top_srcdir@/client/$file", "client/$file"); + pod_file_ok ("$ENV{SOURCE}/../client/$file", "client/$file"); } } diff --git a/tests/client/prompt-t.in b/tests/client/prompt-t.in index 7988fc9..e037b3f 100644 --- a/tests/client/prompt-t.in +++ b/tests/client/prompt-t.in @@ -1,28 +1,27 @@ #!/usr/bin/perl -w # -# tests/client/prompt-t -- Password prompting tests for the wallet client. +# Password prompting tests for the wallet client. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. BEGIN { our $total = 5 } use Test::More tests => $total; -use lib '@abs_top_srcdir@/perl'; +use lib "$ENV{SOURCE}/..//perl"; use Wallet::Admin; -use lib '@abs_top_srcdir@/perl/t/lib'; +use lib "$ENV{SOURCE}/../perl/t/lib"; use Util; # cd to the correct directory. -chdir '@abs_top_srcdir@/tests' - or die "Cannot chdir to @abs_top_srcdir@/tests: $!\n"; +chdir "$ENV{SOURCE}" or die "Cannot chdir to $ENV{SOURCE}: $!\n"; SKIP: { skip 'no password configuration', $total - unless -f '@abs_top_builddir@/tests/data/test.password'; + unless -f "$ENV{BUILD}/data/test.password"; my $remctld = '@REMCTLD@'; skip 'remctld not found', $total unless $remctld; eval { require Expect }; @@ -35,22 +34,21 @@ SKIP: { # Spawn remctld and set up with a different ticket cache. unlink ('krb5cc_test', 'test-pid'); - my $principal = contents ('@abs_top_builddir@/tests/data/test.principal'); - remctld_spawn ($remctld, $principal, - '@abs_top_builddir@/tests/data/test.keytab', - '@abs_top_builddir@/tests/data/basic.conf'); + my $principal = contents ("$ENV{BUILD}/data/test.principal"); + remctld_spawn ($remctld, $principal, "$ENV{BUILD}/data/test.keytab", + "$ENV{BUILD}/data/basic.conf"); $ENV{KRB5CCNAME} = 'krb5cc_test'; # Read in the principal and password. - open (PASS, '<', '@abs_top_builddir@/tests/data/test.password') - or die "Cannot open @abs_top_builddir@/tests/data/test.password: $!\n"; + open (PASS, '<', "$ENV{BUILD}/data/test.password") + or die "Cannot open $ENV{BUILD}/data/test.password: $!\n"; my $user = ; my $password = ; close PASS; chomp ($user, $password); # Spawn wallet and check an invalid password. - my $wallet = Expect->spawn ('@abs_top_builddir@/client/wallet', '-k', + my $wallet = Expect->spawn ("$ENV{BUILD}/../client/wallet", '-k', $principal, '-p', 14373, '-s', 'localhost', '-c', 'fake-wallet', '-u', $user, 'get', 'keytab', 'service/fake-output'); @@ -61,7 +59,7 @@ SKIP: { $wallet->soft_close; # Now check a valid password. - $wallet = Expect->spawn ('@abs_top_builddir@/client/wallet', '-k', + $wallet = Expect->spawn ("$ENV{BUILD}/../client/wallet", '-k', $principal, '-p', 14373, '-s', 'localhost', '-c', 'fake-wallet', '-u', $user, 'get', 'keytab', 'service/fake-output'); diff --git a/tests/server/admin-t.in b/tests/server/admin-t.in index 11d2883..570dc52 100644 --- a/tests/server/admin-t.in +++ b/tests/server/admin-t.in @@ -3,7 +3,7 @@ # Tests for the wallet-admin dispatch code. # # Written by Russ Allbery -# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -82,7 +82,7 @@ sub report_owners { # Wallet::Admin package has already been loaded. package main; $INC{'Wallet/Admin.pm'} = 'FAKE'; -eval { do '@abs_top_srcdir@/server/wallet-admin' }; +eval { do "$ENV{SOURCE}/../server/wallet-admin" }; # Run the wallet admin client. This fun hack takes advantage of the fact that # the wallet admin client is written in Perl so that we can substitute our own diff --git a/tests/server/backend-t.in b/tests/server/backend-t.in index 0c6ac60..2fc6a53 100644 --- a/tests/server/backend-t.in +++ b/tests/server/backend-t.in @@ -3,7 +3,7 @@ # Tests for the wallet-backend dispatch code. # # Written by Russ Allbery -# Copyright 2006, 2007, 2008, 2009 +# Copyright 2006, 2007, 2008, 2009, 2010 # Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -163,7 +163,7 @@ package main; $INC{'Wallet/Server.pm'} = 'FAKE'; my $OUTPUT; our $SYSLOG = \$OUTPUT; -eval { do '@abs_top_srcdir@/server/wallet-backend' }; +eval { do "$ENV{SOURCE}/../server/wallet-backend" }; # Run the wallet backend. This fun hack takes advantage of the fact that the # wallet backend is written in Perl so that we can substitute our own diff --git a/tests/server/keytab-t.in b/tests/server/keytab-t.in index f74267d..2a0ceed 100644 --- a/tests/server/keytab-t.in +++ b/tests/server/keytab-t.in @@ -1,10 +1,9 @@ #!/usr/bin/perl -w -# $Id: backend-t.in 3547 2007-09-14 23:18:48Z rra $ # # Tests for the keytab-backend dispatch code. # # Written by Russ Allbery -# Copyright 2006, 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2006, 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -16,9 +15,9 @@ use Test::More tests => 63; # Load the keytab-backend code and override various settings. my $OUTPUT; $SYSLOG = \$OUTPUT; -eval { do '@abs_top_srcdir@/server/keytab-backend' }; -$CONFIG = '@abs_top_srcdir@/tests/data/allow-extract'; -$KADMIN = '@abs_top_srcdir@/tests/data/fake-kadmin'; +eval { do "$ENV{SOURCE}/../server/keytab-backend" }; +$CONFIG = "$ENV{SOURCE}/data/allow-extract"; +$KADMIN = "$ENV{SOURCE}/data/fake-kadmin"; $TMP = '.'; # Run the keytab backend. diff --git a/tests/server/pod-t.in b/tests/server/pod-t.in index 4575ecb..52d81eb 100644 --- a/tests/server/pod-t.in +++ b/tests/server/pod-t.in @@ -1,9 +1,9 @@ #!/usr/bin/perl # -# tests/server/pod-t -- Test POD formatting for client documentation. +# Test POD formatting for client documentation. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -17,6 +17,6 @@ eval 'use Test::Pod 1.00'; SKIP: { skip 'Test::Pod 1.00 required for testing POD', $total if $@; for my $file (@files) { - pod_file_ok ("@abs_top_srcdir@/server/$file", "server/$file"); + pod_file_ok ("$ENV{SOURCE}/../server/$file", "server/$file"); } } -- cgit v1.2.3 From a556c732806da87d06bb787565e12240ea39b553 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 21:01:33 -0800 Subject: Stop doing Autoconf substitution on some test suite code Anything that only was using substitution for the paths to the build tree now uses $SOURCE and $BUILD instead. Stop doing substitution. Also fix tests/data/cmd-wrapper to use the environment variables. --- .gitignore | 7 - configure.ac | 6 - tests/client/pod-t | 22 ++ tests/client/pod-t.in | 22 -- tests/data/cmd-wrapper | 8 + tests/data/cmd-wrapper.in | 9 - tests/server/admin-t | 241 ++++++++++++++++++++++ tests/server/admin-t.in | 241 ---------------------- tests/server/backend-t | 502 ++++++++++++++++++++++++++++++++++++++++++++++ tests/server/backend-t.in | 502 ---------------------------------------------- tests/server/keytab-t | 88 ++++++++ tests/server/keytab-t.in | 88 -------- tests/server/pod-t | 22 ++ tests/server/pod-t.in | 22 -- 14 files changed, 883 insertions(+), 897 deletions(-) create mode 100755 tests/client/pod-t delete mode 100644 tests/client/pod-t.in create mode 100755 tests/data/cmd-wrapper delete mode 100644 tests/data/cmd-wrapper.in create mode 100755 tests/server/admin-t delete mode 100644 tests/server/admin-t.in create mode 100755 tests/server/backend-t delete mode 100644 tests/server/backend-t.in create mode 100755 tests/server/keytab-t delete mode 100644 tests/server/keytab-t.in create mode 100755 tests/server/pod-t delete mode 100644 tests/server/pod-t.in (limited to 'tests/server') diff --git a/.gitignore b/.gitignore index 09ae109..b0a49df 100644 --- a/.gitignore +++ b/.gitignore @@ -18,15 +18,12 @@ /perl/t/data/test.krbtype /tests/client/basic-t /tests/client/full-t -/tests/client/pod-t /tests/client/prompt-t -/tests/data/cmd-wrapper /tests/data/full.conf /tests/data/test.keytab /tests/data/test.password /tests/data/test.principal /tests/data/test.krbtype -/tests/kasetkey/basic-t /tests/portable/asprintf-t /tests/portable/mkstemp-t /tests/portable/setenv-t @@ -34,10 +31,6 @@ /tests/portable/strlcat-t /tests/portable/strlcpy-t /tests/runtests -/tests/server/admin-t -/tests/server/backend-t -/tests/server/keytab-t -/tests/server/pod-t /tests/util/concat-t /tests/util/messages-krb5-t /tests/util/messages-t diff --git a/configure.ac b/configure.ac index c897775..664c6f7 100644 --- a/configure.ac +++ b/configure.ac @@ -64,11 +64,5 @@ AC_CONFIG_HEADER([config.h]) AC_CONFIG_FILES([Makefile perl/Makefile.PL tests/data/full.conf]) AC_CONFIG_FILES([tests/client/basic-t], [chmod +x tests/client/basic-t]) AC_CONFIG_FILES([tests/client/full-t], [chmod +x tests/client/full-t]) -AC_CONFIG_FILES([tests/client/pod-t], [chmod +x tests/client/pod-t]) AC_CONFIG_FILES([tests/client/prompt-t], [chmod +x tests/client/prompt-t]) -AC_CONFIG_FILES([tests/data/cmd-wrapper], [chmod +x tests/data/cmd-wrapper]) -AC_CONFIG_FILES([tests/server/admin-t], [chmod +x tests/server/admin-t]) -AC_CONFIG_FILES([tests/server/backend-t], [chmod +x tests/server/backend-t]) -AC_CONFIG_FILES([tests/server/keytab-t], [chmod +x tests/server/keytab-t]) -AC_CONFIG_FILES([tests/server/pod-t], [chmod +x tests/server/pod-t]) AC_OUTPUT diff --git a/tests/client/pod-t b/tests/client/pod-t new file mode 100755 index 0000000..9963567 --- /dev/null +++ b/tests/client/pod-t @@ -0,0 +1,22 @@ +#!/usr/bin/perl +# +# Test POD formatting for client documentation. +# +# Written by Russ Allbery +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use Test::More; + +my @files = qw(wallet.pod); +my $total = scalar (@files); +plan tests => $total; + +eval 'use Test::Pod 1.00'; +SKIP: { + skip $total, 'Test::Pod 1.00 required for testing POD' if $@; + for my $file (@files) { + pod_file_ok ("$ENV{SOURCE}/../client/$file", "client/$file"); + } +} diff --git a/tests/client/pod-t.in b/tests/client/pod-t.in deleted file mode 100644 index 9963567..0000000 --- a/tests/client/pod-t.in +++ /dev/null @@ -1,22 +0,0 @@ -#!/usr/bin/perl -# -# Test POD formatting for client documentation. -# -# Written by Russ Allbery -# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University -# -# See LICENSE for licensing terms. - -use Test::More; - -my @files = qw(wallet.pod); -my $total = scalar (@files); -plan tests => $total; - -eval 'use Test::Pod 1.00'; -SKIP: { - skip $total, 'Test::Pod 1.00 required for testing POD' if $@; - for my $file (@files) { - pod_file_ok ("$ENV{SOURCE}/../client/$file", "client/$file"); - } -} diff --git a/tests/data/cmd-wrapper b/tests/data/cmd-wrapper new file mode 100755 index 0000000..79b1943 --- /dev/null +++ b/tests/data/cmd-wrapper @@ -0,0 +1,8 @@ +#!/bin/sh +# +# Wrapper around the standard wallet-backend script that sets the Perl INC +# path and the WALLET_CONFIG environment variable appropriately. + +WALLET_CONFIG="$SOURCE/data/wallet.conf" +export WALLET_CONFIG +exec perl -I"$SOURCE/../perl" "$SOURCE/../server/wallet-backend" -q "$@" diff --git a/tests/data/cmd-wrapper.in b/tests/data/cmd-wrapper.in deleted file mode 100644 index 7c7b342..0000000 --- a/tests/data/cmd-wrapper.in +++ /dev/null @@ -1,9 +0,0 @@ -#!/bin/sh -# -# Wrapper around the standard wallet-backend script that sets the Perl INC -# path and the WALLET_CONFIG environment variable appropriately. - -WALLET_CONFIG='@abs_top_srcdir@/tests/data/wallet.conf' -export WALLET_CONFIG -exec perl -I'@abs_top_srcdir@/perl' '@abs_top_srcdir@/server/wallet-backend' \ - -q "$@" diff --git a/tests/server/admin-t b/tests/server/admin-t new file mode 100755 index 0000000..570dc52 --- /dev/null +++ b/tests/server/admin-t @@ -0,0 +1,241 @@ +#!/usr/bin/perl -w +# +# Tests for the wallet-admin dispatch code. +# +# Written by Russ Allbery +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use strict; +use Test::More tests => 64; + +# Create a dummy class for Wallet::Admin that prints what method was called +# with its arguments and returns data for testing. +package Wallet::Admin; + +use vars qw($empty $error); +$error = 0; +$empty = 0; + +sub error { + if ($error) { + return "some error"; + } else { + return; + } +} + +sub new { + print "new\n"; + return bless ({}, 'Wallet::Admin'); +} + +sub destroy { + print "destroy\n"; + return if $error; + return 1; +} + +sub initialize { + shift; + print "initialize @_\n"; + return if $error; + return 1; +} + +sub list_objects { + print "list_objects\n"; + return if ($error or $empty); + return ([ keytab => 'host/windlord.stanford.edu' ], + [ file => 'unix-wallet-password' ]); +} + +sub list_acls { + print "list_acls\n"; + return if ($error or $empty); + return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]); +} + +sub register_object { + shift; + print "register_object @_\n"; + return if $error; + return 1; +} + +sub register_verifier { + shift; + print "register_verifier @_\n"; + return if $error; + return 1; +} + +sub report_owners { + shift; + print "report_owners @_\n"; + return if ($error or $empty); + return ([ krb5 => 'admin@EXAMPLE.COM' ]); +} + +# Back to the main package and the actual test suite. Lie about whether the +# Wallet::Admin package has already been loaded. +package main; +$INC{'Wallet/Admin.pm'} = 'FAKE'; +eval { do "$ENV{SOURCE}/../server/wallet-admin" }; + +# Run the wallet admin client. This fun hack takes advantage of the fact that +# the wallet admin client is written in Perl so that we can substitute our own +# Wallet::Admin class. +sub run_admin { + my (@args) = @_; + my $result = ''; + open (OUTPUT, '>', \$result) or die "cannot create output string: $!\n"; + select OUTPUT; + local $| = 1; + eval { command (@args) }; + my $error = $@; + select STDOUT; + return ($result, $error); +} + +# Now for the actual tests. First check for unknown commands. +my ($out, $err) = run_admin ('foo'); +is ($err, "unknown command foo\n", 'Unknown command'); +is ($out, "new\n", ' and nothing ran'); + +# Check too few and too many arguments for every command. +my %commands = (destroy => [0, 0], + initialize => [1, 1], + list => [1, 4], + register => [3, 3], + report => [1, -1]); +for my $command (sort keys %commands) { + my ($min, $max) = @{ $commands{$command} }; + if ($min > 0) { + ($out, $err) = run_admin ($command, ('foo') x ($min - 1)); + is ($err, "too few arguments to $command\n", + "Too few arguments for $command"); + is ($out, "new\n", ' and nothing ran'); + } + if ($max >= 0) { + ($out, $err) = run_admin ($command, ('foo') x ($max + 1)); + is ($err, "too many arguments to $command\n", + "Too many arguments for $command"); + is ($out, "new\n", ' and nothing ran'); + } +} + +# Test destroy. +my $answer = ''; +close STDIN; +open (STDIN, '<', \$answer) or die "cannot reopen standard input: $!\n"; +($out, $err) = run_admin ('destroy'); +is ($err, "Aborted\n", 'Destroy with no answer aborts'); +is ($out, "new\n" . + 'This will delete all data in the wallet database. Are you sure (N/y)? ', + ' and prints the right prompt'); +seek (STDIN, 0, 0); +$answer = 'n'; +($out, $err) = run_admin ('destroy'); +is ($err, "Aborted\n", 'Destroy with negative answer answer aborts'); +is ($out, "new\n" . + 'This will delete all data in the wallet database. Are you sure (N/y)? ', + ' and prints the right prompt'); +seek (STDIN, 0, 0); +$answer = 'y'; +($out, $err) = run_admin ('destroy'); +is ($err, '', 'Destroy succeeds with a positive answer'); +is ($out, "new\n" + . 'This will delete all data in the wallet database.' + . ' Are you sure (N/y)? ' . "destroy\n", ' and destroy was run'); +seek (STDIN, 0, 0); + +# Test initialize. +($out, $err) = run_admin ('initialize', 'rra'); +is ($err, "invalid admin principal rra\n", 'Initialize requires a principal'); +is ($out, "new\n", ' and nothing was run'); +($out, $err) = run_admin ('initialize', 'rra@stanford.edu'); +is ($err, '', 'Initialize succeeds with a principal'); +is ($out, "new\ninitialize rra\@stanford.edu\n", ' and runs the right code'); + +# Test list. +($out, $err) = run_admin ('list', 'foo'); +is ($err, "only objects or acls are supported for list\n", + 'List requires a known object'); +is ($out, "new\n", ' and nothing was run'); +($out, $err) = run_admin ('list', 'objects'); +is ($err, '', 'List succeeds for objects'); +is ($out, "new\nlist_objects\n" + . "keytab host/windlord.stanford.edu\nfile unix-wallet-password\n", + ' and returns the right output'); +($out, $err) = run_admin ('list', 'acls'); +is ($err, '', 'List succeeds for ACLs'); +is ($out, "new\nlist_acls\n" + . "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n", + ' and returns the right output'); + +# Test register. +($out, $err) = run_admin ('register', 'foo', 'foo', 'Foo::Bar'); +is ($err, "only object or verifier is supported for register\n", + 'Register requires object or verifier'); +is ($out, "new\n", ' and nothing was run'); +($out, $err) = run_admin ('register', 'object', 'foo', 'Foo::Object'); +is ($err, '', 'Register succeeds for object'); +is ($out, "new\nregister_object foo Foo::Object\n", + ' and returns the right outout'); +($out, $err) = run_admin ('register', 'verifier', 'foo', 'Foo::Verifier'); +is ($err, '', 'Register succeeds for verifier'); +is ($out, "new\nregister_verifier foo Foo::Verifier\n", + ' and returns the right outout'); + +# Test report. +($out, $err) = run_admin ('report', 'foo'); +is ($err, "unknown report type foo\n", 'Report requires a known report'); +is ($out, "new\n", ' and nothing was run'); +($out, $err) = run_admin ('report', 'owners', '%', '%'); +is ($err, '', 'Report succeeds for owners'); +is ($out, "new\nreport_owners % %\nkrb5 admin\@EXAMPLE.COM\n", + ' and returns the right output'); + +# Test error handling. +$Wallet::Admin::error = 1; +($out, $err) = run_admin ('destroy'); +is ($err, "some error\n", 'Error handling succeeds for destroy'); +is ($out, "new\n" + . 'This will delete all data in the wallet database.' + . ' Are you sure (N/y)? ' . "destroy\n", ' and calls the right methods'); +($out, $err) = run_admin ('initialize', 'rra@stanford.edu'); +is ($err, "some error\n", 'Error handling succeeds for initialize'); +is ($out, "new\ninitialize rra\@stanford.edu\n", + ' and calls the right methods'); +($out, $err) = run_admin ('list', 'objects'); +is ($err, "some error\n", 'Error handling succeeds for list objects'); +is ($out, "new\nlist_objects\n", ' and calls the right methods'); +($out, $err) = run_admin ('list', 'acls'); +is ($err, "some error\n", 'Error handling succeeds for list acls'); +is ($out, "new\nlist_acls\n", ' and calls the right methods'); +($out, $err) = run_admin ('register', 'object', 'foo', 'Foo::Object'); +is ($err, "some error\n", 'Error handling succeeds for register object'); +is ($out, "new\nregister_object foo Foo::Object\n", + ' and calls the right methods'); +($out, $err) = run_admin ('register', 'verifier', 'foo', 'Foo::Verifier'); +is ($err, "some error\n", 'Error handling succeeds for register verifier'); +is ($out, "new\nregister_verifier foo Foo::Verifier\n", + ' and calls the right methods'); +($out, $err) = run_admin ('report', 'owners', 'foo', 'bar'); +is ($err, "some error\n", 'Error handling succeeds for report owners'); +is ($out, "new\nreport_owners foo bar\n", ' and calls the right methods'); + +# Test empty lists. +$Wallet::Admin::error = 0; +$Wallet::Admin::empty = 1; +($out, $err) = run_admin ('list', 'objects'); +is ($err, '', 'list objects runs with an empty list with no errors'); +is ($out, "new\nlist_objects\n", ' and calls the right methods'); +($out, $err) = run_admin ('list', 'acls'); +is ($err, '', 'list acls runs with an empty list and no errors'); +is ($out, "new\nlist_acls\n", ' and calls the right methods'); +($out, $err) = run_admin ('report', 'owners', 'foo', 'bar'); +is ($err, '', 'report owners runs with an empty list and no errors'); +is ($out, "new\nreport_owners foo bar\n", ' and calls the right methods'); diff --git a/tests/server/admin-t.in b/tests/server/admin-t.in deleted file mode 100644 index 570dc52..0000000 --- a/tests/server/admin-t.in +++ /dev/null @@ -1,241 +0,0 @@ -#!/usr/bin/perl -w -# -# Tests for the wallet-admin dispatch code. -# -# Written by Russ Allbery -# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University -# -# See LICENSE for licensing terms. - -use strict; -use Test::More tests => 64; - -# Create a dummy class for Wallet::Admin that prints what method was called -# with its arguments and returns data for testing. -package Wallet::Admin; - -use vars qw($empty $error); -$error = 0; -$empty = 0; - -sub error { - if ($error) { - return "some error"; - } else { - return; - } -} - -sub new { - print "new\n"; - return bless ({}, 'Wallet::Admin'); -} - -sub destroy { - print "destroy\n"; - return if $error; - return 1; -} - -sub initialize { - shift; - print "initialize @_\n"; - return if $error; - return 1; -} - -sub list_objects { - print "list_objects\n"; - return if ($error or $empty); - return ([ keytab => 'host/windlord.stanford.edu' ], - [ file => 'unix-wallet-password' ]); -} - -sub list_acls { - print "list_acls\n"; - return if ($error or $empty); - return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]); -} - -sub register_object { - shift; - print "register_object @_\n"; - return if $error; - return 1; -} - -sub register_verifier { - shift; - print "register_verifier @_\n"; - return if $error; - return 1; -} - -sub report_owners { - shift; - print "report_owners @_\n"; - return if ($error or $empty); - return ([ krb5 => 'admin@EXAMPLE.COM' ]); -} - -# Back to the main package and the actual test suite. Lie about whether the -# Wallet::Admin package has already been loaded. -package main; -$INC{'Wallet/Admin.pm'} = 'FAKE'; -eval { do "$ENV{SOURCE}/../server/wallet-admin" }; - -# Run the wallet admin client. This fun hack takes advantage of the fact that -# the wallet admin client is written in Perl so that we can substitute our own -# Wallet::Admin class. -sub run_admin { - my (@args) = @_; - my $result = ''; - open (OUTPUT, '>', \$result) or die "cannot create output string: $!\n"; - select OUTPUT; - local $| = 1; - eval { command (@args) }; - my $error = $@; - select STDOUT; - return ($result, $error); -} - -# Now for the actual tests. First check for unknown commands. -my ($out, $err) = run_admin ('foo'); -is ($err, "unknown command foo\n", 'Unknown command'); -is ($out, "new\n", ' and nothing ran'); - -# Check too few and too many arguments for every command. -my %commands = (destroy => [0, 0], - initialize => [1, 1], - list => [1, 4], - register => [3, 3], - report => [1, -1]); -for my $command (sort keys %commands) { - my ($min, $max) = @{ $commands{$command} }; - if ($min > 0) { - ($out, $err) = run_admin ($command, ('foo') x ($min - 1)); - is ($err, "too few arguments to $command\n", - "Too few arguments for $command"); - is ($out, "new\n", ' and nothing ran'); - } - if ($max >= 0) { - ($out, $err) = run_admin ($command, ('foo') x ($max + 1)); - is ($err, "too many arguments to $command\n", - "Too many arguments for $command"); - is ($out, "new\n", ' and nothing ran'); - } -} - -# Test destroy. -my $answer = ''; -close STDIN; -open (STDIN, '<', \$answer) or die "cannot reopen standard input: $!\n"; -($out, $err) = run_admin ('destroy'); -is ($err, "Aborted\n", 'Destroy with no answer aborts'); -is ($out, "new\n" . - 'This will delete all data in the wallet database. Are you sure (N/y)? ', - ' and prints the right prompt'); -seek (STDIN, 0, 0); -$answer = 'n'; -($out, $err) = run_admin ('destroy'); -is ($err, "Aborted\n", 'Destroy with negative answer answer aborts'); -is ($out, "new\n" . - 'This will delete all data in the wallet database. Are you sure (N/y)? ', - ' and prints the right prompt'); -seek (STDIN, 0, 0); -$answer = 'y'; -($out, $err) = run_admin ('destroy'); -is ($err, '', 'Destroy succeeds with a positive answer'); -is ($out, "new\n" - . 'This will delete all data in the wallet database.' - . ' Are you sure (N/y)? ' . "destroy\n", ' and destroy was run'); -seek (STDIN, 0, 0); - -# Test initialize. -($out, $err) = run_admin ('initialize', 'rra'); -is ($err, "invalid admin principal rra\n", 'Initialize requires a principal'); -is ($out, "new\n", ' and nothing was run'); -($out, $err) = run_admin ('initialize', 'rra@stanford.edu'); -is ($err, '', 'Initialize succeeds with a principal'); -is ($out, "new\ninitialize rra\@stanford.edu\n", ' and runs the right code'); - -# Test list. -($out, $err) = run_admin ('list', 'foo'); -is ($err, "only objects or acls are supported for list\n", - 'List requires a known object'); -is ($out, "new\n", ' and nothing was run'); -($out, $err) = run_admin ('list', 'objects'); -is ($err, '', 'List succeeds for objects'); -is ($out, "new\nlist_objects\n" - . "keytab host/windlord.stanford.edu\nfile unix-wallet-password\n", - ' and returns the right output'); -($out, $err) = run_admin ('list', 'acls'); -is ($err, '', 'List succeeds for ACLs'); -is ($out, "new\nlist_acls\n" - . "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n", - ' and returns the right output'); - -# Test register. -($out, $err) = run_admin ('register', 'foo', 'foo', 'Foo::Bar'); -is ($err, "only object or verifier is supported for register\n", - 'Register requires object or verifier'); -is ($out, "new\n", ' and nothing was run'); -($out, $err) = run_admin ('register', 'object', 'foo', 'Foo::Object'); -is ($err, '', 'Register succeeds for object'); -is ($out, "new\nregister_object foo Foo::Object\n", - ' and returns the right outout'); -($out, $err) = run_admin ('register', 'verifier', 'foo', 'Foo::Verifier'); -is ($err, '', 'Register succeeds for verifier'); -is ($out, "new\nregister_verifier foo Foo::Verifier\n", - ' and returns the right outout'); - -# Test report. -($out, $err) = run_admin ('report', 'foo'); -is ($err, "unknown report type foo\n", 'Report requires a known report'); -is ($out, "new\n", ' and nothing was run'); -($out, $err) = run_admin ('report', 'owners', '%', '%'); -is ($err, '', 'Report succeeds for owners'); -is ($out, "new\nreport_owners % %\nkrb5 admin\@EXAMPLE.COM\n", - ' and returns the right output'); - -# Test error handling. -$Wallet::Admin::error = 1; -($out, $err) = run_admin ('destroy'); -is ($err, "some error\n", 'Error handling succeeds for destroy'); -is ($out, "new\n" - . 'This will delete all data in the wallet database.' - . ' Are you sure (N/y)? ' . "destroy\n", ' and calls the right methods'); -($out, $err) = run_admin ('initialize', 'rra@stanford.edu'); -is ($err, "some error\n", 'Error handling succeeds for initialize'); -is ($out, "new\ninitialize rra\@stanford.edu\n", - ' and calls the right methods'); -($out, $err) = run_admin ('list', 'objects'); -is ($err, "some error\n", 'Error handling succeeds for list objects'); -is ($out, "new\nlist_objects\n", ' and calls the right methods'); -($out, $err) = run_admin ('list', 'acls'); -is ($err, "some error\n", 'Error handling succeeds for list acls'); -is ($out, "new\nlist_acls\n", ' and calls the right methods'); -($out, $err) = run_admin ('register', 'object', 'foo', 'Foo::Object'); -is ($err, "some error\n", 'Error handling succeeds for register object'); -is ($out, "new\nregister_object foo Foo::Object\n", - ' and calls the right methods'); -($out, $err) = run_admin ('register', 'verifier', 'foo', 'Foo::Verifier'); -is ($err, "some error\n", 'Error handling succeeds for register verifier'); -is ($out, "new\nregister_verifier foo Foo::Verifier\n", - ' and calls the right methods'); -($out, $err) = run_admin ('report', 'owners', 'foo', 'bar'); -is ($err, "some error\n", 'Error handling succeeds for report owners'); -is ($out, "new\nreport_owners foo bar\n", ' and calls the right methods'); - -# Test empty lists. -$Wallet::Admin::error = 0; -$Wallet::Admin::empty = 1; -($out, $err) = run_admin ('list', 'objects'); -is ($err, '', 'list objects runs with an empty list with no errors'); -is ($out, "new\nlist_objects\n", ' and calls the right methods'); -($out, $err) = run_admin ('list', 'acls'); -is ($err, '', 'list acls runs with an empty list and no errors'); -is ($out, "new\nlist_acls\n", ' and calls the right methods'); -($out, $err) = run_admin ('report', 'owners', 'foo', 'bar'); -is ($err, '', 'report owners runs with an empty list and no errors'); -is ($out, "new\nreport_owners foo bar\n", ' and calls the right methods'); diff --git a/tests/server/backend-t b/tests/server/backend-t new file mode 100755 index 0000000..2fc6a53 --- /dev/null +++ b/tests/server/backend-t @@ -0,0 +1,502 @@ +#!/usr/bin/perl -w +# +# Tests for the wallet-backend dispatch code. +# +# Written by Russ Allbery +# Copyright 2006, 2007, 2008, 2009, 2010 +# Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use strict; +use Test::More tests => 1263; + +# Create a dummy class for Wallet::Server that prints what method was called +# with its arguments and returns data for testing. +package Wallet::Server; + +use vars qw($error $okay); +$error = 0; +$okay = 0; + +sub error { + if ($okay) { + $okay = 0; + return; + } else { + $error++; + return "error count $error"; + } +} + +sub new { shift; print "new @_\n"; return bless ({}, 'Wallet::Server') } +sub create { shift; print "create @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub destroy { shift; print "destroy @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub store { shift; print "store @_\n"; ($_[0] eq 'error') ? undef : 1 } + +sub acl_add + { shift; print "acl_add @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub acl_create + { shift; print "acl_create @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub acl_destroy + { shift; print "acl_destroy @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub acl_remove + { shift; print "acl_remove @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub acl_rename + { shift; print "acl_rename @_\n"; ($_[0] eq 'error') ? undef : 1 } + +sub acl_history { + shift; + print "acl_history @_\n"; + return if $_[0] eq 'error'; + return 'acl_history'; +} + +sub acl_show { + shift; + print "acl_show @_\n"; + return if $_[0] eq 'error'; + return 'acl_show'; +} + +sub flag_clear + { shift; print "flag_clear @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub flag_set + { shift; print "flag_set @_\n"; ($_[0] eq 'error') ? undef : 1 } + +sub acl { + shift; + print "acl @_\n"; + if ($_[0] eq 'error') { + return; + } elsif ($_[1] eq 'empty') { + $okay = 1; + return; + } else { + return 'acl'; + } +} + +sub attr { + shift; + print "attr @_\n"; + if ($_[0] eq 'error') { + return; + } elsif ($_[1] eq 'empty') { + $okay = 1; + return; + } elsif (@_ == 3) { + return ('attr1', 'attr2'); + } else { + return 'attr'; + } +} + +sub autocreate { + shift; + print "autocreate @_\n"; + return ($_[0] eq 'error') ? undef : 1 +} + +sub check { + shift; + print "check @_\n"; + if ($_[0] eq 'error') { + return; + } elsif ($_[1] eq 'empty') { + return 0; + } else { + return 1; + } +} + +sub expires { + shift; + print "expires @_\n"; + if ($_[0] eq 'error') { + return; + } elsif ($_[1] eq 'empty') { + $okay = 1; + return; + } else { + return 'expires'; + } +} + +sub get { + shift; + print "get @_\n"; + return if $_[0] eq 'error'; + return 'get'; +} + +sub history { + shift; + print "history @_\n"; + return if $_[0] eq 'error'; + return 'history'; +} + +sub owner { + shift; + print "owner @_\n"; + if ($_[0] eq 'error') { + return; + } elsif ($_[1] eq 'empty') { + $okay = 1; + return; + } else { + return 'owner'; + } +} + +sub show { + shift; + print "show @_\n"; + return if $_[0] eq 'error'; + return 'show'; +} + +# Back to the main package and the actual test suite. Lie about whether the +# Wallet::Server package has already been loaded. +package main; +$INC{'Wallet/Server.pm'} = 'FAKE'; +my $OUTPUT; +our $SYSLOG = \$OUTPUT; +eval { do "$ENV{SOURCE}/../server/wallet-backend" }; + +# Run the wallet backend. This fun hack takes advantage of the fact that the +# wallet backend is written in Perl so that we can substitute our own +# Wallet::Server class. +sub run_backend { + my (@args) = @_; + my $result = ''; + open (OUTPUT, '>', \$result) or die "cannot create output string: $!\n"; + select OUTPUT; + local $| = 1; + eval { command (@args) }; + my $error = $@; + select STDOUT; + return ($result, $error); +} + +# Now for the actual tests. First, check for lack of trace information. +my ($out, $err) = run_backend; +is ($err, "REMOTE_USER not set\n", 'REMOTE_USER required'); +is ($OUTPUT, "error: REMOTE_USER not set\n", ' and syslog correct'); +$ENV{REMOTE_USER} = 'admin'; +($out, $err) = run_backend; +is ($err, "neither REMOTE_HOST nor REMOTE_ADDR set\n", + 'REMOTE_HOST or _ADDR required'); +is ($OUTPUT, "error for admin: neither REMOTE_HOST nor REMOTE_ADDR set\n", + ' and syslog correct'); +$ENV{REMOTE_ADDR} = '1.2.3.4'; +my $new = 'new admin 1.2.3.4'; + +# Check unknown commands. +($out, $err) = run_backend ('foo'); +is ($err, "unknown command foo\n", 'Unknown command'); +is ($OUTPUT, "error for admin (1.2.3.4): unknown command foo\n", + ' and syslog correct'); +is ($out, "$new\n", ' and nothing ran'); +($out, $err) = run_backend ('acl', 'foo'); +is ($err, "unknown command acl foo\n", 'Unknown ACL command'); +is ($OUTPUT, "error for admin (1.2.3.4): unknown command acl foo\n", + ' and syslog correct'); +is ($out, "$new\n", ' and nothing ran'); +($out, $err) = run_backend ('flag', 'foo', 'service', 'foo', 'foo'); +is ($err, "unknown command flag foo\n", 'Unknown flag command'); +is ($OUTPUT, "error for admin (1.2.3.4): unknown command flag foo\n", + ' and syslog correct'); +is ($out, "$new\n", ' and nothing ran'); + +# Check too few, too many, and bad arguments for every command. +my %commands = (autocreate => [2, 2], + check => [2, 2], + create => [2, 2], + destroy => [2, 2], + expires => [2, 4], + get => [2, 2], + getacl => [3, 3], + getattr => [3, 3], + history => [2, 2], + owner => [2, 3], + setacl => [4, 4], + setattr => [4, 9], + show => [2, 2], + store => [3, 3]); +my %acl_commands = (add => [3, 3], + create => [1, 1], + destroy => [1, 1], + history => [1, 1], + remove => [3, 3], + rename => [2, 2], + show => [1, 1]); +my %flag_commands = (clear => [3, 3], + set => [3, 3]); +for my $command (sort keys %commands) { + my ($min, $max) = @{ $commands{$command} }; + ($out, $err) = run_backend ($command, ('foo') x ($min - 1)); + is ($err, "insufficient arguments\n", "Too few arguments for $command"); + is ($OUTPUT, "error for admin (1.2.3.4): insufficient arguments\n", + ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + unless ($max >= 9) { + ($out, $err) = run_backend ($command, ('foo') x ($max + 1)); + is ($err, "too many arguments\n", "Too many arguments for $command"); + is ($OUTPUT, "error for admin (1.2.3.4): too many arguments\n", + ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + } + my @base = ('foobar') x $max; + for my $arg (0 .. ($max - 1)) { + my @args = @base; + $args[$arg] = 'foo;bar'; + ($out, $err) = run_backend ($command, @args); + if ($command eq 'store' and $arg == 2) { + is ($err, '', 'Store allows any characters'); + is ($OUTPUT, "command $command @args[0,1] from admin (1.2.3.4)" + . " succeeded\n", ' and success logged'); + is ($out, "$new\nstore foobar foobar foo;bar\n", + ' and calls the right method'); + } else { + is ($err, "invalid characters in argument: foo;bar\n", + "Invalid arguments for $command $arg"); + is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" + . " argument: foo;bar\n", ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + } + } +} +for my $command (sort keys %acl_commands) { + my ($min, $max) = @{ $acl_commands{$command} }; + ($out, $err) = run_backend ('acl', $command, ('foo') x ($min - 1)); + is ($err, "insufficient arguments\n", + "Too few arguments for acl $command"); + is ($OUTPUT, "error for admin (1.2.3.4): insufficient arguments\n", + ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + ($out, $err) = run_backend ('acl', $command, ('foo') x ($max + 1)); + is ($err, "too many arguments\n", "Too many arguments for acl $command"); + is ($OUTPUT, "error for admin (1.2.3.4): too many arguments\n", + ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + my @base = ('foobar') x $max; + for my $arg (0 .. ($max - 1)) { + my @args = @base; + $args[$arg] = 'foo;bar'; + ($out, $err) = run_backend ('acl', $command, @args); + is ($err, "invalid characters in argument: foo;bar\n", + "Invalid arguments for acl $command $arg"); + is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" + . " argument: foo;bar\n", ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + } +} +for my $command (sort keys %flag_commands) { + my ($min, $max) = @{ $flag_commands{$command} }; + ($out, $err) = run_backend ('flag', $command, ('foo') x ($min - 1)); + is ($err, "insufficient arguments\n", + "Too few arguments for flag $command"); + is ($OUTPUT, "error for admin (1.2.3.4): insufficient arguments\n", + ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + ($out, $err) = run_backend ('flag', $command, ('foo') x ($max + 1)); + is ($err, "too many arguments\n", "Too many arguments for flag $command"); + is ($OUTPUT, "error for admin (1.2.3.4): too many arguments\n", + ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + my @base = ('foobar') x $max; + for my $arg (0 .. ($max - 1)) { + my @args = @base; + $args[$arg] = 'foo;bar'; + ($out, $err) = run_backend ('flag', $command, @args); + is ($err, "invalid characters in argument: foo;bar\n", + "Invalid arguments for flag $command $arg"); + is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" + . " argument: foo;bar\n", ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + } +} + +# Now, test that we ran the right functions and passed the correct arguments. +my $error = 1; +for my $command (qw/autocreate create destroy setacl setattr store/) { + my $method = { setacl => 'acl', setattr => 'attr' }->{$command}; + $method ||= $command; + my @extra = ('foo') x ($commands{$command}[0] - 2); + my $extra = @extra ? join (' ', '', @extra) : ''; + ($out, $err) = run_backend ($command, 'type', 'name', @extra); + my $ran; + if ($command eq 'store') { + $ran = "$command type name"; + } else { + $ran = "$command type name" . (@extra ? " @extra" : ''); + } + is ($err, '', "Command $command ran with no errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + is ($out, "$new\n$method type name$extra\n", + ' and ran the right method'); + ($out, $err) = run_backend ($command, 'error', 'name', @extra); + if ($command eq 'store') { + $ran = "$command error name"; + } else { + $ran = "$command error name" . (@extra ? " @extra" : ''); + } + is ($err, "error count $error\n", "Command $command ran with errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count" + . " $error\n", ' and syslog correct'); + is ($out, "$new\n$method error name$extra\n", + ' and ran the right method'); + $error++; +} +for my $command (qw/check expires get getacl getattr history owner show/) { + my $method = { getacl => 'acl', getattr => 'attr' }->{$command}; + $method ||= $command; + my @extra = ('foo') x ($commands{$command}[0] - 2); + my $extra = @extra ? join (' ', '', @extra) : ''; + ($out, $err) = run_backend ($command, 'type', 'name', @extra); + my $ran = "$command type name" . (@extra ? " @extra" : ''); + is ($err, '', "Command $command ran with no errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + if ($command eq 'getattr') { + is ($out, "$new\n$method type name$extra\nattr1\nattr2\n", + ' and ran the right method with output'); + } elsif ($command eq 'check') { + is ($out, "$new\n$method type name$extra\nyes\n", + ' and ran the right method with output'); + } else { + my $newline = ($command =~ /^(get|history|show)\z/) ? '' : "\n"; + is ($out, "$new\n$method type name$extra\n$method$newline", + ' and ran the right method with output'); + } + if ($command eq 'expires' or $command eq 'owner') { + ($out, $err) = run_backend ($command, 'type', 'name', @extra, 'foo'); + my $ran = "$command type name" . (@extra ? " @extra" : '') . ' foo'; + is ($err, '', "Command $command ran with no errors (setting)"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + is ($out, "$new\n$method type name$extra foo\n", + ' and ran the right method'); + } + if ($command eq 'expires' or $command eq 'getacl' or $command eq 'owner') { + ($out, $err) = run_backend ($command, 'type', 'empty', @extra); + my $ran = "$command type empty" . (@extra ? " @extra" : ''); + is ($err, '', "Command $command ran with no errors (empty)"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + my $desc; + if ($command eq 'expires') { $desc = 'expiration' } + elsif ($command eq 'getacl') { $desc = 'ACL' } + elsif ($command eq 'owner') { $desc = 'owner' } + is ($out, "$new\n$method type empty$extra\nNo $desc set\n", + ' and ran the right method with output'); + $error++; + } elsif ($command eq 'getattr') { + ($out, $err) = run_backend ($command, 'type', 'empty', @extra); + my $ran = "$command type empty" . (@extra ? " @extra" : ''); + is ($err, '', "Command $command ran with no errors (empty)"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + is ($out, "$new\n$method type empty$extra\n", + ' and ran the right method with output'); + $error++; + } elsif ($command eq 'check') { + ($out, $err) = run_backend ($command, 'type', 'empty', @extra); + my $ran = "$command type empty" . (@extra ? " @extra" : ''); + is ($err, '', "Command $command ran with no errors (empty)"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + is ($out, "$new\n$method type empty$extra\nno\n", + ' and ran the right method with output'); + } + ($out, $err) = run_backend ($command, 'error', 'name', @extra); + my $ran = "$command error name" . (@extra ? " @extra" : ''); + is ($err, "error count $error\n", "Command $command ran with errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count" + . " $error\n", ' and syslog correct'); + is ($out, "$new\n$method error name$extra\n", + ' and ran the right method'); + $error++; +} +for my $command (sort keys %acl_commands) { + my @extra = ('foo') x ($acl_commands{$command}[0] - 1); + my $extra = @extra ? join (' ', '', @extra) : ''; + ($out, $err) = run_backend ('acl', $command, 'name', @extra); + my $ran = "acl $command name" . (@extra ? " @extra" : ''); + is ($err, '', "Command acl $command ran with no errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + my $expected; + if ($command eq 'show') { + $expected = "$new\nacl_$command name$extra\nacl_show"; + } elsif ($command eq 'history') { + $expected = "$new\nacl_$command name$extra\nacl_history"; + } else { + $expected = "$new\nacl_$command name$extra\n"; + } + is ($out, $expected, ' and ran the right method'); + ($out, $err) = run_backend ('acl', $command, 'error', @extra); + $ran = "acl $command error" . (@extra ? " @extra" : ''); + is ($err, "error count $error\n", "Command acl $command ran with errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count" + . " $error\n", ' and syslog correct'); + is ($out, "$new\nacl_$command error$extra\n", + ' and ran the right method'); + $error++; +} +for my $command (sort keys %flag_commands) { + my @extra = ('foo') x ($flag_commands{$command}[0] - 2); + my $extra = @extra ? join (' ', '', @extra) : ''; + ($out, $err) = run_backend ('flag', $command, 'type', 'name', @extra); + my $ran = "flag $command type name" . (@extra ? " @extra" : ''); + is ($err, '', "Command flag $command ran with no errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + is ($out, "$new\nflag_$command type name$extra\n", + ' and ran the right method'); + ($out, $err) = run_backend ('flag', $command, 'error', 'name', @extra); + $ran = "flag $command error name" . (@extra ? " @extra" : ''); + is ($err, "error count $error\n", + "Command flag $command ran with errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count" + . " $error\n", ' and syslog correct'); + is ($out, "$new\nflag_$command error name$extra\n", + ' and ran the right method'); + $error++; +} + +# Almost done. All that remains is to test the robustness of the bad +# character checks against every possible character and test permitting the +# empty argument. +($out, $err) = run_backend ('show', 'type', ''); +is ($err, '', 'Allowed the empty argument'); +is ($OUTPUT, "command show type from admin (1.2.3.4) succeeded\n", + ' and success logged'); +my $ok = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_/.@-'; +($out, $err) = run_backend ('show', 'type', $ok); +is ($err, '', 'Allowed all valid characters'); +is ($OUTPUT, "command show type $ok from admin (1.2.3.4) succeeded\n", + ' and success logged'); +is ($out, "$new\nshow type $ok\nshow", ' and returned the right output'); +for my $n (0 .. 255) { + my $c = chr ($n); + my $name = $ok . $c; + ($out, $err) = run_backend ('show', 'type', $name); + if (index ($ok, $c) == -1) { + is ($err, "invalid characters in argument: $name\n", + "Rejected invalid character $n"); + my $stripped = $name; + $stripped =~ s/[^\x20-\x7e]/_/g; + is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" + . " argument: $stripped\n", ' and syslog correct'); + is ($out, "$new\n", ' and did nothing'); + } else { + is ($err, '', "Accepted valid character $n"); + is ($OUTPUT, "command show type $name from admin (1.2.3.4)" + . " succeeded\n", ' and success logged'); + is ($out, "$new\nshow type $name\nshow", ' and ran the method'); + } +} diff --git a/tests/server/backend-t.in b/tests/server/backend-t.in deleted file mode 100644 index 2fc6a53..0000000 --- a/tests/server/backend-t.in +++ /dev/null @@ -1,502 +0,0 @@ -#!/usr/bin/perl -w -# -# Tests for the wallet-backend dispatch code. -# -# Written by Russ Allbery -# Copyright 2006, 2007, 2008, 2009, 2010 -# Board of Trustees, Leland Stanford Jr. University -# -# See LICENSE for licensing terms. - -use strict; -use Test::More tests => 1263; - -# Create a dummy class for Wallet::Server that prints what method was called -# with its arguments and returns data for testing. -package Wallet::Server; - -use vars qw($error $okay); -$error = 0; -$okay = 0; - -sub error { - if ($okay) { - $okay = 0; - return; - } else { - $error++; - return "error count $error"; - } -} - -sub new { shift; print "new @_\n"; return bless ({}, 'Wallet::Server') } -sub create { shift; print "create @_\n"; ($_[0] eq 'error') ? undef : 1 } -sub destroy { shift; print "destroy @_\n"; ($_[0] eq 'error') ? undef : 1 } -sub store { shift; print "store @_\n"; ($_[0] eq 'error') ? undef : 1 } - -sub acl_add - { shift; print "acl_add @_\n"; ($_[0] eq 'error') ? undef : 1 } -sub acl_create - { shift; print "acl_create @_\n"; ($_[0] eq 'error') ? undef : 1 } -sub acl_destroy - { shift; print "acl_destroy @_\n"; ($_[0] eq 'error') ? undef : 1 } -sub acl_remove - { shift; print "acl_remove @_\n"; ($_[0] eq 'error') ? undef : 1 } -sub acl_rename - { shift; print "acl_rename @_\n"; ($_[0] eq 'error') ? undef : 1 } - -sub acl_history { - shift; - print "acl_history @_\n"; - return if $_[0] eq 'error'; - return 'acl_history'; -} - -sub acl_show { - shift; - print "acl_show @_\n"; - return if $_[0] eq 'error'; - return 'acl_show'; -} - -sub flag_clear - { shift; print "flag_clear @_\n"; ($_[0] eq 'error') ? undef : 1 } -sub flag_set - { shift; print "flag_set @_\n"; ($_[0] eq 'error') ? undef : 1 } - -sub acl { - shift; - print "acl @_\n"; - if ($_[0] eq 'error') { - return; - } elsif ($_[1] eq 'empty') { - $okay = 1; - return; - } else { - return 'acl'; - } -} - -sub attr { - shift; - print "attr @_\n"; - if ($_[0] eq 'error') { - return; - } elsif ($_[1] eq 'empty') { - $okay = 1; - return; - } elsif (@_ == 3) { - return ('attr1', 'attr2'); - } else { - return 'attr'; - } -} - -sub autocreate { - shift; - print "autocreate @_\n"; - return ($_[0] eq 'error') ? undef : 1 -} - -sub check { - shift; - print "check @_\n"; - if ($_[0] eq 'error') { - return; - } elsif ($_[1] eq 'empty') { - return 0; - } else { - return 1; - } -} - -sub expires { - shift; - print "expires @_\n"; - if ($_[0] eq 'error') { - return; - } elsif ($_[1] eq 'empty') { - $okay = 1; - return; - } else { - return 'expires'; - } -} - -sub get { - shift; - print "get @_\n"; - return if $_[0] eq 'error'; - return 'get'; -} - -sub history { - shift; - print "history @_\n"; - return if $_[0] eq 'error'; - return 'history'; -} - -sub owner { - shift; - print "owner @_\n"; - if ($_[0] eq 'error') { - return; - } elsif ($_[1] eq 'empty') { - $okay = 1; - return; - } else { - return 'owner'; - } -} - -sub show { - shift; - print "show @_\n"; - return if $_[0] eq 'error'; - return 'show'; -} - -# Back to the main package and the actual test suite. Lie about whether the -# Wallet::Server package has already been loaded. -package main; -$INC{'Wallet/Server.pm'} = 'FAKE'; -my $OUTPUT; -our $SYSLOG = \$OUTPUT; -eval { do "$ENV{SOURCE}/../server/wallet-backend" }; - -# Run the wallet backend. This fun hack takes advantage of the fact that the -# wallet backend is written in Perl so that we can substitute our own -# Wallet::Server class. -sub run_backend { - my (@args) = @_; - my $result = ''; - open (OUTPUT, '>', \$result) or die "cannot create output string: $!\n"; - select OUTPUT; - local $| = 1; - eval { command (@args) }; - my $error = $@; - select STDOUT; - return ($result, $error); -} - -# Now for the actual tests. First, check for lack of trace information. -my ($out, $err) = run_backend; -is ($err, "REMOTE_USER not set\n", 'REMOTE_USER required'); -is ($OUTPUT, "error: REMOTE_USER not set\n", ' and syslog correct'); -$ENV{REMOTE_USER} = 'admin'; -($out, $err) = run_backend; -is ($err, "neither REMOTE_HOST nor REMOTE_ADDR set\n", - 'REMOTE_HOST or _ADDR required'); -is ($OUTPUT, "error for admin: neither REMOTE_HOST nor REMOTE_ADDR set\n", - ' and syslog correct'); -$ENV{REMOTE_ADDR} = '1.2.3.4'; -my $new = 'new admin 1.2.3.4'; - -# Check unknown commands. -($out, $err) = run_backend ('foo'); -is ($err, "unknown command foo\n", 'Unknown command'); -is ($OUTPUT, "error for admin (1.2.3.4): unknown command foo\n", - ' and syslog correct'); -is ($out, "$new\n", ' and nothing ran'); -($out, $err) = run_backend ('acl', 'foo'); -is ($err, "unknown command acl foo\n", 'Unknown ACL command'); -is ($OUTPUT, "error for admin (1.2.3.4): unknown command acl foo\n", - ' and syslog correct'); -is ($out, "$new\n", ' and nothing ran'); -($out, $err) = run_backend ('flag', 'foo', 'service', 'foo', 'foo'); -is ($err, "unknown command flag foo\n", 'Unknown flag command'); -is ($OUTPUT, "error for admin (1.2.3.4): unknown command flag foo\n", - ' and syslog correct'); -is ($out, "$new\n", ' and nothing ran'); - -# Check too few, too many, and bad arguments for every command. -my %commands = (autocreate => [2, 2], - check => [2, 2], - create => [2, 2], - destroy => [2, 2], - expires => [2, 4], - get => [2, 2], - getacl => [3, 3], - getattr => [3, 3], - history => [2, 2], - owner => [2, 3], - setacl => [4, 4], - setattr => [4, 9], - show => [2, 2], - store => [3, 3]); -my %acl_commands = (add => [3, 3], - create => [1, 1], - destroy => [1, 1], - history => [1, 1], - remove => [3, 3], - rename => [2, 2], - show => [1, 1]); -my %flag_commands = (clear => [3, 3], - set => [3, 3]); -for my $command (sort keys %commands) { - my ($min, $max) = @{ $commands{$command} }; - ($out, $err) = run_backend ($command, ('foo') x ($min - 1)); - is ($err, "insufficient arguments\n", "Too few arguments for $command"); - is ($OUTPUT, "error for admin (1.2.3.4): insufficient arguments\n", - ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); - unless ($max >= 9) { - ($out, $err) = run_backend ($command, ('foo') x ($max + 1)); - is ($err, "too many arguments\n", "Too many arguments for $command"); - is ($OUTPUT, "error for admin (1.2.3.4): too many arguments\n", - ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); - } - my @base = ('foobar') x $max; - for my $arg (0 .. ($max - 1)) { - my @args = @base; - $args[$arg] = 'foo;bar'; - ($out, $err) = run_backend ($command, @args); - if ($command eq 'store' and $arg == 2) { - is ($err, '', 'Store allows any characters'); - is ($OUTPUT, "command $command @args[0,1] from admin (1.2.3.4)" - . " succeeded\n", ' and success logged'); - is ($out, "$new\nstore foobar foobar foo;bar\n", - ' and calls the right method'); - } else { - is ($err, "invalid characters in argument: foo;bar\n", - "Invalid arguments for $command $arg"); - is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" - . " argument: foo;bar\n", ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); - } - } -} -for my $command (sort keys %acl_commands) { - my ($min, $max) = @{ $acl_commands{$command} }; - ($out, $err) = run_backend ('acl', $command, ('foo') x ($min - 1)); - is ($err, "insufficient arguments\n", - "Too few arguments for acl $command"); - is ($OUTPUT, "error for admin (1.2.3.4): insufficient arguments\n", - ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); - ($out, $err) = run_backend ('acl', $command, ('foo') x ($max + 1)); - is ($err, "too many arguments\n", "Too many arguments for acl $command"); - is ($OUTPUT, "error for admin (1.2.3.4): too many arguments\n", - ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); - my @base = ('foobar') x $max; - for my $arg (0 .. ($max - 1)) { - my @args = @base; - $args[$arg] = 'foo;bar'; - ($out, $err) = run_backend ('acl', $command, @args); - is ($err, "invalid characters in argument: foo;bar\n", - "Invalid arguments for acl $command $arg"); - is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" - . " argument: foo;bar\n", ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); - } -} -for my $command (sort keys %flag_commands) { - my ($min, $max) = @{ $flag_commands{$command} }; - ($out, $err) = run_backend ('flag', $command, ('foo') x ($min - 1)); - is ($err, "insufficient arguments\n", - "Too few arguments for flag $command"); - is ($OUTPUT, "error for admin (1.2.3.4): insufficient arguments\n", - ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); - ($out, $err) = run_backend ('flag', $command, ('foo') x ($max + 1)); - is ($err, "too many arguments\n", "Too many arguments for flag $command"); - is ($OUTPUT, "error for admin (1.2.3.4): too many arguments\n", - ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); - my @base = ('foobar') x $max; - for my $arg (0 .. ($max - 1)) { - my @args = @base; - $args[$arg] = 'foo;bar'; - ($out, $err) = run_backend ('flag', $command, @args); - is ($err, "invalid characters in argument: foo;bar\n", - "Invalid arguments for flag $command $arg"); - is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" - . " argument: foo;bar\n", ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); - } -} - -# Now, test that we ran the right functions and passed the correct arguments. -my $error = 1; -for my $command (qw/autocreate create destroy setacl setattr store/) { - my $method = { setacl => 'acl', setattr => 'attr' }->{$command}; - $method ||= $command; - my @extra = ('foo') x ($commands{$command}[0] - 2); - my $extra = @extra ? join (' ', '', @extra) : ''; - ($out, $err) = run_backend ($command, 'type', 'name', @extra); - my $ran; - if ($command eq 'store') { - $ran = "$command type name"; - } else { - $ran = "$command type name" . (@extra ? " @extra" : ''); - } - is ($err, '', "Command $command ran with no errors"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", - ' and success logged'); - is ($out, "$new\n$method type name$extra\n", - ' and ran the right method'); - ($out, $err) = run_backend ($command, 'error', 'name', @extra); - if ($command eq 'store') { - $ran = "$command error name"; - } else { - $ran = "$command error name" . (@extra ? " @extra" : ''); - } - is ($err, "error count $error\n", "Command $command ran with errors"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count" - . " $error\n", ' and syslog correct'); - is ($out, "$new\n$method error name$extra\n", - ' and ran the right method'); - $error++; -} -for my $command (qw/check expires get getacl getattr history owner show/) { - my $method = { getacl => 'acl', getattr => 'attr' }->{$command}; - $method ||= $command; - my @extra = ('foo') x ($commands{$command}[0] - 2); - my $extra = @extra ? join (' ', '', @extra) : ''; - ($out, $err) = run_backend ($command, 'type', 'name', @extra); - my $ran = "$command type name" . (@extra ? " @extra" : ''); - is ($err, '', "Command $command ran with no errors"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", - ' and success logged'); - if ($command eq 'getattr') { - is ($out, "$new\n$method type name$extra\nattr1\nattr2\n", - ' and ran the right method with output'); - } elsif ($command eq 'check') { - is ($out, "$new\n$method type name$extra\nyes\n", - ' and ran the right method with output'); - } else { - my $newline = ($command =~ /^(get|history|show)\z/) ? '' : "\n"; - is ($out, "$new\n$method type name$extra\n$method$newline", - ' and ran the right method with output'); - } - if ($command eq 'expires' or $command eq 'owner') { - ($out, $err) = run_backend ($command, 'type', 'name', @extra, 'foo'); - my $ran = "$command type name" . (@extra ? " @extra" : '') . ' foo'; - is ($err, '', "Command $command ran with no errors (setting)"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", - ' and success logged'); - is ($out, "$new\n$method type name$extra foo\n", - ' and ran the right method'); - } - if ($command eq 'expires' or $command eq 'getacl' or $command eq 'owner') { - ($out, $err) = run_backend ($command, 'type', 'empty', @extra); - my $ran = "$command type empty" . (@extra ? " @extra" : ''); - is ($err, '', "Command $command ran with no errors (empty)"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", - ' and success logged'); - my $desc; - if ($command eq 'expires') { $desc = 'expiration' } - elsif ($command eq 'getacl') { $desc = 'ACL' } - elsif ($command eq 'owner') { $desc = 'owner' } - is ($out, "$new\n$method type empty$extra\nNo $desc set\n", - ' and ran the right method with output'); - $error++; - } elsif ($command eq 'getattr') { - ($out, $err) = run_backend ($command, 'type', 'empty', @extra); - my $ran = "$command type empty" . (@extra ? " @extra" : ''); - is ($err, '', "Command $command ran with no errors (empty)"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", - ' and success logged'); - is ($out, "$new\n$method type empty$extra\n", - ' and ran the right method with output'); - $error++; - } elsif ($command eq 'check') { - ($out, $err) = run_backend ($command, 'type', 'empty', @extra); - my $ran = "$command type empty" . (@extra ? " @extra" : ''); - is ($err, '', "Command $command ran with no errors (empty)"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", - ' and success logged'); - is ($out, "$new\n$method type empty$extra\nno\n", - ' and ran the right method with output'); - } - ($out, $err) = run_backend ($command, 'error', 'name', @extra); - my $ran = "$command error name" . (@extra ? " @extra" : ''); - is ($err, "error count $error\n", "Command $command ran with errors"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count" - . " $error\n", ' and syslog correct'); - is ($out, "$new\n$method error name$extra\n", - ' and ran the right method'); - $error++; -} -for my $command (sort keys %acl_commands) { - my @extra = ('foo') x ($acl_commands{$command}[0] - 1); - my $extra = @extra ? join (' ', '', @extra) : ''; - ($out, $err) = run_backend ('acl', $command, 'name', @extra); - my $ran = "acl $command name" . (@extra ? " @extra" : ''); - is ($err, '', "Command acl $command ran with no errors"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", - ' and success logged'); - my $expected; - if ($command eq 'show') { - $expected = "$new\nacl_$command name$extra\nacl_show"; - } elsif ($command eq 'history') { - $expected = "$new\nacl_$command name$extra\nacl_history"; - } else { - $expected = "$new\nacl_$command name$extra\n"; - } - is ($out, $expected, ' and ran the right method'); - ($out, $err) = run_backend ('acl', $command, 'error', @extra); - $ran = "acl $command error" . (@extra ? " @extra" : ''); - is ($err, "error count $error\n", "Command acl $command ran with errors"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count" - . " $error\n", ' and syslog correct'); - is ($out, "$new\nacl_$command error$extra\n", - ' and ran the right method'); - $error++; -} -for my $command (sort keys %flag_commands) { - my @extra = ('foo') x ($flag_commands{$command}[0] - 2); - my $extra = @extra ? join (' ', '', @extra) : ''; - ($out, $err) = run_backend ('flag', $command, 'type', 'name', @extra); - my $ran = "flag $command type name" . (@extra ? " @extra" : ''); - is ($err, '', "Command flag $command ran with no errors"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", - ' and success logged'); - is ($out, "$new\nflag_$command type name$extra\n", - ' and ran the right method'); - ($out, $err) = run_backend ('flag', $command, 'error', 'name', @extra); - $ran = "flag $command error name" . (@extra ? " @extra" : ''); - is ($err, "error count $error\n", - "Command flag $command ran with errors"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count" - . " $error\n", ' and syslog correct'); - is ($out, "$new\nflag_$command error name$extra\n", - ' and ran the right method'); - $error++; -} - -# Almost done. All that remains is to test the robustness of the bad -# character checks against every possible character and test permitting the -# empty argument. -($out, $err) = run_backend ('show', 'type', ''); -is ($err, '', 'Allowed the empty argument'); -is ($OUTPUT, "command show type from admin (1.2.3.4) succeeded\n", - ' and success logged'); -my $ok = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_/.@-'; -($out, $err) = run_backend ('show', 'type', $ok); -is ($err, '', 'Allowed all valid characters'); -is ($OUTPUT, "command show type $ok from admin (1.2.3.4) succeeded\n", - ' and success logged'); -is ($out, "$new\nshow type $ok\nshow", ' and returned the right output'); -for my $n (0 .. 255) { - my $c = chr ($n); - my $name = $ok . $c; - ($out, $err) = run_backend ('show', 'type', $name); - if (index ($ok, $c) == -1) { - is ($err, "invalid characters in argument: $name\n", - "Rejected invalid character $n"); - my $stripped = $name; - $stripped =~ s/[^\x20-\x7e]/_/g; - is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" - . " argument: $stripped\n", ' and syslog correct'); - is ($out, "$new\n", ' and did nothing'); - } else { - is ($err, '', "Accepted valid character $n"); - is ($OUTPUT, "command show type $name from admin (1.2.3.4)" - . " succeeded\n", ' and success logged'); - is ($out, "$new\nshow type $name\nshow", ' and ran the method'); - } -} diff --git a/tests/server/keytab-t b/tests/server/keytab-t new file mode 100755 index 0000000..2a0ceed --- /dev/null +++ b/tests/server/keytab-t @@ -0,0 +1,88 @@ +#!/usr/bin/perl -w +# +# Tests for the keytab-backend dispatch code. +# +# Written by Russ Allbery +# Copyright 2006, 2007, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use strict; +use vars qw($CONFIG $KADMIN $SYSLOG $TMP); + +use Test::More tests => 63; + +# Load the keytab-backend code and override various settings. +my $OUTPUT; +$SYSLOG = \$OUTPUT; +eval { do "$ENV{SOURCE}/../server/keytab-backend" }; +$CONFIG = "$ENV{SOURCE}/data/allow-extract"; +$KADMIN = "$ENV{SOURCE}/data/fake-kadmin"; +$TMP = '.'; + +# Run the keytab backend. +sub run_backend { + my (@args) = @_; + my $result = ''; + open (OUTPUT, '>', \$result) or die "cannot create output string: $!\n"; + select OUTPUT; + local $| = 1; + eval { download (@args) }; + my $error = $@; + select STDOUT; + return ($result, $error); +} + +# The actual tests. +$ENV{REMOTE_USER} = 'admin'; +my ($out, $err) = run_backend (); +is ($err, "keytab-backend: invalid arguments: \n", 'Fails with no arguments'); +is ($OUTPUT, "invalid arguments: \n", ' and syslog matches'); +is ($out, '', ' and produces no output'); +($out, $err) = run_backend ('foo', 'bar', 'baz'); +is ($err, "keytab-backend: invalid arguments: foo bar baz\n", + 'Fails with three arguments'); +is ($OUTPUT, "invalid arguments: foo bar baz\n", ' and syslog matches'); +is ($out, '', ' and produces no output'); +for my $bad (qw{service service\*@example =@example host/foo+bar@example + rcmd.foo@EXAMPLE host/foo/bar@EXAMPLE /bar@EXAMPLE.NET + bar/@EXAMPLE.NET bar/bar@}) { + ($out, $err) = run_backend ('keytab', $bad); + is ($err, "keytab-backend: bad principal name $bad\n", + "Invalid principal $bad"); + is ($OUTPUT, "bad principal name $bad\n", ' and syslog matches'); + is ($out, '', ' and produces no output'); +} +for my $bad (qw{service/foo@EXAMPLE.ORGA bar@EXAMPLE.NET + host/example.net@EXAMPLE.ORG aservice/foo@EXAMPLE.ORG}) { + ($out, $err) = run_backend ('keytab', $bad); + is ($err, + "keytab-backend: permission denied: admin may not retrieve $bad\n", + "Permission denied for $bad"); + is ($OUTPUT, "permission denied: admin may not retrieve $bad\n", + ' and syslog matches'); + is ($out, '', ' and produces no output'); +} +for my $good (qw{service/foo@EXAMPLE.ORG foo/bar@EXAMPLE.NET + host/example.org@EXAMPLE.ORG}) { + ($out, $err) = run_backend ($good); + is ($err, '', "Success for good keytab $good"); + is ($out, "$good\n", ' and the right output'); + is ($OUTPUT, "keytab $good retrieved by admin\n", ' and syslog is right'); + ok (! -f "$TMP/keytab$$", ' and the file is gone'); +} +($out, $err) = run_backend ('keytab', 'error@EXAMPLE.ORG'); +is ($err, "keytab-backend: retrieve of error\@EXAMPLE.ORG failed for" + . " admin: kadmin.local exited with status 1\n", + 'Good error on kadmin failure'); +is ($OUTPUT, "retrieve of error\@EXAMPLE.ORG failed for admin: kadmin.local" + . " exited with status 1\n", ' and syslog matches'); +is ($out, '', ' and no output'); + +# Test a configuration failure. +$CONFIG = '/path/to/bad/file'; +($out, $err) = run_backend ('get', 'service/foo@EXAMPLE.ORG'); +like ($err, qr{^keytab-backend: cannot open /path/to/bad/file: }, + 'Fails with bad configuration file'); +like ($OUTPUT, qr{^cannot open /path/to/bad/file: }, ' and syslog matches'); +is ($out, '', ' and produces no output'); diff --git a/tests/server/keytab-t.in b/tests/server/keytab-t.in deleted file mode 100644 index 2a0ceed..0000000 --- a/tests/server/keytab-t.in +++ /dev/null @@ -1,88 +0,0 @@ -#!/usr/bin/perl -w -# -# Tests for the keytab-backend dispatch code. -# -# Written by Russ Allbery -# Copyright 2006, 2007, 2010 Board of Trustees, Leland Stanford Jr. University -# -# See LICENSE for licensing terms. - -use strict; -use vars qw($CONFIG $KADMIN $SYSLOG $TMP); - -use Test::More tests => 63; - -# Load the keytab-backend code and override various settings. -my $OUTPUT; -$SYSLOG = \$OUTPUT; -eval { do "$ENV{SOURCE}/../server/keytab-backend" }; -$CONFIG = "$ENV{SOURCE}/data/allow-extract"; -$KADMIN = "$ENV{SOURCE}/data/fake-kadmin"; -$TMP = '.'; - -# Run the keytab backend. -sub run_backend { - my (@args) = @_; - my $result = ''; - open (OUTPUT, '>', \$result) or die "cannot create output string: $!\n"; - select OUTPUT; - local $| = 1; - eval { download (@args) }; - my $error = $@; - select STDOUT; - return ($result, $error); -} - -# The actual tests. -$ENV{REMOTE_USER} = 'admin'; -my ($out, $err) = run_backend (); -is ($err, "keytab-backend: invalid arguments: \n", 'Fails with no arguments'); -is ($OUTPUT, "invalid arguments: \n", ' and syslog matches'); -is ($out, '', ' and produces no output'); -($out, $err) = run_backend ('foo', 'bar', 'baz'); -is ($err, "keytab-backend: invalid arguments: foo bar baz\n", - 'Fails with three arguments'); -is ($OUTPUT, "invalid arguments: foo bar baz\n", ' and syslog matches'); -is ($out, '', ' and produces no output'); -for my $bad (qw{service service\*@example =@example host/foo+bar@example - rcmd.foo@EXAMPLE host/foo/bar@EXAMPLE /bar@EXAMPLE.NET - bar/@EXAMPLE.NET bar/bar@}) { - ($out, $err) = run_backend ('keytab', $bad); - is ($err, "keytab-backend: bad principal name $bad\n", - "Invalid principal $bad"); - is ($OUTPUT, "bad principal name $bad\n", ' and syslog matches'); - is ($out, '', ' and produces no output'); -} -for my $bad (qw{service/foo@EXAMPLE.ORGA bar@EXAMPLE.NET - host/example.net@EXAMPLE.ORG aservice/foo@EXAMPLE.ORG}) { - ($out, $err) = run_backend ('keytab', $bad); - is ($err, - "keytab-backend: permission denied: admin may not retrieve $bad\n", - "Permission denied for $bad"); - is ($OUTPUT, "permission denied: admin may not retrieve $bad\n", - ' and syslog matches'); - is ($out, '', ' and produces no output'); -} -for my $good (qw{service/foo@EXAMPLE.ORG foo/bar@EXAMPLE.NET - host/example.org@EXAMPLE.ORG}) { - ($out, $err) = run_backend ($good); - is ($err, '', "Success for good keytab $good"); - is ($out, "$good\n", ' and the right output'); - is ($OUTPUT, "keytab $good retrieved by admin\n", ' and syslog is right'); - ok (! -f "$TMP/keytab$$", ' and the file is gone'); -} -($out, $err) = run_backend ('keytab', 'error@EXAMPLE.ORG'); -is ($err, "keytab-backend: retrieve of error\@EXAMPLE.ORG failed for" - . " admin: kadmin.local exited with status 1\n", - 'Good error on kadmin failure'); -is ($OUTPUT, "retrieve of error\@EXAMPLE.ORG failed for admin: kadmin.local" - . " exited with status 1\n", ' and syslog matches'); -is ($out, '', ' and no output'); - -# Test a configuration failure. -$CONFIG = '/path/to/bad/file'; -($out, $err) = run_backend ('get', 'service/foo@EXAMPLE.ORG'); -like ($err, qr{^keytab-backend: cannot open /path/to/bad/file: }, - 'Fails with bad configuration file'); -like ($OUTPUT, qr{^cannot open /path/to/bad/file: }, ' and syslog matches'); -is ($out, '', ' and produces no output'); diff --git a/tests/server/pod-t b/tests/server/pod-t new file mode 100755 index 0000000..52d81eb --- /dev/null +++ b/tests/server/pod-t @@ -0,0 +1,22 @@ +#!/usr/bin/perl +# +# Test POD formatting for client documentation. +# +# Written by Russ Allbery +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use Test::More; + +my @files = qw(keytab-backend wallet-admin wallet-backend); +my $total = scalar (@files); +plan tests => $total; + +eval 'use Test::Pod 1.00'; +SKIP: { + skip 'Test::Pod 1.00 required for testing POD', $total if $@; + for my $file (@files) { + pod_file_ok ("$ENV{SOURCE}/../server/$file", "server/$file"); + } +} diff --git a/tests/server/pod-t.in b/tests/server/pod-t.in deleted file mode 100644 index 52d81eb..0000000 --- a/tests/server/pod-t.in +++ /dev/null @@ -1,22 +0,0 @@ -#!/usr/bin/perl -# -# Test POD formatting for client documentation. -# -# Written by Russ Allbery -# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University -# -# See LICENSE for licensing terms. - -use Test::More; - -my @files = qw(keytab-backend wallet-admin wallet-backend); -my $total = scalar (@files); -plan tests => $total; - -eval 'use Test::Pod 1.00'; -SKIP: { - skip 'Test::Pod 1.00 required for testing POD', $total if $@; - for my $file (@files) { - pod_file_ok ("$ENV{SOURCE}/../server/$file", "server/$file"); - } -} -- cgit v1.2.3 From 5d7f614e88bac459a693f1dcc91aad36ed3d00dd Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 23:57:10 -0800 Subject: Reorganize main POD tests and add a spelling check Add a POD spelling test to the non-Perl-module part of the code and move the documentation tests into a separate directory. Merge the POD syntax tests between client and server into one test. Reformat all of the POD documentation to use 74 columns. Fix a few revealed spelling errors or weird wordings. --- client/wallet.pod | 11 ++++--- server/keytab-backend | 64 +++++++++++++++++++----------------- server/wallet-admin | 17 ++++++---- server/wallet-backend | 83 +++++++++++++++++++++++++---------------------- tests/TESTS | 4 +-- tests/client/pod-t | 22 ------------- tests/docs/pod-spelling-t | 80 +++++++++++++++++++++++++++++++++++++++++++++ tests/docs/pod-t | 21 ++++++++++++ tests/server/pod-t | 22 ------------- 9 files changed, 200 insertions(+), 124 deletions(-) delete mode 100755 tests/client/pod-t create mode 100755 tests/docs/pod-spelling-t create mode 100755 tests/docs/pod-t delete mode 100755 tests/server/pod-t (limited to 'tests/server') diff --git a/client/wallet.pod b/client/wallet.pod index 9908bb1..09fb571 100644 --- a/client/wallet.pod +++ b/client/wallet.pod @@ -2,6 +2,11 @@ wallet - Client for retrieving secure data from a central server +=for stopwords +-hv srvtab arg keytabs metadata keytab ACL PTS kinit klist remctl PKINIT +acl timestamp autocreate backend-specific setacl enctypes enctype ktadd +KDC appdefaults remctld Allbery nul uuencode getacl backend + =head1 SYNOPSIS B [B<-hv>] [B<-c> I] [B<-f> I] @@ -44,9 +49,7 @@ entries, each of which is a scheme and an identifier. A scheme specifies a way of checking whether a user is authorized. An identifier is some data specific to the scheme that specifies which users are authorized. For example, for the C scheme, the identifier is a principal name -and only that principal is authorized by that ACL entry. For the C -scheme, the identifier is a PTS group name, and all members of that PTS -group are authorized by that ACL entry. +and only that principal is authorized by that ACL entry. To run the wallet command-line client, you must already have a Kerberos ticket. You can obtain a Kerberos ticket with B and see your @@ -201,7 +204,7 @@ Display the history of the ACL . Each change to the ACL (not including changes to the name of the ACL) will be represented by two lines. The first line will have a timestamp of the change followed by a description of the change, and the second line will give the user who made -the change and the host from which the change was mde. +the change and the host from which the change was made. =item acl remove diff --git a/server/keytab-backend b/server/keytab-backend index b37fb3a..7b6adb4 100755 --- a/server/keytab-backend +++ b/server/keytab-backend @@ -17,7 +17,8 @@ # The keytab for the extracted principal will be printed to standard output. # # Written by Russ Allbery -# Copyright 2006, 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2006, 2007, 2008, 2010 +# Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -155,6 +156,10 @@ __END__ # Documentation ############################################################################## +=for stopwords +keytab-backend keytabs KDC keytab kadmin.local -norandkey ktadd remctld +auth Allbery rekeying + =head1 NAME keytab-backend - Extract keytabs from the KDC without changing the key @@ -165,27 +170,28 @@ B retrieve I =head1 DESCRIPTION -B retrieves a keytab for an existing principal from the KDC -database without changing the current key. It allows generation of a keytab -for a service without rekeying that service. It requires a B -patched to support the B<-norandkey> option to B. +B retrieves a keytab for an existing principal from the +KDC database without changing the current key. It allows generation of a +keytab for a service without rekeying that service. It requires a +B patched to support the B<-norandkey> option to B. -This script is intended to run under B. On success, it prints the -keytab to standard output, logs a success message to syslog (facility auth, -priority info), and exits with status 0. On failure, it prints out an error -message, logs an error to syslog (facility auth, priority err), and exits -with a non-zero status. +This script is intended to run under B. On success, it prints +the keytab to standard output, logs a success message to syslog (facility +auth, priority info), and exits with status 0. On failure, it prints out +an error message, logs an error to syslog (facility auth, priority err), +and exits with a non-zero status. The principal is checked for basic sanity (only accepting alphanumerics, -C<_>, and C<-> with an optional instance and then only alphanumerics, C<_>, -C<->, and C<.> in the realm) and then checked against a configuration file -that lists regexes of principals that can be retrieved. When deploying this -software, limit as tightly as possible which principals can be downloaded in -this fashion. Generally only shared service principals used on multiple -systems should be made available in this way. +C<_>, and C<-> with an optional instance and then only alphanumerics, +C<_>, C<->, and C<.> in the realm) and then checked against a +configuration file that lists regexes of principals that can be retrieved. +When deploying this software, limit as tightly as possible which +principals can be downloaded in this fashion. Generally only shared +service principals used on multiple systems should be made available in +this way. -B does not do any authorization checks. Those should be done -by B before it is called. +B does not do any authorization checks. Those should be +done by B before it is called. =head1 FILES @@ -193,19 +199,19 @@ by B before it is called. =item F -The configuration file that controls which principals can have their keytabs -retrieved. Blank lines and lines starting with C<#>, as well as anything -after C<#> on a line, are ignored. All other lines should be Perl regular -expressions, one per line, that match principals whose keytabs can be -retrieved by B. Any principal that does not match one of -those regular expressions cannot be retrieved. +The configuration file that controls which principals can have their +keytabs retrieved. Blank lines and lines starting with C<#>, as well as +anything after C<#> on a line, are ignored. All other lines should be +Perl regular expressions, one per line, that match principals whose +keytabs can be retrieved by B. Any principal that does +not match one of those regular expressions cannot be retrieved. =item F The temporary directory used for creating keytabs. B will -create the keytab in this directory, make sure that was successful, and then -delete the temporary file after the results have been sent to standard -output. +create the keytab in this directory, make sure that was successful, and +then delete the temporary file after the results have been sent to +standard output. =back @@ -213,8 +219,8 @@ output. kadmin.local(8), remctld(8) -This program is part of the wallet system. The current version is available -from L. +This program is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/server/wallet-admin b/server/wallet-admin index cd775b6..828cfc5 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -1,9 +1,9 @@ #!/usr/bin/perl -w # -# wallet-admin -- Wallet server administrative commands. +# wallet-backend -- Wallet server administrative commands. # # Written by Russ Allbery -# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -110,6 +110,9 @@ __END__ wallet-admin - Wallet server administrative commands +=for stopwords +metadata ACL hostname backend acl acls wildcard SQL Allbery + =head1 SYNOPSIS B I [I ...] @@ -171,8 +174,8 @@ be listed in the form: In both cases, there will be one line per ACL or object. -If no searchtype is given, all the ACLs or objects in the database will -be returned. If a searchtype (and possible search arguments) are given, +If no search type is given, all the ACLs or objects in the database will +be returned. If a search type (and possible search arguments) are given, then the ACLs or objects will be limited to those that match the search. The currently supported object search types are: @@ -206,7 +209,7 @@ The currently supported ACL search types are: =item list acls empty Returns all ACLs which have no entries, generally so that abandoned ACLs -can be housekept. +can be destroyed. =item list acls entry @@ -256,8 +259,8 @@ with duplicates suppressed. Wallet::Admin(3), Wallet::Config(3), wallet-backend(8) -This program is part of the wallet system. The current version is available -from L. +This program is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/server/wallet-backend b/server/wallet-backend index 0770f97..7780758 100755 --- a/server/wallet-backend +++ b/server/wallet-backend @@ -3,7 +3,7 @@ # wallet-backend -- Wallet server for storing and retrieving secure data. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -311,6 +311,11 @@ __END__ # The commands section of this document is duplicated from the documentation # for wallet and should be kept in sync. +=for stopwords +wallet-backend backend backend-specific remctld ACL acl timestamp getacl +setacl metadata nul keytab keytabs enctypes enctype ktadd KDC Allbery +autocreate + =head1 NAME wallet-backend - Wallet server for storing and retrieving secure data @@ -321,20 +326,22 @@ B [B<-q>] I [I ...] =head1 DESCRIPTION -B implements the interface between B and the wallet -system. It is written to run under B and expects the authenticated -identity of the remote user in the REMOTE_USER environment variable. It -uses REMOTE_HOST or REMOTE_ADDR if REMOTE_HOST isn't set for additional -trace information. It accepts the command from B on the command -line, creates a Wallet::Server object, and calls the appropriate methods. - -This program is a fairly thin wrapper around Wallet::Server that translates -command strings into method calls and returns the results. It does check -all arguments except for the argument to the store command and -rejects any argument not matching C<^[\w_/.-]+\z>; in other words, only -alphanumerics, underscore (C<_>), slash (C), period (C<.>), and hyphen -(C<->) are permitted in arguments. This provides some additional security -over and above the checking already done by the rest of the wallet code. +B implements the interface between B and the +wallet system. It is written to run under B and expects the +authenticated identity of the remote user in the REMOTE_USER environment +variable. It uses REMOTE_HOST or REMOTE_ADDR if REMOTE_HOST isn't set for +additional trace information. It accepts the command from B on +the command line, creates a Wallet::Server object, and calls the +appropriate methods. + +This program is a fairly thin wrapper around Wallet::Server that +translates command strings into method calls and returns the results. It +does check all arguments except for the argument to the store +command and rejects any argument not matching C<^[\w_/.-]+\z>; in other +words, only alphanumerics, underscore (C<_>), slash (C), period (C<.>), +and hyphen (C<->) are permitted in arguments. This provides some +additional security over and above the checking already done by the rest +of the wallet code. =head1 OPTIONS @@ -400,7 +407,7 @@ Display the history of the ACL . Each change to the ACL (not including changes to the name of the ACL) will be represented by two lines. The first line will have a timestamp of the change followed by a description of the change, and the second line will give the user who made -the change and the host from which the change was mde. +the change and the host from which the change was made. =item acl remove @@ -447,8 +454,8 @@ The expiration will be displayed in seconds since epoch. If is given, sets the expiration on the object identified by and to and (if given)