line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Dancer2::Plugin::Auth::Extensible::Test::App; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
Dancer2::Plugin::Auth::Extensible::Test::App - Dancer2 app for testing providers |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=cut |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '0.710'; |
10
|
|
|
|
|
|
|
|
11
|
2
|
|
|
2
|
|
1875752
|
use strict; |
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
84
|
|
12
|
2
|
|
|
2
|
|
13
|
use warnings; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
76
|
|
13
|
2
|
|
|
2
|
|
14
|
use Test::More; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
38
|
|
14
|
2
|
|
|
2
|
|
815
|
use Test::Deep qw(bag cmp_deeply); |
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
24
|
|
15
|
2
|
|
|
2
|
|
1812
|
use Test::Fatal; |
|
2
|
|
|
|
|
2125
|
|
|
2
|
|
|
|
|
128
|
|
16
|
2
|
|
|
2
|
|
19
|
use Dancer2 appname => 'TestApp'; |
|
2
|
|
|
|
|
32
|
|
|
2
|
|
|
|
|
22
|
|
17
|
2
|
|
|
2
|
|
9118
|
use Dancer2::Plugin::Auth::Extensible; |
|
2
|
|
|
|
|
11
|
|
|
2
|
|
|
|
|
32
|
|
18
|
2
|
|
|
2
|
|
6547
|
use Scalar::Util qw(blessed); |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
195
|
|
19
|
2
|
|
|
2
|
|
18
|
use YAML (); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
10695
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
set session => 'simple'; |
22
|
|
|
|
|
|
|
set logger => 'capture'; |
23
|
|
|
|
|
|
|
set log => 'debug'; |
24
|
|
|
|
|
|
|
set show_errors => 1; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# nasty shared global makes it easy to pass data between app and test script |
27
|
|
|
|
|
|
|
our $data = {}; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
config->{plugins}->{"Auth::Extensible"}->{password_reset_send_email} = |
30
|
|
|
|
|
|
|
__PACKAGE__ . "::email_send"; |
31
|
|
|
|
|
|
|
config->{plugins}->{"Auth::Extensible"}->{welcome_send} = |
32
|
|
|
|
|
|
|
__PACKAGE__ . "::email_send"; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub email_send { |
35
|
2
|
|
|
2
|
0
|
235
|
my ( $plugin, %args ) = @_; |
36
|
2
|
|
|
|
|
21
|
$data = { %args, called => 1 }; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# we need the plugin object and a provider for provider tests |
40
|
|
|
|
|
|
|
my $plugin = app->with_plugin('Auth::Extensible'); |
41
|
|
|
|
|
|
|
my $provider = $plugin->auth_provider('config1'); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
my @provider_can = (); |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
push @provider_can, 'record_lastlogin' if $plugin->config->{record_lastlogin}; |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
config->{plugins}->{"Auth::Extensible"}->{reset_password_handler} = 1 |
48
|
|
|
|
|
|
|
if $provider->can('get_user_by_code'); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# |
51
|
|
|
|
|
|
|
# IMPORTANT NOTE |
52
|
|
|
|
|
|
|
# |
53
|
|
|
|
|
|
|
# We use "isnt exception {...}, undef, ..." a lot which is REALLY BAD |
54
|
|
|
|
|
|
|
# practice. This should only ever be done in provider tests since we cannot |
55
|
|
|
|
|
|
|
# be sure what exception message a provider returns and we do NOT mandate |
56
|
|
|
|
|
|
|
# specific messages so we can only test if something died. |
57
|
|
|
|
|
|
|
# |
58
|
|
|
|
|
|
|
# When writing new provider tests please always test first with a "like /qr/" |
59
|
|
|
|
|
|
|
# instead and then once the tests are all working against one provider switch |
60
|
|
|
|
|
|
|
# them to the bad "isnt undef" style so they are portable. |
61
|
|
|
|
|
|
|
# |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
subtest 'Provider authenticate_user tests' => sub { |
64
|
|
|
|
|
|
|
my $ret; |
65
|
|
|
|
|
|
|
push @provider_can, 'authenticate_user'; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
isnt exception { $ret = $provider->authenticate_user(); }, |
68
|
|
|
|
|
|
|
undef, |
69
|
|
|
|
|
|
|
"authenticate_user with no args dies."; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
isnt exception { $ret = $provider->authenticate_user(''); }, |
72
|
|
|
|
|
|
|
undef, |
73
|
|
|
|
|
|
|
"authenticate_user with empty username and no password dies."; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
isnt exception { $ret = $provider->authenticate_user(undef, ''); }, |
76
|
|
|
|
|
|
|
undef, |
77
|
|
|
|
|
|
|
"authenticate_user with undef username and empty password dies."; |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
is exception { $ret = $provider->authenticate_user('', ''); }, |
80
|
|
|
|
|
|
|
undef, |
81
|
|
|
|
|
|
|
"authenticate_user with empty username and empty password lives."; |
82
|
|
|
|
|
|
|
ok !$ret, "... and returns a false value."; |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
is exception { $ret = $provider->authenticate_user('unknown', 'beer'); }, |
85
|
|
|
|
|
|
|
undef, |
86
|
|
|
|
|
|
|
"authenticate_user with unknown user lives."; |
87
|
|
|
|
|
|
|
ok !$ret, "... and returns a false value."; |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
is exception { $ret = $provider->authenticate_user('dave', 'notcorrect'); }, |
90
|
|
|
|
|
|
|
undef, |
91
|
|
|
|
|
|
|
"authenticate_user with known user and bad password lives."; |
92
|
|
|
|
|
|
|
ok !$ret, "... and returns a false value."; |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
is exception { $ret = $provider->authenticate_user('dave', 'beer'); }, |
95
|
|
|
|
|
|
|
undef, |
96
|
|
|
|
|
|
|
"authenticate_user with known user and good password."; |
97
|
|
|
|
|
|
|
ok $ret, "... and returns a true value."; |
98
|
|
|
|
|
|
|
}; |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
SKIP: { |
101
|
|
|
|
|
|
|
skip "Provider has no get_user_details method", 1 |
102
|
|
|
|
|
|
|
unless $provider->can('get_user_details'); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
subtest 'Provider get_user_details tests' => sub { |
105
|
|
|
|
|
|
|
my $ret; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
push @provider_can, 'get_user_details'; |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
isnt exception { $ret = $provider->get_user_details(); }, |
110
|
|
|
|
|
|
|
undef, |
111
|
|
|
|
|
|
|
"get_user_details with no args dies."; |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
is exception { $ret = $provider->get_user_details(''); }, |
114
|
|
|
|
|
|
|
undef, |
115
|
|
|
|
|
|
|
"get_user_details with empty username lives."; |
116
|
|
|
|
|
|
|
ok !$ret, "... and returns a false value."; |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
is exception { $ret = $provider->get_user_details('unknown'); }, |
119
|
|
|
|
|
|
|
undef, |
120
|
|
|
|
|
|
|
"get_user_details with unknown user lives."; |
121
|
|
|
|
|
|
|
ok !$ret, "... and returns a false value."; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
is exception { $ret = $provider->get_user_details('dave'); }, |
124
|
|
|
|
|
|
|
undef, |
125
|
|
|
|
|
|
|
"get_user_details with known user lives."; |
126
|
|
|
|
|
|
|
ok $ret, "... and returns a true value"; |
127
|
|
|
|
|
|
|
ok blessed($ret) || ref($ret) eq 'HASH', |
128
|
|
|
|
|
|
|
"... which is either an object or a hash reference" |
129
|
|
|
|
|
|
|
or diag explain $ret; |
130
|
|
|
|
|
|
|
is blessed($ret) ? $ret->name : $ret->{name}, 'David Precious', |
131
|
|
|
|
|
|
|
"... and user's name is David Precious."; |
132
|
|
|
|
|
|
|
}; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
SKIP: { |
136
|
|
|
|
|
|
|
skip "Provider has no get_user_roles method", 1 |
137
|
|
|
|
|
|
|
unless $provider->can('get_user_roles'); |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
subtest 'Provider get_user_roles tests' => sub { |
140
|
|
|
|
|
|
|
my $ret; |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
push @provider_can, 'get_user_roles'; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
isnt exception { $ret = $provider->get_user_roles(); }, |
145
|
|
|
|
|
|
|
undef, |
146
|
|
|
|
|
|
|
"get_user_roles with no args dies."; |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
is exception { $ret = $provider->get_user_roles(''); }, undef, |
149
|
|
|
|
|
|
|
"get_user_roles with empty username lives"; |
150
|
|
|
|
|
|
|
ok !$ret, "... and returns false value."; |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
is exception { $ret = $provider->get_user_roles('unknown'); }, undef, |
153
|
|
|
|
|
|
|
"get_user_roles with unknown user lives"; |
154
|
|
|
|
|
|
|
ok !$ret, "... and returns false value."; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
is exception { $ret = $provider->get_user_roles('dave'); }, undef, |
157
|
|
|
|
|
|
|
"get_user_roles with known user \"dave\" lives"; |
158
|
|
|
|
|
|
|
ok $ret, "... and returns true value"; |
159
|
|
|
|
|
|
|
is ref($ret), 'ARRAY', "... which is an array reference"; |
160
|
|
|
|
|
|
|
cmp_deeply $ret, bag( "BeerDrinker", "Motorcyclist" ), |
161
|
|
|
|
|
|
|
"... and dave is a BeerDrinker and Motorcyclist."; |
162
|
|
|
|
|
|
|
}; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
SKIP: { |
166
|
|
|
|
|
|
|
skip "Provider has no create_user method", 1 |
167
|
|
|
|
|
|
|
unless $provider->can('create_user'); |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
subtest 'Provider create_user tests' => sub { |
170
|
|
|
|
|
|
|
my $ret; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
push @provider_can, 'create_user'; |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
isnt exception { $ret = $provider->create_user(); }, |
175
|
|
|
|
|
|
|
undef, |
176
|
|
|
|
|
|
|
"create_user with no args dies."; |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
isnt exception { $ret = $provider->create_user(username => ''); }, |
179
|
|
|
|
|
|
|
undef, |
180
|
|
|
|
|
|
|
"create_user with empty username dies."; |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
isnt exception { $ret = $provider->create_user(username => 'dave'); }, |
183
|
|
|
|
|
|
|
undef, |
184
|
|
|
|
|
|
|
"create_user with existing username dies."; |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
is exception { |
187
|
|
|
|
|
|
|
$ret = $provider->get_user_details('provider_create_user'); |
188
|
|
|
|
|
|
|
}, |
189
|
|
|
|
|
|
|
undef, |
190
|
|
|
|
|
|
|
"get_user_details \"provider_create_user\" lives"; |
191
|
|
|
|
|
|
|
ok !defined $ret, "... and does not return a user."; |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
is exception { |
194
|
|
|
|
|
|
|
$ret = $provider->create_user( |
195
|
|
|
|
|
|
|
username => 'provider_create_user', |
196
|
|
|
|
|
|
|
name => 'Create User' |
197
|
|
|
|
|
|
|
); |
198
|
|
|
|
|
|
|
}, |
199
|
|
|
|
|
|
|
undef, |
200
|
|
|
|
|
|
|
"create_user \"provider_create_user\" lives"; |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
ok defined $ret, "... and returns a user"; |
203
|
|
|
|
|
|
|
is blessed($ret) ? $ret->name : $ret->{name}, "Create User", |
204
|
|
|
|
|
|
|
"... and user's name is correct."; |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
is exception { |
207
|
|
|
|
|
|
|
$ret = $provider->get_user_details('provider_create_user'); |
208
|
|
|
|
|
|
|
}, |
209
|
|
|
|
|
|
|
undef, |
210
|
|
|
|
|
|
|
"get_user_details \"provider_create_user\" lives"; |
211
|
|
|
|
|
|
|
ok defined $ret, "... and now *does* return a user."; |
212
|
|
|
|
|
|
|
is blessed($ret) ? $ret->name : $ret->{name}, "Create User", |
213
|
|
|
|
|
|
|
"... and user's name is correct."; |
214
|
|
|
|
|
|
|
}; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
SKIP: { |
218
|
|
|
|
|
|
|
skip "Provider has no set_user_details method", 1 |
219
|
|
|
|
|
|
|
unless $provider->can('set_user_details'); |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
subtest 'Provider set_user_details tests' => sub { |
222
|
|
|
|
|
|
|
my $ret; |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
push @provider_can, 'set_user_details'; |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
isnt exception { $ret = $provider->set_user_details(); }, |
227
|
|
|
|
|
|
|
undef, |
228
|
|
|
|
|
|
|
"set_user_details with no args dies."; |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
isnt exception { $ret = $provider->set_user_details(''); }, |
231
|
|
|
|
|
|
|
undef, |
232
|
|
|
|
|
|
|
"set_user_details with empty username dies."; |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
is exception { |
235
|
|
|
|
|
|
|
$ret = $provider->create_user( |
236
|
|
|
|
|
|
|
username => 'provider_set_user_details', |
237
|
|
|
|
|
|
|
name => 'Initial Name' |
238
|
|
|
|
|
|
|
); |
239
|
|
|
|
|
|
|
}, |
240
|
|
|
|
|
|
|
undef, |
241
|
|
|
|
|
|
|
"Create a user for testing lives"; |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
is exception { |
244
|
|
|
|
|
|
|
$ret = $provider->get_user_details('provider_set_user_details') |
245
|
|
|
|
|
|
|
}, |
246
|
|
|
|
|
|
|
undef, |
247
|
|
|
|
|
|
|
"... and get_user_details on new user lives"; |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
is blessed($ret) ? $ret->name : $ret->{name}, 'Initial Name', |
250
|
|
|
|
|
|
|
"... and user has expected name."; |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
is exception { |
253
|
|
|
|
|
|
|
$ret = $provider->set_user_details( 'provider_set_user_details', |
254
|
|
|
|
|
|
|
name => 'New Name', ); |
255
|
|
|
|
|
|
|
}, |
256
|
|
|
|
|
|
|
undef, |
257
|
|
|
|
|
|
|
"Using set_user_details to change user's name lives"; |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
is blessed($ret) ? $ret->name : $ret->{name}, 'New Name', |
260
|
|
|
|
|
|
|
"... and returned user has expected name."; |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
is exception { |
263
|
|
|
|
|
|
|
$ret = $provider->get_user_details('provider_set_user_details') |
264
|
|
|
|
|
|
|
}, |
265
|
|
|
|
|
|
|
undef, |
266
|
|
|
|
|
|
|
"... and get_user_details on new user lives"; |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
is blessed($ret) ? $ret->name : $ret->{name}, 'New Name', |
269
|
|
|
|
|
|
|
"... and returned user has expected name."; |
270
|
|
|
|
|
|
|
}; |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
SKIP: { |
274
|
|
|
|
|
|
|
skip "Provider has no get_user_by_code method", 1 |
275
|
|
|
|
|
|
|
unless $provider->can('get_user_by_code'); |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
subtest 'Provider get_user_by_code tests' => sub { |
278
|
|
|
|
|
|
|
my $ret; |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
push @provider_can, 'get_user_by_code'; |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
isnt exception { $ret = $provider->get_user_by_code(); }, |
283
|
|
|
|
|
|
|
undef, |
284
|
|
|
|
|
|
|
"get_user_by_code with no args dies."; |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
isnt exception { $ret = $provider->get_user_by_code(''); }, |
287
|
|
|
|
|
|
|
undef, |
288
|
|
|
|
|
|
|
"get_user_by_code with empty code dies."; |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
is exception { $ret = $provider->get_user_by_code('nosuchcode'); }, |
291
|
|
|
|
|
|
|
undef, |
292
|
|
|
|
|
|
|
"get_user_by_code with non-existant code lives"; |
293
|
|
|
|
|
|
|
ok !defined $ret, "... and returns undef."; |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
is exception { |
296
|
|
|
|
|
|
|
$ret = $provider->create_user( |
297
|
|
|
|
|
|
|
username => 'provider_get_user_by_code', |
298
|
|
|
|
|
|
|
pw_reset_code => '01234567890get_user_by_code', |
299
|
|
|
|
|
|
|
); |
300
|
|
|
|
|
|
|
}, |
301
|
|
|
|
|
|
|
undef, |
302
|
|
|
|
|
|
|
"Create a user for testing lives"; |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
is exception { |
305
|
|
|
|
|
|
|
$ret = $provider->get_user_by_code('01234567890get_user_by_code'); |
306
|
|
|
|
|
|
|
}, |
307
|
|
|
|
|
|
|
undef, |
308
|
|
|
|
|
|
|
"get_user_by_code with non-existant code lives"; |
309
|
|
|
|
|
|
|
ok defined $ret, "... and returns something true"; |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
is $ret, 'provider_get_user_by_code', |
312
|
|
|
|
|
|
|
"... and returned username is correct."; |
313
|
|
|
|
|
|
|
}; |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
SKIP: { |
317
|
|
|
|
|
|
|
skip "Provider has no set_user_password method", 1 |
318
|
|
|
|
|
|
|
unless $provider->can('set_user_password'); |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
subtest 'Provider set_user_password tests' => sub { |
321
|
|
|
|
|
|
|
my $ret; |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
push @provider_can, 'set_user_password'; |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
isnt exception { $ret = $provider->set_user_password(); }, |
326
|
|
|
|
|
|
|
undef, |
327
|
|
|
|
|
|
|
"set_user_password with no args dies."; |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
isnt exception { $ret = $provider->set_user_password(''); }, |
330
|
|
|
|
|
|
|
undef, |
331
|
|
|
|
|
|
|
"set_user_password with username but undef password dies"; |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
isnt exception { $ret = $provider->set_user_password( undef, '' ); }, |
334
|
|
|
|
|
|
|
undef, |
335
|
|
|
|
|
|
|
"set_user_password with password but undef username dies"; |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
is exception { |
338
|
|
|
|
|
|
|
$ret = |
339
|
|
|
|
|
|
|
$provider->create_user( username => 'provider_set_user_password' ) |
340
|
|
|
|
|
|
|
}, |
341
|
|
|
|
|
|
|
undef, |
342
|
|
|
|
|
|
|
"Create a user for testing lives"; |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
is exception { |
345
|
|
|
|
|
|
|
$ret = $provider->set_user_password( 'provider_set_user_password', |
346
|
|
|
|
|
|
|
'aNicePassword' ) |
347
|
|
|
|
|
|
|
}, |
348
|
|
|
|
|
|
|
undef, "set_user_password for our new user lives"; |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
is exception { |
351
|
|
|
|
|
|
|
$ret = $provider->authenticate_user( 'provider_set_user_password', |
352
|
|
|
|
|
|
|
'aNicePassword' ) |
353
|
|
|
|
|
|
|
}, |
354
|
|
|
|
|
|
|
undef, "... and authenticate_user with correct password lives"; |
355
|
|
|
|
|
|
|
ok $ret, "... and authenticate_user passes (returns true)"; |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
is exception { |
358
|
|
|
|
|
|
|
$ret = $provider->authenticate_user( 'provider_set_user_password', |
359
|
|
|
|
|
|
|
'badpwd' ) |
360
|
|
|
|
|
|
|
}, |
361
|
|
|
|
|
|
|
undef, "... and whilst authenticate_user with bad password lives"; |
362
|
|
|
|
|
|
|
ok !$ret, "... it returns false."; |
363
|
|
|
|
|
|
|
}; |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
SKIP: { |
367
|
|
|
|
|
|
|
skip "Provider has no password_expired method", 1 |
368
|
|
|
|
|
|
|
unless $provider->can('password_expired'); |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
subtest 'Provider password_expired tests' => sub { |
371
|
|
|
|
|
|
|
my $ret; |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
push @provider_can, 'password_expired'; |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
isnt exception { $ret = $provider->password_expired(); }, |
376
|
|
|
|
|
|
|
undef, |
377
|
|
|
|
|
|
|
"password_expired with no args dies."; |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
is exception { |
380
|
|
|
|
|
|
|
$ret = |
381
|
|
|
|
|
|
|
$provider->create_user( username => 'provider_password_expired' ) |
382
|
|
|
|
|
|
|
}, |
383
|
|
|
|
|
|
|
undef, |
384
|
|
|
|
|
|
|
"Create a user for testing lives"; |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
is exception { |
387
|
|
|
|
|
|
|
$ret = $provider->password_expired($ret) |
388
|
|
|
|
|
|
|
}, |
389
|
|
|
|
|
|
|
undef, |
390
|
|
|
|
|
|
|
"... and password_expired for user lives"; |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
ok $ret, "... and password is expired since it has never been set."; |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
is exception { |
395
|
|
|
|
|
|
|
$ret = $provider->set_user_password( 'provider_password_expired', |
396
|
|
|
|
|
|
|
'password' ) |
397
|
|
|
|
|
|
|
}, |
398
|
|
|
|
|
|
|
undef, |
399
|
|
|
|
|
|
|
"Setting password for user lives"; |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
is exception { |
402
|
|
|
|
|
|
|
$ret = $provider->password_expired($ret) |
403
|
|
|
|
|
|
|
}, |
404
|
|
|
|
|
|
|
undef, |
405
|
|
|
|
|
|
|
"... and password_expired for user lives"; |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
ok !$ret, "... and password is now *not* expired."; |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
is exception { |
410
|
|
|
|
|
|
|
$ret = $provider->set_user_details( 'provider_password_expired', |
411
|
|
|
|
|
|
|
pw_changed => DateTime->now->subtract( weeks => 1 ) ) |
412
|
|
|
|
|
|
|
}, |
413
|
|
|
|
|
|
|
undef, |
414
|
|
|
|
|
|
|
"Set pw_changed to one week ago lives and so now password is expired"; |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
is exception { |
417
|
|
|
|
|
|
|
$ret = $provider->password_expired($ret) |
418
|
|
|
|
|
|
|
}, |
419
|
|
|
|
|
|
|
undef, |
420
|
|
|
|
|
|
|
"... and password_expired for user lives"; |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
ok $ret, "... and password *is* now expired since expiry is 2 days."; |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
}; |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
subtest "Plugin coverage testing" => sub { |
428
|
|
|
|
|
|
|
# DO NOT use this for testing things that can be tested elsewhere since |
429
|
|
|
|
|
|
|
# these tests are purely to catch the code paths that we can't get to |
430
|
|
|
|
|
|
|
# any other way. |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
like exception { $plugin->realm() }, qr/realm name not provided/, |
433
|
|
|
|
|
|
|
"Calling realm method with no args dies"; |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
like exception { $plugin->realm('') }, qr/realm name not provided/, |
436
|
|
|
|
|
|
|
"... and calling it with single empty arg dies."; |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
foreach my $username ( undef, +{}, '', 'username' ) { |
439
|
|
|
|
|
|
|
foreach my $password ( undef, +{}, '', 'password' ) { |
440
|
|
|
|
|
|
|
my $ret = $plugin->authenticate_user( $username, $password ); |
441
|
|
|
|
|
|
|
is $ret, 0, |
442
|
|
|
|
|
|
|
"Checking authenticate_user with username/password: " |
443
|
|
|
|
|
|
|
. mydumper($username) . "/" |
444
|
|
|
|
|
|
|
. mydumper($password); |
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
}; |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
sub mydumper { |
450
|
64
|
|
|
64
|
0
|
120
|
my $val = shift; |
451
|
64
|
100
|
|
|
|
212
|
!defined $val && return '(undef)'; |
452
|
48
|
100
|
|
|
|
170
|
ref($val) ne '' && return ref($val); |
453
|
32
|
100
|
|
|
|
121
|
$val eq '' && return '(empty)'; |
454
|
16
|
|
|
|
|
71
|
$val; |
455
|
|
|
|
|
|
|
}; |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
# hooks |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
hook before_authenticate_user => sub { |
460
|
|
|
|
|
|
|
debug "before_authenticate_user", to_json( shift, { canonical => 1 } ); |
461
|
|
|
|
|
|
|
}; |
462
|
|
|
|
|
|
|
hook after_authenticate_user => sub { |
463
|
|
|
|
|
|
|
debug "after_authenticate_user", to_json( shift, { canonical => 1 } ); |
464
|
|
|
|
|
|
|
}; |
465
|
|
|
|
|
|
|
hook before_create_user => sub { |
466
|
|
|
|
|
|
|
debug "before_create_user", to_json( shift, { canonical => 1 } ); |
467
|
|
|
|
|
|
|
}; |
468
|
|
|
|
|
|
|
hook after_create_user => sub { |
469
|
|
|
|
|
|
|
my ( $username, $user, $errors ) = @_; |
470
|
|
|
|
|
|
|
my $ret = $user ? 1 : 0; |
471
|
|
|
|
|
|
|
debug "after_create_user,$username,$ret,",scalar @$errors ? 'yes' : 'no'; |
472
|
|
|
|
|
|
|
}; |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
# and finally the routes for the main plugin tests |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
get '/provider_can' => sub { |
477
|
|
|
|
|
|
|
send_as YAML => \@provider_can; |
478
|
|
|
|
|
|
|
}; |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
get '/' => sub { |
481
|
|
|
|
|
|
|
"Index always accessible"; |
482
|
|
|
|
|
|
|
}; |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
post '/authenticate_user' => sub { |
485
|
|
|
|
|
|
|
my $params = body_parameters->as_hashref; |
486
|
|
|
|
|
|
|
my @ret = authenticate_user( $params->{username}, $params->{password}, |
487
|
|
|
|
|
|
|
$params->{realm} ); |
488
|
|
|
|
|
|
|
send_as YAML => \@ret; |
489
|
|
|
|
|
|
|
}; |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
post '/create_user' => sub { |
492
|
|
|
|
|
|
|
my $params = body_parameters->as_hashref; |
493
|
|
|
|
|
|
|
my $user = create_user %$params; |
494
|
|
|
|
|
|
|
return $user ? 1 : 0; |
495
|
|
|
|
|
|
|
}; |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
post '/get_user_details' => sub { |
498
|
|
|
|
|
|
|
my $params = body_parameters->as_hashref; |
499
|
|
|
|
|
|
|
my $user = get_user_details $params->{username}, $params->{realm}; |
500
|
|
|
|
|
|
|
if ( blessed($user) ) { |
501
|
|
|
|
|
|
|
if ( $user->isa('DBIx::Class::Row')) { |
502
|
|
|
|
|
|
|
$user = +{ $user->get_columns }; |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
else { |
505
|
|
|
|
|
|
|
# assume some kind of hash-backed object |
506
|
|
|
|
|
|
|
$user = \%$user; |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
return $user ? send_as YAML => $user : 0; |
510
|
|
|
|
|
|
|
}; |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
get '/session_data' => sub { |
513
|
|
|
|
|
|
|
my $session = session->data; |
514
|
|
|
|
|
|
|
send_as YAML => $session; |
515
|
|
|
|
|
|
|
}; |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
get '/logged_in_user_lastlogin' => sub { |
518
|
|
|
|
|
|
|
my $dt = logged_in_user_lastlogin; |
519
|
|
|
|
|
|
|
if ( ref($dt) eq 'DateTime' ) { |
520
|
|
|
|
|
|
|
return $dt->ymd; |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
return 'not set'; |
523
|
|
|
|
|
|
|
}; |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
get '/logged_in_user' => sub { |
526
|
|
|
|
|
|
|
my $user = logged_in_user; |
527
|
|
|
|
|
|
|
if ( blessed($user) ) { |
528
|
|
|
|
|
|
|
if ( $user->isa('DBIx::Class::Row')) { |
529
|
|
|
|
|
|
|
$user = +{ $user->get_columns }; |
530
|
|
|
|
|
|
|
} |
531
|
|
|
|
|
|
|
else { |
532
|
|
|
|
|
|
|
# assume some kind of hash-backed object |
533
|
|
|
|
|
|
|
$user = \%$user; |
534
|
|
|
|
|
|
|
} |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
send_as YAML => $user ? $user : 'none'; |
537
|
|
|
|
|
|
|
}; |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
get '/logged_in_user_twice' => sub { |
540
|
|
|
|
|
|
|
logged_in_user; # retrieve |
541
|
|
|
|
|
|
|
my $user = logged_in_user; # should now be stashed in var |
542
|
|
|
|
|
|
|
if ( blessed($user) ) { |
543
|
|
|
|
|
|
|
if ( $user->isa('DBIx::Class::Row')) { |
544
|
|
|
|
|
|
|
$user = +{ $user->get_columns }; |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
else { |
547
|
|
|
|
|
|
|
# assume some kind of hash-backed object |
548
|
|
|
|
|
|
|
$user = \%$user; |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
send_as YAML => $user ? $user : 'none'; |
552
|
|
|
|
|
|
|
}; |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
get '/loggedin' => require_login sub { |
555
|
|
|
|
|
|
|
"You are logged in"; |
556
|
|
|
|
|
|
|
}; |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
get qr{/regex/(.+)} => require_login sub { |
559
|
|
|
|
|
|
|
return "Matched"; |
560
|
|
|
|
|
|
|
}; |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
get '/require_login_no_sub' => require_login; |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
get '/require_login_not_coderef' => require_login { a => 1 }; |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
get '/roles' => require_login sub { |
567
|
|
|
|
|
|
|
my $roles = user_roles() || []; |
568
|
|
|
|
|
|
|
return join ',', sort @$roles; |
569
|
|
|
|
|
|
|
}; |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
get '/roles/:user' => require_login sub { |
572
|
|
|
|
|
|
|
my $user = param 'user'; |
573
|
|
|
|
|
|
|
return join ',', sort @{ user_roles($user) }; |
574
|
|
|
|
|
|
|
}; |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
get '/roles/:user/:realm' => require_login sub { |
577
|
|
|
|
|
|
|
my $user = param 'user'; |
578
|
|
|
|
|
|
|
my $realm = param 'realm'; |
579
|
|
|
|
|
|
|
return join ',', sort @{ user_roles($user, $realm) }; |
580
|
|
|
|
|
|
|
}; |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
get '/user_roles' => sub { |
583
|
|
|
|
|
|
|
return join ',', sort @{ user_roles() }; |
584
|
|
|
|
|
|
|
}; |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
get '/beer' => require_role BeerDrinker => sub { |
587
|
|
|
|
|
|
|
"You can have a beer"; |
588
|
|
|
|
|
|
|
}; |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
get '/piss' => require_role BearGrylls => sub { |
591
|
|
|
|
|
|
|
"You can drink piss"; |
592
|
|
|
|
|
|
|
}; |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
get '/piss/regex' => require_role qr/beer/i => sub { |
595
|
|
|
|
|
|
|
"You can drink piss now"; |
596
|
|
|
|
|
|
|
}; |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
get '/anyrole' => require_any_role ['Foo','BeerDrinker'] => sub { |
599
|
|
|
|
|
|
|
"Matching one of multiple roles works"; |
600
|
|
|
|
|
|
|
}; |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
get '/allroles' => require_all_roles ['BeerDrinker', 'Motorcyclist'] => sub { |
603
|
|
|
|
|
|
|
"Matching multiple required roles works"; |
604
|
|
|
|
|
|
|
}; |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
get '/not_allroles' => require_all_roles ['BeerDrinker', 'BadRole'] => sub { |
607
|
|
|
|
|
|
|
"Matching multiple required roles should fail"; |
608
|
|
|
|
|
|
|
}; |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
get '/does_dave_drink_beer' => sub { |
611
|
|
|
|
|
|
|
return user_has_role('dave', 'BeerDrinker'); |
612
|
|
|
|
|
|
|
}; |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
get '/does_dave_drink_cider' => sub { |
615
|
|
|
|
|
|
|
return user_has_role('dave', 'CiderDrinker'); |
616
|
|
|
|
|
|
|
}; |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
get '/does_undef_drink_beer' => sub { |
619
|
|
|
|
|
|
|
return user_has_role(undef, 'BeerDrinker'); |
620
|
|
|
|
|
|
|
}; |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
get '/user_password' => sub { |
623
|
|
|
|
|
|
|
return user_password params('query'); |
624
|
|
|
|
|
|
|
}; |
625
|
|
|
|
|
|
|
post '/user_password' => sub { |
626
|
|
|
|
|
|
|
return user_password %{ body_parameters->as_hashref }; |
627
|
|
|
|
|
|
|
}; |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
get '/update_current_user' => sub { |
630
|
|
|
|
|
|
|
my $user = update_current_user name => "I love cider"; |
631
|
|
|
|
|
|
|
if ( blessed($user) ) { |
632
|
|
|
|
|
|
|
if ( $user->isa('DBIx::Class::Row')) { |
633
|
|
|
|
|
|
|
$user = +{ $user->get_columns }; |
634
|
|
|
|
|
|
|
} |
635
|
|
|
|
|
|
|
else { |
636
|
|
|
|
|
|
|
# assume some kind of hash-backed object |
637
|
|
|
|
|
|
|
$user = \%$user; |
638
|
|
|
|
|
|
|
} |
639
|
|
|
|
|
|
|
} |
640
|
|
|
|
|
|
|
YAML::Dump $user; |
641
|
|
|
|
|
|
|
}; |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
get '/update_user_name/:realm' => sub { |
644
|
|
|
|
|
|
|
my $realm = param 'realm'; |
645
|
|
|
|
|
|
|
YAML::Dump update_user 'mark', realm => $realm, name => "Wiltshire Apples $realm"; |
646
|
|
|
|
|
|
|
}; |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
post '/update_user' => sub { |
649
|
|
|
|
|
|
|
my $params = body_parameters->as_hashref; |
650
|
|
|
|
|
|
|
my $username = delete $params->{username}; |
651
|
|
|
|
|
|
|
send_as YAML => update_user $username, %$params; |
652
|
|
|
|
|
|
|
}; |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
get '/get_user_mark/:realm' => sub { |
655
|
|
|
|
|
|
|
my $realm = param 'realm'; |
656
|
|
|
|
|
|
|
content_type 'text/x-yaml'; |
657
|
|
|
|
|
|
|
my $user = get_user_details 'mark', $realm; |
658
|
|
|
|
|
|
|
if ( blessed($user) ) { |
659
|
|
|
|
|
|
|
if ( $user->isa('DBIx::Class::Row')) { |
660
|
|
|
|
|
|
|
$user = +{ $user->get_columns }; |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
else { |
663
|
|
|
|
|
|
|
# assume some kind of hash-backed object |
664
|
|
|
|
|
|
|
$user = \%$user; |
665
|
|
|
|
|
|
|
} |
666
|
|
|
|
|
|
|
} |
667
|
|
|
|
|
|
|
YAML::Dump $user; |
668
|
|
|
|
|
|
|
}; |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
post '/auth_provider' => sub { |
671
|
|
|
|
|
|
|
$plugin->auth_provider( body_parameters->get('realm') ); |
672
|
|
|
|
|
|
|
return; |
673
|
|
|
|
|
|
|
}; |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
get '/logged_in_user_password_expired' => sub { |
676
|
|
|
|
|
|
|
my $ret = logged_in_user_password_expired; |
677
|
|
|
|
|
|
|
return $ret ? 'yes' : 'no'; |
678
|
|
|
|
|
|
|
}; |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
1; |