File Coverage

blib/lib/OAuth/Cmdline.pm
Criterion Covered Total %
statement 33 137 24.0
branch 0 30 0.0
condition 0 3 0.0
subroutine 11 28 39.2
pod 3 17 17.6
total 47 215 21.8


line stmt bran cond sub pod time code
1             ###########################################
2             package OAuth::Cmdline;
3             ###########################################
4 3     3   446 use strict;
  3         5  
  3         66  
5 3     3   11 use warnings;
  3         5  
  3         55  
6 3     3   1170 use URI;
  3         10249  
  3         81  
7 3     3   1124 use YAML qw( DumpFile LoadFile );
  3         15846  
  3         142  
8 3     3   1222 use HTTP::Request::Common;
  3         40574  
  3         208  
9 3     3   21 use URI;
  3         4  
  3         74  
10 3     3   1584 use LWP::UserAgent;
  3         66252  
  3         125  
11 3     3   2775 use Log::Log4perl qw(:easy);
  3         116178  
  3         15  
12 3     3   1675 use JSON qw( from_json );
  3         6  
  3         24  
13 3     3   298 use MIME::Base64;
  3         5  
  3         135  
14 3     3   1131 use Moo;
  3         16859  
  3         21  
15              
16             our $VERSION = '0.07'; # VERSION
17             # ABSTRACT: OAuth2 for command line applications using web services
18              
19             has client_id => ( is => "rw" );
20             has client_secret => ( is => "rw" );
21             has local_uri => (
22             is => "rw",
23             default => "http://localhost:8082",
24             );
25             has homedir => (
26             is => "ro",
27             default => glob '~',
28             );
29             has base_uri => ( is => "rw" );
30             has login_uri => ( is => "rw" );
31             has site => ( is => "rw" );
32             has scope => ( is => "rw" );
33             has token_uri => ( is => "rw" );
34             has redir_uri => ( is => "rw" );
35             has access_type => ( is => "rw" );
36             has raise_error => ( is => "rw" );
37              
38             ###########################################
39             sub redirect_uri {
40             ###########################################
41 0     0 0   my( $self ) = @_;
42              
43 0           return $self->local_uri . "/callback";
44             }
45              
46             ###########################################
47             sub cache_file_path {
48             ###########################################
49 0     0 0   my( $self ) = @_;
50              
51             # creds saved ~/.[site].yml
52 0           return $self->homedir . "/." .
53             $self->site . ".yml";
54             }
55              
56             ###########################################
57             sub full_login_uri {
58             ###########################################
59 0     0 0   my( $self ) = @_;
60              
61 0           my $full_login_uri = URI->new( $self->login_uri );
62              
63 0 0         $full_login_uri->query_form (
    0          
64             client_id => $self->client_id(),
65             response_type => "code",
66             (defined $self->redirect_uri() ?
67             ( redirect_uri => $self->redirect_uri() ) :
68             ()
69             ),
70             scope => $self->scope(),
71             ($self->access_type() ?
72             (access_type => $self->access_type()) : ()),
73             );
74              
75 0           DEBUG "full login uri: $full_login_uri";
76 0           return $full_login_uri;
77             }
78              
79             ###########################################
80             sub access_token {
81             ###########################################
82 0     0 0   my( $self ) = @_;
83              
84 0 0         if( $self->token_expired() ) {
85 0 0         $self->token_refresh() or LOGDIE "Token refresh failed";
86             }
87              
88 0           my $cache = $self->cache_read();
89 0           return $cache->{ access_token };
90             }
91              
92             ###########################################
93             sub authorization_headers {
94             ###########################################
95 0     0 1   my( $self ) = @_;
96              
97             return (
98 0           'Authorization' =>
99             'Bearer ' . $self->access_token
100             );
101             }
102              
103             ###########################################
104             sub token_refresh_authorization_header {
105             ###########################################
106 0     0 0   my( $self ) = @_;
107              
108 0           return ();
109             }
110              
111             ###########################################
112             sub token_refresh {
113             ###########################################
114 0     0 0   my( $self ) = @_;
115              
116 0           DEBUG "Refreshing access token";
117              
118 0           my $cache = $self->cache_read();
119              
120 0           $self->token_uri( $cache->{ token_uri } );
121              
122             my $req = &HTTP::Request::Common::POST(
123             $self->token_uri,
124             {
125             refresh_token => $cache->{ refresh_token },
126             client_id => $cache->{ client_id },
127             client_secret => $cache->{ client_secret },
128 0           grant_type => 'refresh_token',
129             },
130             $self->token_refresh_authorization_header(),
131             );
132              
133 0           my $ua = LWP::UserAgent->new();
134 0           my $resp = $ua->request($req);
135              
136 0 0         if( $resp->is_success() ) {
137 0           my $data =
138             from_json( $resp->content() );
139              
140 0           DEBUG "Token refreshed, will expire in $data->{ expires_in } seconds";
141              
142 0           $cache->{ access_token } = $data->{ access_token };
143 0           $cache->{ expires } = $data->{ expires_in } + time();
144              
145 0           ($cache, $data) = $self->update_refresh_token($cache, $data);
146              
147 0           $self->cache_write( $cache );
148 0           return 1;
149             }
150              
151 0           ERROR "Token refresh failed: ", $resp->status_line();
152 0           return undef;
153             }
154              
155             ###########################################
156             sub update_refresh_token {
157             ###########################################
158 0     0 0   my( $self, $cache, $data ) = @_;
159            
160 0           return ($cache, $data);
161             }
162              
163             ###########################################
164             sub token_expired {
165             ###########################################
166 0     0 1   my( $self ) = @_;
167              
168 0           my $cache = $self->cache_read();
169              
170 0           my $time_remaining = $cache->{ expires } - time();
171              
172 0 0         if( $time_remaining < 300 ) {
173 0 0         if( $time_remaining < 0 ) {
174 0           DEBUG "Token expired ", -$time_remaining, " seconds ago";
175             } else {
176 0           DEBUG "Token will expire in $time_remaining seconds";
177             }
178              
179 0           DEBUG "Token needs to be refreshed.";
180 0           return 1;
181             }
182              
183 0           return 0;
184             }
185              
186             ###########################################
187             sub token_expire {
188             ###########################################
189 0     0 1   my( $self ) = @_;
190              
191 0           my $cache = $self->cache_read();
192              
193 0           $cache->{ expires } = time() - 1;
194 0           $self->cache_write( $cache );
195             }
196              
197             ###########################################
198             sub cache_read {
199             ###########################################
200 0     0 0   my( $self ) = @_;
201              
202 0 0         if( ! -f $self->cache_file_path ) {
203 0           LOGDIE "Cache file ", $self->cache_file_path, " not found. ",
204             "See GETTING STARTED in the docs for how to get started.";
205             }
206              
207 0           return LoadFile $self->cache_file_path;
208             }
209              
210             ###########################################
211             sub cache_write {
212             ###########################################
213 0     0 0   my( $self, $cache ) = @_;
214              
215 0           my $old_umask = umask 0177;
216              
217 0           DumpFile $self->cache_file_path, $cache;
218              
219 0           umask $old_umask;
220 0           return 1;
221             }
222              
223             ###########################################
224             sub tokens_get_additional_params {
225             ###########################################
226 0     0 0   my( $self, $params ) = @_;
227              
228 0           return $params;
229             }
230              
231             ###########################################
232             sub tokens_get {
233             ###########################################
234 0     0 0   my( $self, $code ) = @_;
235              
236 0           my $req = &HTTP::Request::Common::POST(
237             $self->token_uri, $self->tokens_get_additional_params(
238             [
239             code => $code,
240             client_id => $self->client_id,
241             client_secret => $self->client_secret,
242             redirect_uri => $self->redirect_uri,
243             grant_type => 'authorization_code',
244             ])
245             );
246              
247 0           my $ua = LWP::UserAgent->new();
248 0           my $resp = $ua->request($req);
249              
250 0 0         if( $resp->is_success() ) {
251 0           my $json = $resp->content();
252 0           DEBUG "Received: [$json]";
253 0           my $data = from_json( $json );
254              
255             return ( $data->{ access_token },
256             $data->{ refresh_token },
257 0           $data->{ expires_in } );
258             }
259              
260 0           my $error;
261 0           eval {
262 0           my $json = $resp->content();
263 0           DEBUG "Received: [$json]",
264             my $data = from_json( $json );
265 0           $error = $data->{'error'};
266             };
267             # An exception will be thrown if the content is not JSON
268 0 0         if ($@) {
269 0           $error = $resp->content();
270             }
271              
272 0           LOGDIE $resp->status_line() . ' - ' . $error . "\n";
273 0           return undef;
274             }
275              
276             ###########################################
277             sub tokens_collect {
278             ###########################################
279 0     0 0   my( $self, $code ) = @_;
280              
281 0           my( $access_token, $refresh_token,
282             $expires_in ) = $self->tokens_get( $code );
283              
284 0           my $cache = {
285             access_token => $access_token,
286             refresh_token => $refresh_token,
287             client_id => $self->client_id,
288             client_secret => $self->client_secret,
289             expires => time() + $expires_in,
290             token_uri => $self->token_uri,
291             };
292              
293 0           $self->cache_write( $cache );
294             }
295              
296             ###########################################
297             sub http_get {
298             ###########################################
299 0     0 0   my( $self, $url, $query ) = @_;
300              
301 0           my $ua = LWP::UserAgent->new();
302              
303 0           my $uri = URI->new( $url );
304 0 0         $uri->query_form( @$query ) if defined $query;
305              
306 0           DEBUG "Fetching $uri";
307              
308 0           my $resp = $ua->get( $uri,
309             $self->authorization_headers, @$query );
310              
311 0 0         if( $resp->is_error ) {
312 0 0         if( $self->raise_error ) {
313 0           die $resp->message;
314             }
315 0           return undef;
316             }
317              
318 0           return $resp->decoded_content;
319             }
320              
321             ###########################################
322             sub client_init_conf_check {
323             ###########################################
324 0     0 0   my( $self, $url ) = @_;
325              
326 0           my $conf = { };
327 0 0         if( -f $self->cache_file_path ) {
328 0           $conf = $self->cache_read();
329             }
330              
331 0 0 0       if( !exists $conf->{ client_id } or
332             !exists $conf->{ client_secret } ) {
333 0           die "You need to register your application on " .
334             "$url and add the client_id and " .
335             "client_secret entries to " . $self->cache_file_path . "\n";
336             }
337            
338 0           $self->client_id( $conf->{ client_id } );
339 0           $self->client_secret( $conf->{ client_secret } );
340              
341 0           return 1;
342             }
343              
344             1;
345              
346             __END__
347              
348             =pod
349              
350             =encoding UTF-8
351              
352             =head1 NAME
353              
354             OAuth::Cmdline - OAuth2 for command line applications using web services
355              
356             =head1 VERSION
357              
358             version 0.07
359              
360             =head1 SYNOPSIS
361              
362             # Use a site-specific class instead of the parent class, see
363             # description below for generic cases
364              
365             my $oauth = OAuth::Cmdline::GoogleDrive->new( );
366             $oauth->access_token();
367              
368             =head1 DESCRIPTION
369              
370             OAuth::Cmdline helps standalone command line scripts to deal with
371             web services requiring OAuth access tokens.
372              
373             =head1 WARNING: LIMITED ALPHA RELEASE
374              
375             While C<OAuth::Cmdline> has been envisioned to work with
376             various OAuth-controlled web services, it is currently tested with the
377             following services, shown below with their subclasses:
378              
379             =over
380              
381             =item B<OAuth::Cmdline::GoogleDrive>
382             - Google Drive
383              
384             =item B<OAuth::Cmdline::Spotify>
385             - Spotify
386              
387             =item B<OAuth::Cmdline::MicrosoftOnline>
388             - Azure AD and other OAuth2-authenticated services that use the Microsoft
389             Online common authentication endpoint (tested with Azure AD via the Graph
390             API)
391              
392             =item B<OAuth::Cmdline::Automatic>
393             - Automatic.com car plugin
394              
395             =item B<OAuth::Cmdline::Youtube>
396             - Youtube viewer reports
397              
398             =item B<OAuth::Cmdline::Smartthings>
399             - Smartthings API
400              
401             =back
402              
403             If you want to use this module for a different service, go ahead and try
404             it, it might just as well work. In this case, specify the C<site> parameter,
405             which determines the name of the cache file with the access token and
406             other settings in your home directory:
407              
408             # Will use standard OAuth techniques and save your
409             # tokens in ~/.some-other.site.yml
410             my $oauth = OAuth::Cmdline->new( site => "some-other-site" );
411              
412             =head1 GETTING STARTED
413              
414             To obtain the initial set of access and refresh tokens from the
415             OAuth-controlled site, you need to register your command line app
416             with the site and you'll get a "Client ID" and a "Client Secret"
417             in return. Also, the site's SDK will point out the "Login URI" and
418             the "Token URI" to be used with the particular service.
419             Then, run the following script (the example uses the Spotify web service)
420              
421             use OAuth::Cmdline;
422             use OAuth::Cmdline::Mojo;
423              
424             my $oauth = OAuth::Cmdline::GoogleDrive->new(
425             client_id => "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",
426             client_secret => "YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY",
427             login_uri => "https://accounts.google.com/o/oauth2/auth",
428             token_uri => "https://accounts.google.com/o/oauth2/token",
429             scope => "user-read-private",
430             );
431            
432             my $app = OAuth::Cmdline::Mojo->new(
433             oauth => $oauth,
434             );
435            
436             $app->start( 'daemon', '-l', $oauth->local_uri );
437              
438             and point a browser to the URL displayed at startup. Clicking on the
439             link displayed will take you to the OAuth-controlled site, where you need
440             to log in and allow the app access to the user data, following the flow
441             provided on the site. The site will then redirect to the web server
442             started by the script, which will receive an initial access token with
443             an expiration date and a refresh token from the site, and store it locally
444             in the cache file in your home directory (~/.sitename.yml).
445              
446             =head1 ACCESS TOKEN ACCESS
447              
448             Once the cache file has been initialized, the application can use the
449             C<access_token()> method in order to get a valid access token. If
450             C<OAuth::Cmdline> finds out that the cached access token is expired,
451             it'll automatically refresh it for you behind the scenes.
452              
453             C<OAuth::Cmdline> also offers a convenience function for providing a hash
454             with authorization headers for use with LWP::UserAgent:
455              
456             my $resp = $ua->get( $url, $oauth->authorization_headers );
457              
458             This will create an "Authorization" header based on the access token and
459             include it in the request to the web service.
460              
461             =head2 Public Methods
462              
463             =over 4
464              
465             =item C<new()>
466              
467             Instantiate a new OAuth::Cmdline::XXX object. XXX stands for the specific
468             site's implementation, and can be "GoogleDrive" or one of the other
469             subclasses listed above.
470              
471             =item C<authorization_headers()>
472              
473             Returns the HTTP header name and value the specific site requires for
474             authentication. For example, in GoogleDrive's case, the values are:
475              
476             AuthorizationBearer xxxxx.yyy
477              
478             The method is used to pass the authentication header key and value
479             to an otherwise unauthenticated web request, like
480              
481             my $resp = $ua->get( $url, $oauth->authorization_headers );
482              
483             =item C<token_expired()>
484              
485             (Internal) Check if the access token is expired and will be refreshed
486             on the next call of C<authorization_headers()>.
487              
488             =item C<token_expire()>
489              
490             Force the expiration of the access token, so that the next request
491             obtains a new one.
492              
493             =back
494              
495             =head1 AUTHOR
496              
497             Mike Schilli <cpan@perlmeister.com>
498              
499             =head1 COPYRIGHT AND LICENSE
500              
501             This software is copyright (c) 2022 by Mike Schilli.
502              
503             This is free software; you can redistribute it and/or modify it under
504             the same terms as the Perl 5 programming language system itself.
505              
506             =cut