line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
########################################### |
2
|
|
|
|
|
|
|
package OAuth::Cmdline; |
3
|
|
|
|
|
|
|
########################################### |
4
|
2
|
|
|
2
|
|
680
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
78
|
|
5
|
2
|
|
|
2
|
|
13
|
use warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
72
|
|
6
|
2
|
|
|
2
|
|
1716
|
use URI; |
|
2
|
|
|
|
|
11263
|
|
|
2
|
|
|
|
|
72
|
|
7
|
2
|
|
|
2
|
|
1122
|
use YAML qw( DumpFile LoadFile ); |
|
2
|
|
|
|
|
11923
|
|
|
2
|
|
|
|
|
123
|
|
8
|
2
|
|
|
2
|
|
1131
|
use HTTP::Request::Common; |
|
2
|
|
|
|
|
35989
|
|
|
2
|
|
|
|
|
164
|
|
9
|
2
|
|
|
2
|
|
15
|
use URI; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
40
|
|
10
|
2
|
|
|
2
|
|
1784
|
use LWP::UserAgent; |
|
2
|
|
|
|
|
38566
|
|
|
2
|
|
|
|
|
95
|
|
11
|
2
|
|
|
2
|
|
2048
|
use Log::Log4perl qw(:easy); |
|
2
|
|
|
|
|
93095
|
|
|
2
|
|
|
|
|
12
|
|
12
|
2
|
|
|
2
|
|
906
|
use JSON qw( from_json ); |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
16
|
|
13
|
2
|
|
|
2
|
|
259
|
use MIME::Base64; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
118
|
|
14
|
2
|
|
|
2
|
|
662
|
use Moo; |
|
2
|
|
|
|
|
11487
|
|
|
2
|
|
|
|
|
13
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our $VERSION = "0.06"; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
has client_id => ( is => "rw" ); |
19
|
|
|
|
|
|
|
has client_secret => ( is => "rw" ); |
20
|
|
|
|
|
|
|
has local_uri => ( |
21
|
|
|
|
|
|
|
is => "rw", |
22
|
|
|
|
|
|
|
default => "http://localhost:8082", |
23
|
|
|
|
|
|
|
); |
24
|
|
|
|
|
|
|
has homedir => ( |
25
|
|
|
|
|
|
|
is => "ro", |
26
|
|
|
|
|
|
|
default => glob '~', |
27
|
|
|
|
|
|
|
); |
28
|
|
|
|
|
|
|
has base_uri => ( is => "rw" ); |
29
|
|
|
|
|
|
|
has login_uri => ( is => "rw" ); |
30
|
|
|
|
|
|
|
has site => ( is => "rw" ); |
31
|
|
|
|
|
|
|
has scope => ( is => "rw" ); |
32
|
|
|
|
|
|
|
has token_uri => ( is => "rw" ); |
33
|
|
|
|
|
|
|
has redir_uri => ( is => "rw" ); |
34
|
|
|
|
|
|
|
has access_type => ( is => "rw" ); |
35
|
|
|
|
|
|
|
has raise_error => ( is => "rw" ); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
########################################### |
38
|
|
|
|
|
|
|
sub redirect_uri { |
39
|
|
|
|
|
|
|
########################################### |
40
|
0
|
|
|
0
|
0
|
|
my( $self ) = @_; |
41
|
|
|
|
|
|
|
|
42
|
0
|
|
|
|
|
|
return $self->local_uri . "/callback"; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
########################################### |
46
|
|
|
|
|
|
|
sub cache_file_path { |
47
|
|
|
|
|
|
|
########################################### |
48
|
0
|
|
|
0
|
0
|
|
my( $self ) = @_; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# creds saved ~/.[site].yml |
51
|
0
|
|
|
|
|
|
return $self->homedir . "/." . |
52
|
|
|
|
|
|
|
$self->site . ".yml"; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
########################################### |
56
|
|
|
|
|
|
|
sub full_login_uri { |
57
|
|
|
|
|
|
|
########################################### |
58
|
0
|
|
|
0
|
0
|
|
my( $self ) = @_; |
59
|
|
|
|
|
|
|
|
60
|
0
|
|
|
|
|
|
my $full_login_uri = URI->new( $self->login_uri ); |
61
|
|
|
|
|
|
|
|
62
|
0
|
0
|
|
|
|
|
$full_login_uri->query_form ( |
|
|
0
|
|
|
|
|
|
63
|
|
|
|
|
|
|
client_id => $self->client_id(), |
64
|
|
|
|
|
|
|
response_type => "code", |
65
|
|
|
|
|
|
|
(defined $self->redirect_uri() ? |
66
|
|
|
|
|
|
|
( redirect_uri => $self->redirect_uri() ) : |
67
|
|
|
|
|
|
|
() |
68
|
|
|
|
|
|
|
), |
69
|
|
|
|
|
|
|
scope => $self->scope(), |
70
|
|
|
|
|
|
|
($self->access_type() ? |
71
|
|
|
|
|
|
|
(access_type => $self->access_type()) : ()), |
72
|
|
|
|
|
|
|
); |
73
|
|
|
|
|
|
|
|
74
|
0
|
|
|
|
|
|
DEBUG "full login uri: $full_login_uri"; |
75
|
0
|
|
|
|
|
|
return $full_login_uri; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
########################################### |
79
|
|
|
|
|
|
|
sub access_token { |
80
|
|
|
|
|
|
|
########################################### |
81
|
0
|
|
|
0
|
0
|
|
my( $self ) = @_; |
82
|
|
|
|
|
|
|
|
83
|
0
|
0
|
|
|
|
|
if( $self->token_expired() ) { |
84
|
0
|
0
|
|
|
|
|
$self->token_refresh() or LOGDIE "Token refresh failed"; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
0
|
|
|
|
|
|
my $cache = $self->cache_read(); |
88
|
0
|
|
|
|
|
|
return $cache->{ access_token }; |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
########################################### |
92
|
|
|
|
|
|
|
sub authorization_headers { |
93
|
|
|
|
|
|
|
########################################### |
94
|
0
|
|
|
0
|
1
|
|
my( $self ) = @_; |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
return ( |
97
|
0
|
|
|
|
|
|
'Authorization' => |
98
|
|
|
|
|
|
|
'Bearer ' . $self->access_token |
99
|
|
|
|
|
|
|
); |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
########################################### |
103
|
|
|
|
|
|
|
sub token_refresh_authorization_header { |
104
|
|
|
|
|
|
|
########################################### |
105
|
0
|
|
|
0
|
0
|
|
my( $self ) = @_; |
106
|
|
|
|
|
|
|
|
107
|
0
|
|
|
|
|
|
return (); |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
########################################### |
111
|
|
|
|
|
|
|
sub token_refresh { |
112
|
|
|
|
|
|
|
########################################### |
113
|
0
|
|
|
0
|
0
|
|
my( $self ) = @_; |
114
|
|
|
|
|
|
|
|
115
|
0
|
|
|
|
|
|
DEBUG "Refreshing access token"; |
116
|
|
|
|
|
|
|
|
117
|
0
|
|
|
|
|
|
my $cache = $self->cache_read(); |
118
|
|
|
|
|
|
|
|
119
|
0
|
|
|
|
|
|
$self->token_uri( $cache->{ token_uri } ); |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
my $req = &HTTP::Request::Common::POST( |
122
|
|
|
|
|
|
|
$self->token_uri, |
123
|
|
|
|
|
|
|
{ |
124
|
|
|
|
|
|
|
refresh_token => $cache->{ refresh_token }, |
125
|
|
|
|
|
|
|
client_id => $cache->{ client_id }, |
126
|
|
|
|
|
|
|
client_secret => $cache->{ client_secret }, |
127
|
0
|
|
|
|
|
|
grant_type => 'refresh_token', |
128
|
|
|
|
|
|
|
}, |
129
|
|
|
|
|
|
|
$self->token_refresh_authorization_header(), |
130
|
|
|
|
|
|
|
); |
131
|
|
|
|
|
|
|
|
132
|
0
|
|
|
|
|
|
my $ua = LWP::UserAgent->new(); |
133
|
0
|
|
|
|
|
|
my $resp = $ua->request($req); |
134
|
|
|
|
|
|
|
|
135
|
0
|
0
|
|
|
|
|
if( $resp->is_success() ) { |
136
|
0
|
|
|
|
|
|
my $data = |
137
|
|
|
|
|
|
|
from_json( $resp->content() ); |
138
|
|
|
|
|
|
|
|
139
|
0
|
|
|
|
|
|
DEBUG "Token refreshed, will expire in $data->{ expires_in } seconds"; |
140
|
|
|
|
|
|
|
|
141
|
0
|
|
|
|
|
|
$cache->{ access_token } = $data->{ access_token }; |
142
|
0
|
|
|
|
|
|
$cache->{ expires } = $data->{ expires_in } + time(); |
143
|
|
|
|
|
|
|
|
144
|
0
|
|
|
|
|
|
$self->cache_write( $cache ); |
145
|
0
|
|
|
|
|
|
return 1; |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
0
|
|
|
|
|
|
ERROR "Token refresh failed: ", $resp->status_line(); |
149
|
0
|
|
|
|
|
|
return undef; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
########################################### |
153
|
|
|
|
|
|
|
sub token_expired { |
154
|
|
|
|
|
|
|
########################################### |
155
|
0
|
|
|
0
|
1
|
|
my( $self ) = @_; |
156
|
|
|
|
|
|
|
|
157
|
0
|
|
|
|
|
|
my $cache = $self->cache_read(); |
158
|
|
|
|
|
|
|
|
159
|
0
|
|
|
|
|
|
my $time_remaining = $cache->{ expires } - time(); |
160
|
|
|
|
|
|
|
|
161
|
0
|
0
|
|
|
|
|
if( $time_remaining < 300 ) { |
162
|
0
|
0
|
|
|
|
|
if( $time_remaining < 0 ) { |
163
|
0
|
|
|
|
|
|
DEBUG "Token expired ", -$time_remaining, " seconds ago"; |
164
|
|
|
|
|
|
|
} else { |
165
|
0
|
|
|
|
|
|
DEBUG "Token will expire in $time_remaining seconds"; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
0
|
|
|
|
|
|
DEBUG "Token needs to be refreshed."; |
169
|
0
|
|
|
|
|
|
return 1; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
0
|
|
|
|
|
|
return 0; |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
########################################### |
176
|
|
|
|
|
|
|
sub token_expire { |
177
|
|
|
|
|
|
|
########################################### |
178
|
0
|
|
|
0
|
1
|
|
my( $self ) = @_; |
179
|
|
|
|
|
|
|
|
180
|
0
|
|
|
|
|
|
my $cache = $self->cache_read(); |
181
|
|
|
|
|
|
|
|
182
|
0
|
|
|
|
|
|
$cache->{ expires } = time() - 1; |
183
|
0
|
|
|
|
|
|
$self->cache_write( $cache ); |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
########################################### |
187
|
|
|
|
|
|
|
sub cache_read { |
188
|
|
|
|
|
|
|
########################################### |
189
|
0
|
|
|
0
|
0
|
|
my( $self ) = @_; |
190
|
|
|
|
|
|
|
|
191
|
0
|
0
|
|
|
|
|
if( ! -f $self->cache_file_path ) { |
192
|
0
|
|
|
|
|
|
LOGDIE "Cache file ", $self->cache_file_path, " not found. ", |
193
|
|
|
|
|
|
|
"See GETTING STARTED in the docs for how to get started."; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
0
|
|
|
|
|
|
return LoadFile $self->cache_file_path; |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
########################################### |
200
|
|
|
|
|
|
|
sub cache_write { |
201
|
|
|
|
|
|
|
########################################### |
202
|
0
|
|
|
0
|
0
|
|
my( $self, $cache ) = @_; |
203
|
|
|
|
|
|
|
|
204
|
0
|
|
|
|
|
|
my $old_umask = umask 0177; |
205
|
|
|
|
|
|
|
|
206
|
0
|
|
|
|
|
|
DumpFile $self->cache_file_path, $cache; |
207
|
|
|
|
|
|
|
|
208
|
0
|
|
|
|
|
|
umask $old_umask; |
209
|
0
|
|
|
|
|
|
return 1; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
########################################### |
213
|
|
|
|
|
|
|
sub tokens_get { |
214
|
|
|
|
|
|
|
########################################### |
215
|
0
|
|
|
0
|
0
|
|
my( $self, $code ) = @_; |
216
|
|
|
|
|
|
|
|
217
|
0
|
|
|
|
|
|
my $req = &HTTP::Request::Common::POST( |
218
|
|
|
|
|
|
|
$self->token_uri, |
219
|
|
|
|
|
|
|
[ |
220
|
|
|
|
|
|
|
code => $code, |
221
|
|
|
|
|
|
|
client_id => $self->client_id, |
222
|
|
|
|
|
|
|
client_secret => $self->client_secret, |
223
|
|
|
|
|
|
|
redirect_uri => $self->redirect_uri, |
224
|
|
|
|
|
|
|
grant_type => 'authorization_code', |
225
|
|
|
|
|
|
|
] |
226
|
|
|
|
|
|
|
); |
227
|
|
|
|
|
|
|
|
228
|
0
|
|
|
|
|
|
my $ua = LWP::UserAgent->new(); |
229
|
0
|
|
|
|
|
|
my $resp = $ua->request($req); |
230
|
|
|
|
|
|
|
|
231
|
0
|
0
|
|
|
|
|
if( $resp->is_success() ) { |
232
|
0
|
|
|
|
|
|
my $json = $resp->content(); |
233
|
0
|
|
|
|
|
|
DEBUG "Received: [$json]", |
234
|
|
|
|
|
|
|
my $data = from_json( $json ); |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
return ( $data->{ access_token }, |
237
|
|
|
|
|
|
|
$data->{ refresh_token }, |
238
|
0
|
|
|
|
|
|
$data->{ expires_in } ); |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
0
|
|
|
|
|
|
LOGDIE $resp->status_line(); |
242
|
0
|
|
|
|
|
|
return undef; |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
########################################### |
246
|
|
|
|
|
|
|
sub tokens_collect { |
247
|
|
|
|
|
|
|
########################################### |
248
|
0
|
|
|
0
|
0
|
|
my( $self, $code ) = @_; |
249
|
|
|
|
|
|
|
|
250
|
0
|
|
|
|
|
|
my( $access_token, $refresh_token, |
251
|
|
|
|
|
|
|
$expires_in ) = $self->tokens_get( $code ); |
252
|
|
|
|
|
|
|
|
253
|
0
|
|
|
|
|
|
my $cache = { |
254
|
|
|
|
|
|
|
access_token => $access_token, |
255
|
|
|
|
|
|
|
refresh_token => $refresh_token, |
256
|
|
|
|
|
|
|
client_id => $self->client_id, |
257
|
|
|
|
|
|
|
client_secret => $self->client_secret, |
258
|
|
|
|
|
|
|
expires => time() + $expires_in, |
259
|
|
|
|
|
|
|
token_uri => $self->token_uri, |
260
|
|
|
|
|
|
|
}; |
261
|
|
|
|
|
|
|
|
262
|
0
|
|
|
|
|
|
$self->cache_write( $cache ); |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
########################################### |
266
|
|
|
|
|
|
|
sub http_get { |
267
|
|
|
|
|
|
|
########################################### |
268
|
0
|
|
|
0
|
0
|
|
my( $self, $url, $query ) = @_; |
269
|
|
|
|
|
|
|
|
270
|
0
|
|
|
|
|
|
my $ua = LWP::UserAgent->new(); |
271
|
|
|
|
|
|
|
|
272
|
0
|
|
|
|
|
|
my $uri = URI->new( $url ); |
273
|
0
|
0
|
|
|
|
|
$uri->query_form( @$query ) if defined $query; |
274
|
|
|
|
|
|
|
|
275
|
0
|
|
|
|
|
|
DEBUG "Fetching $uri"; |
276
|
|
|
|
|
|
|
|
277
|
0
|
|
|
|
|
|
my $resp = $ua->get( $uri, |
278
|
|
|
|
|
|
|
$self->authorization_headers, @$query ); |
279
|
|
|
|
|
|
|
|
280
|
0
|
0
|
|
|
|
|
if( $resp->is_error ) { |
281
|
0
|
0
|
|
|
|
|
if( $self->raise_error ) { |
282
|
0
|
|
|
|
|
|
die $resp->message; |
283
|
|
|
|
|
|
|
} |
284
|
0
|
|
|
|
|
|
return undef; |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
|
287
|
0
|
|
|
|
|
|
return $resp->decoded_content; |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
########################################### |
291
|
|
|
|
|
|
|
sub client_init_conf_check { |
292
|
|
|
|
|
|
|
########################################### |
293
|
0
|
|
|
0
|
0
|
|
my( $self, $url ) = @_; |
294
|
|
|
|
|
|
|
|
295
|
0
|
|
|
|
|
|
my $conf = { }; |
296
|
0
|
0
|
|
|
|
|
if( -f $self->cache_file_path ) { |
297
|
0
|
|
|
|
|
|
$conf = $self->cache_read(); |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
0
|
0
|
0
|
|
|
|
if( !exists $conf->{ client_id } or |
301
|
|
|
|
|
|
|
!exists $conf->{ client_secret } ) { |
302
|
0
|
|
|
|
|
|
die "You need to register your application on " . |
303
|
|
|
|
|
|
|
"$url and add the client_id and " . |
304
|
|
|
|
|
|
|
"client_secret entries to " . $self->cache_file_path . "\n"; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
|
307
|
0
|
|
|
|
|
|
$self->client_id( $conf->{ client_id } ); |
308
|
0
|
|
|
|
|
|
$self->client_secret( $conf->{ client_secret } ); |
309
|
|
|
|
|
|
|
|
310
|
0
|
|
|
|
|
|
return 1; |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
1; |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
__END__ |