line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package OIDC::Lite::Client::WebServer; |
2
|
1
|
|
|
1
|
|
1373
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
38
|
|
3
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
9
|
|
|
1
|
|
|
|
|
28
|
|
4
|
1
|
|
|
1
|
|
831
|
use parent 'OAuth::Lite2::Client::WebServer'; |
|
1
|
|
|
|
|
276
|
|
|
1
|
|
|
|
|
4
|
|
5
|
|
|
|
|
|
|
use bytes (); |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
use URI; |
8
|
|
|
|
|
|
|
use Carp (); |
9
|
|
|
|
|
|
|
use Try::Tiny qw(try catch); |
10
|
|
|
|
|
|
|
use LWP::UserAgent; |
11
|
|
|
|
|
|
|
use HTTP::Request; |
12
|
|
|
|
|
|
|
use HTTP::Headers; |
13
|
|
|
|
|
|
|
use Params::Validate qw(HASHREF); |
14
|
|
|
|
|
|
|
use OAuth::Lite2; |
15
|
|
|
|
|
|
|
use OAuth::Lite2::Util qw(build_content); |
16
|
|
|
|
|
|
|
use OIDC::Lite::Client::TokenResponseParser; |
17
|
|
|
|
|
|
|
use OAuth::Lite2::Client::StateResponseParser; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 NAME |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
OIDC::Lite::Client::WebServer - OpenID Connect Web Server Profile Client |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 SYNOPSIS |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
my $client = OIDC::Lite::Client::WebServer->new( |
26
|
|
|
|
|
|
|
id => q{my_client_id}, |
27
|
|
|
|
|
|
|
secret => q{my_client_secret}, |
28
|
|
|
|
|
|
|
authorize_uri => q{http://example.org/authorize}, |
29
|
|
|
|
|
|
|
access_token_uri => q{http://example.org/token}, |
30
|
|
|
|
|
|
|
); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# redirect user to authorize page. |
33
|
|
|
|
|
|
|
sub start_authorize { |
34
|
|
|
|
|
|
|
my $your_app = shift; |
35
|
|
|
|
|
|
|
my $redirect_url = $client->uri_to_redirect( |
36
|
|
|
|
|
|
|
redirect_uri => q{http://yourapp/callback}, |
37
|
|
|
|
|
|
|
scope => q{photo}, |
38
|
|
|
|
|
|
|
state => q{optional_state}, |
39
|
|
|
|
|
|
|
); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
$your_app->res->redirect( $redirect_url ); |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# this method corresponds to the url 'http://yourapp/callback' |
45
|
|
|
|
|
|
|
sub callback { |
46
|
|
|
|
|
|
|
my $your_app = shift; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
my $code = $your_app->request->param("code"); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
my $access_token = $client->get_access_token( |
51
|
|
|
|
|
|
|
code => $code, |
52
|
|
|
|
|
|
|
redirect_uri => q{http://yourapp/callback}, |
53
|
|
|
|
|
|
|
) or return $your_app->error( $client->errstr ); |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
$your_app->store->save( access_token => $access_token->access_token ); |
56
|
|
|
|
|
|
|
$your_app->store->save( expires_at => time() + $access_token->expires_in ); |
57
|
|
|
|
|
|
|
$your_app->store->save( refresh_token => $access_token->refresh_token ); |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub refresh_access_token { |
61
|
|
|
|
|
|
|
my $your_app = shift; |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
my $access_token = $client->refresh_access_token( |
64
|
|
|
|
|
|
|
refresh_token => $refresh_token, |
65
|
|
|
|
|
|
|
) or return $your_app->error( $client->errstr ); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
$your_app->store->save( access_token => $access_token->access_token ); |
68
|
|
|
|
|
|
|
$your_app->store->save( expires_at => time() + $access_token->expires_in ); |
69
|
|
|
|
|
|
|
$your_app->store->save( refresh_token => $access_token->refresh_token ); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub access_to_protected_resource { |
74
|
|
|
|
|
|
|
my $your_app = shift; |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
my $access_token = $your_app->store->get("access_token"); |
77
|
|
|
|
|
|
|
my $expires_at = $your_app->store->get("expires_at"); |
78
|
|
|
|
|
|
|
my $refresh_token = $your_app->store->get("refresh_token"); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
unless ($access_token) { |
81
|
|
|
|
|
|
|
$your_app->start_authorize(); |
82
|
|
|
|
|
|
|
return; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
if ($expires_at < time()) { |
86
|
|
|
|
|
|
|
$your_app->refresh_access_token(); |
87
|
|
|
|
|
|
|
return; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
my $req = HTTP::Request->new( GET => q{http://example.org/photo} ); |
91
|
|
|
|
|
|
|
$req->header( Authorization => sprintf(q{OAuth %s}, $access_token) ); |
92
|
|
|
|
|
|
|
my $agent = LWP::UserAgent->new; |
93
|
|
|
|
|
|
|
my $res = $agent->request($req); |
94
|
|
|
|
|
|
|
... |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=head1 DESCRIPTION |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
Client library for OpenID Connect Web Server Profile. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=head1 METHODS |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=head2 new( %params ) |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=over 4 |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=item id |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
Client ID |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=item secret |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
Client secret |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=item authorize_uri |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
authorization page uri on auth-server. |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=item access_token_uri |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
token endpoint uri on auth-server. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=item refresh_token_uri |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
refresh-token endpoint uri on auth-server. |
127
|
|
|
|
|
|
|
if you omit this, access_token_uri is used instead. |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=item agent |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
user agent. if you omit this, LWP::UserAgent's object is set by default. |
132
|
|
|
|
|
|
|
You can use your custom agent or preset-agents. |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
See also |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
L |
137
|
|
|
|
|
|
|
L |
138
|
|
|
|
|
|
|
L |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=back |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=cut |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
sub new { |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
my $class = shift; |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
my %args = Params::Validate::validate(@_, { |
149
|
|
|
|
|
|
|
id => 1, |
150
|
|
|
|
|
|
|
secret => 1, |
151
|
|
|
|
|
|
|
authorize_uri => { optional => 1 }, |
152
|
|
|
|
|
|
|
access_token_uri => { optional => 1 }, |
153
|
|
|
|
|
|
|
refresh_token_uri => { optional => 1 }, |
154
|
|
|
|
|
|
|
agent => { optional => 1 }, |
155
|
|
|
|
|
|
|
}); |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
my $self = bless { |
158
|
|
|
|
|
|
|
id => undef, |
159
|
|
|
|
|
|
|
secret => undef, |
160
|
|
|
|
|
|
|
authorize_uri => undef, |
161
|
|
|
|
|
|
|
access_token_uri => undef, |
162
|
|
|
|
|
|
|
refresh_token_uri => undef, |
163
|
|
|
|
|
|
|
last_request => undef, |
164
|
|
|
|
|
|
|
last_response => undef, |
165
|
|
|
|
|
|
|
%args, |
166
|
|
|
|
|
|
|
}, $class; |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
unless ($self->{agent}) { |
169
|
|
|
|
|
|
|
$self->{agent} = LWP::UserAgent->new; |
170
|
|
|
|
|
|
|
$self->{agent}->agent( |
171
|
|
|
|
|
|
|
join "/", __PACKAGE__, $OAuth::Lite2::VERSION); |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
$self->{format} = 'json'; |
175
|
|
|
|
|
|
|
$self->{response_parser} = OIDC::Lite::Client::TokenResponseParser->new; |
176
|
|
|
|
|
|
|
$self->{state_response_parser} = OAuth::Lite2::Client::StateResponseParser->new; |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
return $self; |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=head2 uri_to_redirect( %params ) |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=cut |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
sub uri_to_redirect { |
186
|
|
|
|
|
|
|
my $self = shift; |
187
|
|
|
|
|
|
|
my %args = Params::Validate::validate(@_, { |
188
|
|
|
|
|
|
|
redirect_uri => 1, |
189
|
|
|
|
|
|
|
state => { optional => 1 }, |
190
|
|
|
|
|
|
|
scope => { optional => 1 }, |
191
|
|
|
|
|
|
|
uri => { optional => 1 }, |
192
|
|
|
|
|
|
|
extra => { optional => 1, type => HASHREF }, |
193
|
|
|
|
|
|
|
}); |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
unless (exists $args{uri}) { |
196
|
|
|
|
|
|
|
$args{uri} = $self->{authorize_uri}; |
197
|
|
|
|
|
|
|
Carp::croak "uri not found" unless $args{uri}; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
my %params = ( |
201
|
|
|
|
|
|
|
response_type => 'code', |
202
|
|
|
|
|
|
|
client_id => $self->{id}, |
203
|
|
|
|
|
|
|
redirect_uri => $args{redirect_uri}, |
204
|
|
|
|
|
|
|
); |
205
|
|
|
|
|
|
|
$params{state} = $args{state} if $args{state}; |
206
|
|
|
|
|
|
|
$params{scope} = $args{scope} if $args{scope}; |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
if ($args{extra}) { |
209
|
|
|
|
|
|
|
for my $key ( keys %{$args{extra}} ) { |
210
|
|
|
|
|
|
|
$params{$key} = $args{extra}{$key}; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
my $uri = URI->new($args{uri}); |
215
|
|
|
|
|
|
|
$uri->query_form(%params); |
216
|
|
|
|
|
|
|
return $uri->as_string; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=head2 get_access_token( %params ) |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
execute verification, |
222
|
|
|
|
|
|
|
and returns L object. |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=over 4 |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=item code |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
Authorization-code that is issued beforehand by server |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=item redirect_uri |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
The URL that has used for user authorization's callback |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=back |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=cut |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
sub get_access_token { |
239
|
|
|
|
|
|
|
my $self = shift; |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
my %args = Params::Validate::validate(@_, { |
242
|
|
|
|
|
|
|
code => 1, |
243
|
|
|
|
|
|
|
redirect_uri => { optional => 1 }, |
244
|
|
|
|
|
|
|
server_state => { optional => 1 }, |
245
|
|
|
|
|
|
|
uri => { optional => 1 }, |
246
|
|
|
|
|
|
|
use_basic_schema => { optional => 1 }, |
247
|
|
|
|
|
|
|
}); |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
unless (exists $args{uri}) { |
250
|
|
|
|
|
|
|
$args{uri} = $self->{access_token_uri}; |
251
|
|
|
|
|
|
|
Carp::croak "uri not found" unless $args{uri}; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
my %params = ( |
255
|
|
|
|
|
|
|
grant_type => 'authorization_code', |
256
|
|
|
|
|
|
|
code => $args{code}, |
257
|
|
|
|
|
|
|
); |
258
|
|
|
|
|
|
|
$params{redirect_uri} = $args{redirect_uri} if $args{redirect_uri}; |
259
|
|
|
|
|
|
|
$params{server_state} = $args{server_state} if $args{server_state}; |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
unless ($args{use_basic_schema}){ |
262
|
|
|
|
|
|
|
$params{client_id} = $self->{id}; |
263
|
|
|
|
|
|
|
$params{client_secret} = $self->{secret}; |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
my $content = build_content(\%params); |
267
|
|
|
|
|
|
|
my $headers = HTTP::Headers->new; |
268
|
|
|
|
|
|
|
$headers->header("Content-Type" => q{application/x-www-form-urlencoded}); |
269
|
|
|
|
|
|
|
$headers->header("Content-Length" => bytes::length($content)); |
270
|
|
|
|
|
|
|
$headers->authorization_basic($self->{id}, $self->{secret}) |
271
|
|
|
|
|
|
|
if($args{use_basic_schema}); |
272
|
|
|
|
|
|
|
my $req = HTTP::Request->new( POST => $args{uri}, $headers, $content ); |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
my $res = $self->{agent}->request($req); |
275
|
|
|
|
|
|
|
$self->{last_request} = $req; |
276
|
|
|
|
|
|
|
$self->{last_response} = $res; |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
my ($token, $errmsg); |
279
|
|
|
|
|
|
|
try { |
280
|
|
|
|
|
|
|
$token = $self->{response_parser}->parse($res); |
281
|
|
|
|
|
|
|
} catch { |
282
|
|
|
|
|
|
|
$errmsg = "$_"; |
283
|
|
|
|
|
|
|
return $self->error($errmsg); |
284
|
|
|
|
|
|
|
}; |
285
|
|
|
|
|
|
|
return $token; |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=head2 refresh_access_token( %params ) |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
Refresh access token by refresh_token, |
291
|
|
|
|
|
|
|
returns L object. |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=over 4 |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
=item refresh_token |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
=back |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
=cut |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
sub refresh_access_token { |
302
|
|
|
|
|
|
|
my $self = shift; |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
my %args = Params::Validate::validate(@_, { |
305
|
|
|
|
|
|
|
refresh_token => 1, |
306
|
|
|
|
|
|
|
uri => { optional => 1 }, |
307
|
|
|
|
|
|
|
use_basic_schema => { optional => 1 }, |
308
|
|
|
|
|
|
|
}); |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
unless (exists $args{uri}) { |
311
|
|
|
|
|
|
|
$args{uri} = $self->{access_token_uri}; |
312
|
|
|
|
|
|
|
Carp::croak "uri not found" unless $args{uri}; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
my %params = ( |
316
|
|
|
|
|
|
|
grant_type => 'refresh_token', |
317
|
|
|
|
|
|
|
refresh_token => $args{refresh_token}, |
318
|
|
|
|
|
|
|
); |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
unless ($args{use_basic_schema}){ |
321
|
|
|
|
|
|
|
$params{client_id} = $self->{id}; |
322
|
|
|
|
|
|
|
$params{client_secret} = $self->{secret}; |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
my $content = build_content(\%params); |
326
|
|
|
|
|
|
|
my $headers = HTTP::Headers->new; |
327
|
|
|
|
|
|
|
$headers->header("Content-Type" => q{application/x-www-form-urlencoded}); |
328
|
|
|
|
|
|
|
$headers->header("Content-Length" => bytes::length($content)); |
329
|
|
|
|
|
|
|
$headers->authorization_basic($self->{id}, $self->{secret}) |
330
|
|
|
|
|
|
|
if($args{use_basic_schema}); |
331
|
|
|
|
|
|
|
my $req = HTTP::Request->new( POST => $args{uri}, $headers, $content ); |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
my $res = $self->{agent}->request($req); |
334
|
|
|
|
|
|
|
$self->{last_request} = $req; |
335
|
|
|
|
|
|
|
$self->{last_response} = $res; |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
my ($token, $errmsg); |
338
|
|
|
|
|
|
|
try { |
339
|
|
|
|
|
|
|
$token = $self->{response_parser}->parse($res); |
340
|
|
|
|
|
|
|
} catch { |
341
|
|
|
|
|
|
|
$errmsg = "$_"; |
342
|
|
|
|
|
|
|
return $self->error($errmsg); |
343
|
|
|
|
|
|
|
}; |
344
|
|
|
|
|
|
|
return $token; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
=head2 last_request |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
Returns a HTTP::Request object that is used |
350
|
|
|
|
|
|
|
when you obtain or refresh access token last time internally. |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
=head2 last_request |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
Returns a HTTP::Response object that is used |
355
|
|
|
|
|
|
|
when you obtain or refresh access token last time internally. |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
=cut |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
sub last_request { $_[0]->{last_request} } |
360
|
|
|
|
|
|
|
sub last_response { $_[0]->{last_response} } |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
=head1 AUTHOR |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
Ryo Ito, Eritou.06@gmail.comE |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
Copyright (C) 2012 by Ryo Ito |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
371
|
|
|
|
|
|
|
it under the same terms as Perl itself, either Perl version 5.8.8 or, |
372
|
|
|
|
|
|
|
at your option, any later version of Perl 5 you may have available. |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
=cut |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
1; |