| 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__ |