Skip to content

Commit 8447f59

Browse files
author
Igor Afanasyev
committed
Initial commit
0 parents  commit 8447f59

File tree

8 files changed

+358
-0
lines changed

8 files changed

+358
-0
lines changed

‎.gitignore

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
~*
2+
.DS_Store
3+
.vscode

‎AUTHORS

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
AUTHOR / MAINTAINER
2+
3+
Igor Afanasyev <igor.afanasyev@gmail.com>

‎MIT-LICENSE.txt

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
Copyright (c) 2020 Igor Afanasyev, https://github.com/loctools/perl-loctools-net
2+
3+
Permission is hereby granted, free of charge, to any person obtaining
4+
a copy of this software and associated documentation files (the
5+
"Software"), to deal in the Software without restriction, including
6+
without limitation the rights to use, copy, modify, merge, publish,
7+
distribute, sublicense, and/or sell copies of the Software, and to
8+
permit persons to whom the Software is furnished to do so, subject to
9+
the following conditions:
10+
11+
The above copyright notice and this permission notice shall be
12+
included in all copies or substantial portions of the Software.
13+
14+
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
15+
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
16+
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
17+
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
18+
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
19+
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
20+
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

‎README.md

Lines changed: 42 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,42 @@
1+
# Loctools::Net
2+
3+
A collection of utility modules to simplify working with HTTP and OAuth2-based services.
4+
5+
## Loctools::Net::OAuth2::Session
6+
7+
This is a wrapper on top of `Net::OAuth2::Profile::WebServer` that implements a session that persists in a file. It allows you to authorize the application on first use, and then loads the session from disk and renews the token automatically.
8+
9+
## Loctools::Net::OAuth2::Session::Google
10+
11+
This module is a wrapper on top of `Loctools::Net::OAuth2::Session` that presets Google OAuth2 parameters.
12+
13+
## Loctools::Net::HTTP::Client
14+
15+
This is a wrapper on top of `LWP::UserAgent` that implements HTTP requests with exponential back-off and automatic OAuth session renewal.
16+
17+
## Installation
18+
19+
$ cpan Loctools::Net
20+
21+
## Usage
22+
23+
```perl
24+
use Loctools::Net::OAuth2::Session::Google;
25+
use Loctools::Net::HTTP::Client;
26+
27+
my $session = Loctools::Net::OAuth2::Session::Google->new(
28+
client_id => '<my-client-id>',
29+
client_secret => '<my-client-secret>',
30+
scope => '<scope-id>',
31+
session_file => './oauth2-session.json',
32+
);
33+
34+
# this will automatically load the session,
35+
# renew the token if it is expired,
36+
# or show the authorization prompt in the console
37+
my $client = Loctools::Net::HTTP::Client->new(session => $session);
38+
39+
# $client->get('https://...');
40+
# $client->post_json('https://...', { ... });
41+
# ...
42+
```

‎lib/Loctools/Net.pm

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
=head1 NAME
2+
3+
Loctools::Net - Shared network-related modules
4+
5+
=head1 DESCRIPTION
6+
7+
A collection of shared modules to simplify working
8+
with HTTP and OAuth2-based services.
9+
10+
=head1 COPYRIGHT
11+
12+
Copyright (C) 2019, Igor Afanasyev.
13+
14+
=head1 SEE ALSO
15+
16+
L<https://github.com/loctools/perl-loctools-net>
17+
18+
=cut
19+
20+
package Loctools::Net;
21+
22+
our $VERSION = '1.0';
23+
24+
1;

‎lib/Loctools/Net/HTTP/Client.pm

Lines changed: 125 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,125 @@
1+
package Loctools::Net::HTTP::Client;
2+
3+
use strict;
4+
5+
use HTTP::Headers;
6+
use HTTP::Request;
7+
use LWP::UserAgent;
8+
use JSON qw(decode_json encode_json);
9+
10+
my $DEFAULT_MAX_RETRIES = 5;
11+
12+
sub new {
13+
my ($class, %params) = @_;
14+
15+
my $self => {
16+
max_retries => $DEFAULT_MAX_RETRIES,
17+
};
18+
19+
$self->{max_retries} = $params{max_retries} if defined $params{max_retries};
20+
21+
$self->{ua} = LWP::UserAgent->new();
22+
$self->{ua}->cookie_jar({});
23+
24+
if (defined $params{session}) {
25+
$self->{session} = $params{session};
26+
$self->{session}->start;
27+
}
28+
29+
bless $self, $class;
30+
return $self;
31+
}
32+
33+
# do the request with an exponential back-off
34+
sub request {
35+
my ($self, $method, $url, $raw_content, $headers) = @_;
36+
37+
my $attempt = 1;
38+
my $code;
39+
my $content;
40+
while (1) {
41+
if ($attempt > 1) {
42+
print "Attempt #".$attempt."\n";
43+
}
44+
# upgrade headers hash to HTTP::Headers
45+
$headers = {} unless defined $headers;
46+
bless($headers, 'HTTP::Headers');
47+
48+
my $request = HTTP::Request->new($method, $url, $headers, $raw_content);
49+
if (defined $raw_content) {
50+
my $len = length($raw_content);
51+
$request->header('Content-Length', $len);
52+
}
53+
if (defined $self->{session}) {
54+
$request->header($self->{session}->authorization_header);
55+
}
56+
57+
my $response = $self->{ua}->request($request);
58+
$code = $response->code;
59+
$content = $response->content;
60+
61+
last if ($code == 200 || $attempt >= $self->{max_retries});
62+
63+
my $need_sleep = 1;
64+
65+
if ($code == 401) {
66+
if (defined $self->{session}) {
67+
$self->{session}->renew;
68+
$need_sleep = undef if $attempt == 1; # don't sleep the first time
69+
}
70+
} elsif ($code =~ m/^(500|503)$/) {
71+
# one of the known error codes, just retry
72+
} else {
73+
last; # unexpected error code
74+
}
75+
76+
if ($code != 200) {
77+
my $sleep_time = $need_sleep ? 2**$attempt : 0;
78+
79+
warn "Server returned error #", "$code when requesting the URL ",
80+
$self->{ua}->{_res}->base(), ", will make attempt #", "$attempt in $sleep_time seconds\n";
81+
82+
sleep $sleep_time if $need_sleep;
83+
$attempt++;
84+
}
85+
}
86+
87+
if ($code != 200) {
88+
warn "Server returned error #", $code, " after $attempt attempt(s). Won't continue.\n";
89+
warn "Returned content:\n\n===========\n$content\n===========\n\n";
90+
}
91+
92+
return $code, $content;
93+
}
94+
95+
sub get {
96+
my $self = shift;
97+
return $self->request('GET', @_);
98+
}
99+
100+
sub put {
101+
my $self = shift;
102+
return $self->request('PUT', @_);
103+
}
104+
105+
sub post {
106+
my $self = shift;
107+
return $self->request('POST', @_);
108+
}
109+
110+
sub post_json {
111+
my ($self, $url, $content, $headers) = @_;
112+
return $self->post($url, encode_json($content), _add_json_header($headers));
113+
}
114+
115+
sub put_json {
116+
my ($self, $url, $content, $headers) = @_;
117+
return $self->put($url, encode_json($content), _add_json_header($headers));
118+
}
119+
120+
sub _add_json_header {
121+
my $headers = shift;
122+
$headers = {} unless defined $headers;
123+
$headers->{'Content-type'} = 'application/json; charset=UTF-8';
124+
return $headers;
125+
}

‎lib/Loctools/Net/OAuth2/Session.pm

Lines changed: 116 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,116 @@
1+
package Loctools::Net::OAuth2::Session;
2+
3+
use strict;
4+
5+
use JSON qw(decode_json encode_json);
6+
use Net::OAuth2::Profile::WebServer;
7+
8+
sub new {
9+
my ($class, %params) = @_;
10+
11+
my $session_file = $params{session_file};
12+
die "session_file parameter not provided" if $session_file eq '';
13+
delete $params{session_file};
14+
15+
my $auth = Net::OAuth2::Profile::WebServer->new(%params);
16+
17+
my $self = {
18+
session_file => $session_file,
19+
auth => $auth,
20+
};
21+
22+
bless $self, $class;
23+
return $self;
24+
}
25+
26+
sub start {
27+
my ($self) = @_;
28+
29+
if (-f $self->{session_file}) {
30+
$self->load;
31+
32+
if ($self->{token}->expired) {
33+
warn "OAuth2 token expired, renewing\n";
34+
$self->renew;
35+
}
36+
} else {
37+
warn "\nOAuth2 session file not found. You will need to authorize your application once.\n\n";
38+
$self->authorize;
39+
}
40+
}
41+
42+
sub access_token {
43+
my ($self) = @_;
44+
return $self->{token}->access_token;
45+
}
46+
47+
sub authorization_header {
48+
my ($self) = @_;
49+
return (Authorization => "Bearer ".$self->access_token);
50+
}
51+
52+
sub load {
53+
my ($self) = @_;
54+
warn "Loading OAuth2 session from $self->{session_file}\n";
55+
my $session = _load_json($self->{session_file}) or die $!;
56+
$self->{token} = Net::OAuth2::AccessToken->session_thaw(
57+
$session, profile => $self->{auth}
58+
);
59+
}
60+
61+
sub authorize {
62+
my ($self) = @_;
63+
64+
my $response = $self->{auth}->authorize_response;
65+
my $url = $response->headers->{location};
66+
67+
print "1) Open this URL in your browser:\n\n";
68+
print "$url\n\n";
69+
print "2) Authorize the application\n";
70+
print "3) Copy the authorization code and paste it here.\n\n";
71+
72+
my $code;
73+
while (1) {
74+
print "Code: ";
75+
$code = <STDIN>; # wait for input
76+
chomp $code;
77+
last if $code ne '';
78+
}
79+
80+
$self->{token} = $self->{auth}->get_access_token($code);
81+
$self->save;
82+
}
83+
84+
sub renew {
85+
my ($self) = @_;
86+
$self->{auth}->update_access_token($self->{token});
87+
$self->save;
88+
}
89+
90+
sub save {
91+
my ($self) = @_;
92+
warn "Saving OAuth2 session to $self->{session_file}\n";
93+
_save_json($self->{session_file}, $self->{token}->session_freeze());
94+
}
95+
96+
sub _load_json {
97+
my ($filename) = @_;
98+
open IN, $filename || die "Can't read from file '$filename': $!";
99+
binmode IN;
100+
my $raw = join('', <IN>);
101+
close IN;
102+
return decode_json($raw);
103+
}
104+
105+
sub _save_json {
106+
my ($filename, $data) = @_;
107+
my $raw = encode_json($data);
108+
open OUT, ">$filename" || die "Can't write to file '$filename': $!";
109+
binmode(OUT);
110+
print OUT $raw;
111+
close OUT;
112+
}
113+
114+
115+
116+
1;

‎lib/Loctools/Net/OAuth2/Session/Google.pm

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,25 @@
1+
package Loctools::Net::OAuth2::Session::Google;
2+
use parent Loctools::Net::OAuth2::Session;
3+
4+
use strict;
5+
6+
sub new {
7+
my ($class, %params) = @_;
8+
9+
my $defautls = {
10+
site => 'https://accounts.google.com',
11+
authorize_path => '/o/oauth2/auth',
12+
access_token_path => '/o/oauth2/token',
13+
refresh_token_path => '/o/oauth2/token',
14+
response_type => 'code',
15+
redirect_uri => 'urn:ietf:wg:oauth:2.0:oob',
16+
};
17+
18+
map {
19+
$params{$_} = $defautls->{$_} unless exists $params{$_};
20+
} keys %$defautls;
21+
22+
return $class->SUPER::new(%params);
23+
}
24+
25+
1;

0 commit comments

Comments
 (0)