From 60210334fa3dbd5dd168199063c6ee850d750d0c Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 21 Feb 2010 17:45:55 -0800 Subject: Imported Upstream version 0.10 --- tests/server/admin-t | 171 +++++++++++++++ tests/server/admin-t.in | 217 ------------------- tests/server/backend-t | 522 ++++++++++++++++++++++++++++++++++++++++++++++ tests/server/backend-t.in | 498 ------------------------------------------- tests/server/keytab-t | 88 ++++++++ tests/server/keytab-t.in | 89 -------- tests/server/pod-t.in | 23 -- tests/server/report-t | 151 ++++++++++++++ 8 files changed, 932 insertions(+), 827 deletions(-) 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 delete mode 100644 tests/server/pod-t.in create mode 100755 tests/server/report-t (limited to 'tests/server') diff --git a/tests/server/admin-t b/tests/server/admin-t new file mode 100755 index 0000000..5bde104 --- /dev/null +++ b/tests/server/admin-t @@ -0,0 +1,171 @@ +#!/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 => 36; + +# 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($error); +$error = 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 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; +} + +# 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], + register => [3, 3]); +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 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 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 ('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'); diff --git a/tests/server/admin-t.in b/tests/server/admin-t.in deleted file mode 100644 index be40880..0000000 --- a/tests/server/admin-t.in +++ /dev/null @@ -1,217 +0,0 @@ -#!/usr/bin/perl -w -# $Id$ -# -# Tests for the wallet-admin dispatch code. -# -# Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University -# -# See LICENSE for licensing terms. - -use strict; -use Test::More tests => 54; - -# 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; -} - -# 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 '@abs_top_srcdir@/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, 1], - register => [3, 3]); -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'); - } - ($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 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'); - -# 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'); diff --git a/tests/server/backend-t b/tests/server/backend-t new file mode 100755 index 0000000..b58d02c --- /dev/null +++ b/tests/server/backend-t @@ -0,0 +1,522 @@ +#!/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 => 1269; + +# 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; +my $INPUT = ''; +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; + close STDIN; + open (STDIN, '<', \$INPUT) or die "cannot change stdin: $!\n"; + 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 => [2, 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) : ''; + $extra = ' ' if $command eq 'store'; + ($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); + $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++; +} + +# Special check for store allowing nul characters on standard input. +$INPUT = "Some data\000with a nul character"; +($out, $err) = run_backend ('store', 'type', 'name'); +is ($err, '', 'store with nul data ran with no errors'); +is ($OUTPUT, "command store type name from admin (1.2.3.4) succeeded\n", + ' and success logged'); +is ($out, "$new\nstore type name $INPUT\n", + ' and ran the right method'); +$INPUT = ''; +($out, $err) = run_backend ('store', 'type', 'name'); +is ($err, '', 'store with empty stdin data ran with no errors'); +is ($OUTPUT, "command store type name from admin (1.2.3.4) succeeded\n", + ' and success logged'); +is ($out, "$new\nstore type name \n", + ' and ran the right method'); + +# 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 e1518d8..0000000 --- a/tests/server/backend-t.in +++ /dev/null @@ -1,498 +0,0 @@ -#!/usr/bin/perl -w -# $Id$ -# -# Tests for the wallet-backend dispatch code. -# -# Written by Russ Allbery -# Copyright 2006, 2007, 2008 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 '@abs_top_srcdir@/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); - $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 f74267d..0000000 --- a/tests/server/keytab-t.in +++ /dev/null @@ -1,89 +0,0 @@ -#!/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 -# -# 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 '@abs_top_srcdir@/server/keytab-backend' }; -$CONFIG = '@abs_top_srcdir@/tests/data/allow-extract'; -$KADMIN = '@abs_top_srcdir@/tests/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.in b/tests/server/pod-t.in deleted file mode 100644 index fd939a5..0000000 --- a/tests/server/pod-t.in +++ /dev/null @@ -1,23 +0,0 @@ -#!/usr/bin/perl -# $Id$ -# -# tests/server/pod-t -- Test POD formatting for client documentation. -# -# Written by Russ Allbery -# Copyright 2008 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 $total, 'Test::Pod 1.00 required for testing POD' if $@; - for my $file (@files) { - pod_file_ok ("@abs_top_srcdir@/server/$file", "server/$file"); - } -} diff --git a/tests/server/report-t b/tests/server/report-t new file mode 100755 index 0000000..285ee5a --- /dev/null +++ b/tests/server/report-t @@ -0,0 +1,151 @@ +#!/usr/bin/perl -w +# +# Tests for the wallet-report 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 => 32; + +# Create a dummy class for Wallet::Report that prints what method was called +# with its arguments and returns data for testing. +package Wallet::Report; + +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::Report'); +} + +sub acls { + shift; + print "acls @_\n"; + return if ($error or $empty); + return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]); +} + +sub objects { + shift; + print "objects @_\n"; + return if ($error or $empty); + return ([ keytab => 'host/windlord.stanford.edu' ], + [ file => 'unix-wallet-password' ]); +} + +sub owners { + shift; + print "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::Report package has already been loaded. +package main; +$INC{'Wallet/Report.pm'} = 'FAKE'; +eval { do "$ENV{SOURCE}/../server/wallet-report" }; + +# Run the wallet report client. This fun hack takes advantage of the fact +# that the wallet report client is written in Perl so that we can substitute +# our own Wallet::Report class. +sub run_report { + 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_report ('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 = (acls => [0, 3], + objects => [0, 2], + owners => [2, 2]); +for my $command (sort keys %commands) { + my ($min, $max) = @{ $commands{$command} }; + if ($min > 0) { + ($out, $err) = run_report ($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_report ($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 the report methods. +($out, $err) = run_report ('acls'); +is ($err, '', 'List succeeds for ACLs'); +is ($out, "new\nacls \n" + . "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n", + ' and returns the right output'); +($out, $err) = run_report ('acls', 'entry', 'foo', 'foo'); +is ($err, '', 'List succeeds for ACLs'); +is ($out, "new\nacls entry foo foo\n" + . "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n", + ' and returns the right output'); +($out, $err) = run_report ('objects'); +is ($err, '', 'List succeeds for objects'); +is ($out, "new\nobjects \n" + . "keytab host/windlord.stanford.edu\nfile unix-wallet-password\n", + ' and returns the right output'); +($out, $err) = run_report ('objects', 'type', 'foo'); +is ($err, '', 'List succeeds for objects type foo'); +is ($out, "new\nobjects type foo\n" + . "keytab host/windlord.stanford.edu\nfile unix-wallet-password\n", + ' and returns the right output'); +($out, $err) = run_report ('owners', '%', '%'); +is ($err, '', 'Report succeeds for owners'); +is ($out, "new\nowners % %\nkrb5 admin\@EXAMPLE.COM\n", + ' and returns the right output'); + +# Test error handling. +$Wallet::Report::error = 1; +($out, $err) = run_report ('acls'); +is ($err, "some error\n", 'Error handling succeeds for list acls'); +is ($out, "new\nacls \n", ' and calls the right methods'); +($out, $err) = run_report ('objects'); +is ($err, "some error\n", 'Error handling succeeds for list objects'); +is ($out, "new\nobjects \n", ' and calls the right methods'); +($out, $err) = run_report ('owners', 'foo', 'bar'); +is ($err, "some error\n", 'Error handling succeeds for report owners'); +is ($out, "new\nowners foo bar\n", ' and calls the right methods'); + +# Test empty lists. +$Wallet::Report::error = 0; +$Wallet::Report::empty = 1; +($out, $err) = run_report ('acls'); +is ($err, '', 'list acls runs with an empty list and no errors'); +is ($out, "new\nacls \n", ' and calls the right methods'); +($out, $err) = run_report ('objects'); +is ($err, '', 'list objects runs with an empty list with no errors'); +is ($out, "new\nobjects \n", ' and calls the right methods'); +($out, $err) = run_report ('owners', 'foo', 'bar'); +is ($err, '', 'report owners runs with an empty list and no errors'); +is ($out, "new\nowners foo bar\n", ' and calls the right methods'); -- cgit v1.2.3