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
|
#!/usr/bin/perl -w
#
# Tests for the wallet-report dispatch code.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
#
# See LICENSE for licensing terms.
use strict;
use Test::More tests => 44;
# 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 audit {
shift;
print "audit @_\n";
return if ($error or $empty);
if ($_[0] eq 'objects') {
return ([ file => 'unix-wallet-password' ]);
} elsif ($_[0] eq 'acls') {
return ([ 2, 'group/admins' ]);
} else {
return;
}
}
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],
audit => [2, 2],
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 ('audit', 'objects', 'name');
is ($err, '', 'Object audit report succeeds');
is ($out, "new\naudit objects name\nfile unix-wallet-password\n",
' and returns the right output');
($out, $err) = run_report ('audit', 'acls', 'name');
is ($err, '', 'ACL audit report succeeds');
is ($out, "new\naudit acls name\ngroup/admins (ACL ID: 2)\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 acls');
is ($out, "new\nacls \n", ' and calls the right methods');
($out, $err) = run_report ('audit', 'objects', 'name');
is ($err, "some error\n", 'Error handling succeeds for audit');
is ($out, "new\naudit objects name\n", ' and calls the right methods');
($out, $err) = run_report ('objects');
is ($err, "some error\n", 'Error handling succeeds for 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 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, '', 'acls runs with an empty list and no errors');
is ($out, "new\nacls \n", ' and calls the right methods');
($out, $err) = run_report ('audit', 'objects', 'name');
is ($err, '', 'audit runs with an empty list and no errors');
is ($out, "new\naudit objects name\n", ' and calls the right methods');
($out, $err) = run_report ('objects');
is ($err, '', '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, '', 'owners runs with an empty list and no errors');
is ($out, "new\nowners foo bar\n", ' and calls the right methods');
|
