1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
#!/usr/bin/perl -w
#
# Tests for the wallet-admin dispatch code.
#
# Written by Russ Allbery <eagle@eyrie.org>
# Copyright 2008, 2009, 2010, 2011
# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
use strict;
use Test::More tests => 42;
# 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;
}
sub upgrade {
print "upgrade\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],
upgrade => [0, 0]);
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', 'eagle@eyrie.org');
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 upgrade.
($out, $err) = run_admin ('upgrade');
is ($err, '', 'Upgrade succeeds');
is ($out, "new\nupgrade\n", ' and runs the right code');
# 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', 'eagle@eyrie.org');
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');
($out, $err) = run_admin ('upgrade');
is ($err, "some error\n", 'Error handling succeeds for initialize');
is ($out, "new\nupgrade\n", ' and calls the right methods');
|
