File Coverage

blib/lib/Net/HTTP/Spore/Middleware/Auth/OAuth.pm
Criterion Covered Total %
statement 73 84 86.9
branch 16 28 57.1
condition 7 22 31.8
subroutine 10 10 100.0
pod 0 1 0.0
total 106 145 73.1


line stmt bran cond sub pod time code
1             package Net::HTTP::Spore::Middleware::Auth::OAuth;
2             $Net::HTTP::Spore::Middleware::Auth::OAuth::VERSION = '0.07';
3             # ABSTRACT: middleware for OAuth authentication
4              
5 1     1   563 use Moose;
  1         3  
  1         7  
6 1     1   5682 use URI::Escape;
  1         2  
  1         50  
7 1     1   307 use Digest::SHA;
  1         2126  
  1         42  
8 1     1   7 use MIME::Base64;
  1         1  
  1         850  
9              
10             extends 'Net::HTTP::Spore::Middleware::Auth';
11              
12             has [qw/oauth_consumer_key oauth_consumer_secret/] => (
13             is => 'ro',
14             isa => 'Str',
15             required => 1,
16             );
17              
18             has oauth_callback => (
19             is => 'ro',
20             isa => 'Str',
21             lazy => 1,
22             default => 'oob',
23             );
24              
25             has oauth_signature_method => (
26             is => 'ro',
27             isa => 'Str',
28             lazy => 1,
29             default => 'HMAC-SHA1',
30             );
31              
32             has [qw/oauth_token oauth_token_secret oauth_verifier realm/] => (
33             is => 'ro',
34             isa => 'Str',
35             );
36              
37             sub call {
38 3     3 0 7 my ( $self, $req ) = @_;
39              
40 3 50       15 return unless $self->should_authenticate($req);
41              
42 3         88 my $oauth_params = {
43             oauth_signature_method => $self->oauth_signature_method,
44             oauth_consumer_key => $self->oauth_consumer_key,
45             oauth_token => $self->oauth_token,
46             oauth_verifier => $self->oauth_verifier,
47             oauth_version => '1.0',
48             };
49              
50 3 100       10 if ( !defined $oauth_params->{oauth_token} ) {
51 2         56 $oauth_params->{oauth_callback} = $self->oauth_callback;
52             }
53              
54 3         10 foreach my $k ( keys %$oauth_params ) {
55 17         141 $oauth_params->{$k} = uri_escape( $oauth_params->{$k} );
56             }
57              
58 3         28 $req->finalize;
59              
60 3         10 my $oauth_sig = $self->_oauth_sig( $req, $oauth_params );
61 3         56 $req->header( 'Authorization' =>
62             $self->_build_auth_string( $oauth_params, $oauth_sig ) );
63             }
64              
65             sub _base_string {
66 3     3   7 my ($self, $req, $oparams) = @_;
67              
68 3         6 my $query_keys = [];
69 3         5 my $query_vals = {};
70              
71 3 100       78 if ( defined $req->env->{QUERY_STRING} ) {
72 1         22 while ($req->env->{QUERY_STRING} =~ /([^=]+)=([^&]*)&?/g){
73 1         4 my ($k,$v) = ($1,$2);
74 1         3 push @$query_keys, $k;
75 1         23 $query_vals->{$k} = $v;
76             }
77             }
78              
79 3         10 my $payload = $req->body;
80 3 50       10 if ( defined $payload ) {
81 0         0 my $ct = $req->header('content-type');
82 0 0 0     0 if ( !defined $ct or $ct eq 'application/x-www-form-urlencoded' ) {
83 0         0 while ($payload =~ /([^=]+)=([^&]*)&?/g){
84 0         0 my ($k,$v) = ($1,$2);
85 0         0 $v =~ s/\+/\%\%20/;
86 0         0 push @$query_keys, $k;
87 0         0 $query_vals->{$k} = $v;
88             }
89             }
90             }
91              
92 3         55 my $scheme = $req->scheme;
93 3         10 my $port = $req->port;
94              
95 3 50 33     14 if ( $port == 80 && $scheme eq 'http' ) {
96 3         5 $port = undef;
97             }
98 3 0 33     10 if ( defined $port
      33        
      0        
99             && defined $scheme
100             && $port == 443
101             && $scheme eq 'https' )
102             {
103 0         0 $port = undef;
104             }
105              
106              
107             my $uri =
108             ( $scheme || 'https' ) . "://"
109             . $req->env->{SERVER_NAME}
110             . $req->env->{SCRIPT_NAME}
111 3   50     71 . $req->env->{PATH_INFO};
112              
113 3         12 foreach my $k (keys %$oparams){
114 23         34 push @$query_keys, $k;
115 23         37 $query_vals->{$k} = $oparams->{$k};
116             }
117              
118 3         17 my @sort = sort {$a cmp $b} @$query_keys;
  51         68  
119 3         6 my $params = [];
120              
121 3         7 foreach my $k (@sort){
122 24         30 my $v = $query_vals->{$k};
123 24 100       59 push @$params, $k . '=' . $v if defined $v;
124             }
125 3         9 my $normalized = join('&', @$params);
126 3         9 my $str = uc($req->method) . '&' . uri_escape($uri) . '&' . uri_escape($normalized);
127 3         185 return $str;
128             }
129              
130             sub _build_auth_string {
131 3     3   6 my ( $self, $oauth_params, $oauth_sig ) = @_;
132              
133 3         6 my $auth = 'OAuth';
134              
135 3 50       81 if ( $self->realm ) {
136 0         0 $auth = $auth . ' realm="' . $self->realm . '",';
137             }
138              
139             $auth =
140             $auth
141             . ' oauth_consumer_key="'
142             . $oauth_params->{oauth_consumer_key} . '"'
143             . ', oauth_signature_method="'
144 3         13 . $oauth_params->{oauth_signature_method} . '"'
145             . ', oauth_signature="'
146             . $oauth_sig . '"';
147              
148 3 50       9 if ( $oauth_params->{oauth_signature_method} ne 'PLAINTEXT' ) {
149             $auth =
150             $auth
151             . ', oauth_timestamp="'
152             . $oauth_params->{oauth_timestamp} . '"'
153             . ', oauth_nonce="'
154 3         11 . $oauth_params->{oauth_nonce} . '"';
155             }
156              
157 3 100       7 if ( !$oauth_params->{oauth_token} ) {
158             $auth =
159 2         6 $auth . ', oauth_callback="' . $oauth_params->{oauth_callback} . '"';
160             }
161             else {
162 1 50       4 if ( $oauth_params->{oauth_verifier} ) {
163             $auth =
164             $auth
165             . ', oauth_token="'
166             . $oauth_params->{oauth_token} . '"'
167             . ', oauth_verifier="'
168 1         5 . $oauth_params->{oauth_verifier} . '"';
169             }
170             else {
171             $auth =
172 0         0 $auth . ', oauth_token="' . $oauth_params->{oauth_token} . '"';
173             }
174             }
175              
176 3         8 $auth = $auth . ', oauth_version="' . $oauth_params->{oauth_version} . '"';
177 3         13 return $auth;
178             }
179              
180             sub _oauth_sig {
181 3     3   6 my ( $self, $req, $oauth_params ) = @_;
182              
183             die $oauth_params->{oauth_signature_method} . " is not supported"
184             unless ( $oauth_params->{oauth_signature_method} eq 'PLAINTEXT'
185 3 50 33     18 || $oauth_params->{oauth_signature_method} eq 'HMAC-SHA1' );
186              
187 3 50       7 if ( $oauth_params->{oauth_signature_method} eq 'PLAINTEXT' ) {
188 0         0 return uri_escape( $self->_signature_key );
189             }
190              
191 3         9 $oauth_params->{oauth_timestamp} = time;
192 3         8 $oauth_params->{oauth_nonce} = $self->_oauth_nonce;
193              
194 3         11 my $oauth_signature_base_string = $self->_base_string( $req, $oauth_params );
195              
196 3         11 return uri_escape(
197             MIME::Base64::encode_base64(
198             Digest::SHA::hmac_sha1(
199             $oauth_signature_base_string, $self->_signature_key
200             )
201             )
202             );
203             }
204              
205             sub _oauth_nonce {
206 3     3   69 Digest::SHA::sha1_hex( rand() . 'random' . time() . 'keyyy' );
207             }
208              
209             sub _signature_key {
210 3     3   4 my $self = shift;
211 3   100     92 my $signature_key =
212             uri_escape( $self->oauth_consumer_secret ) . '&'
213             . uri_escape( $self->oauth_token_secret || '' );
214 3         54 return $signature_key;
215             }
216              
217             1;
218              
219             __END__
220              
221             =pod
222              
223             =encoding UTF-8
224              
225             =head1 NAME
226              
227             Net::HTTP::Spore::Middleware::Auth::OAuth - middleware for OAuth authentication
228              
229             =head1 VERSION
230              
231             version 0.07
232              
233             =head1 SYNOPSIS
234              
235             my $client = Net::HTTP::Spore->new_from_spec( 'google-url-shortener.json' );
236             $client->enable('Format::JSON');
237             $client->enable('Auth::OAuth',
238             oauth_consumer_key => '00000000.apps.googleusercontent.com',
239             oauth_consumer_secret => 'xxxxxxxxx',
240             oauth_token => 'yyyyyyyyy',
241             oauth_token_secret => 'zzzzzzzzz',
242             );
243              
244             my $r = $client->insert( payload => { longUrl => 'http://f.lumberjaph.net/' } );
245             say( $r->body->{id} . ' is ' . $r->body->{longUrl} );
246             say "list >";
247             $r = $client->list();
248             foreach my $short (@{$r->body->{items}}){
249             say $short->{id} . ' ' . $short->{longUrl};
250             }
251              
252             =head1 DESCRIPTION
253              
254             Net::HTTP::Spore::Middleware::Auth::OAuth is a middleware to handle OAuth mechanism. This middleware should be loaded as the last middleware, because it requires all parameters to be setted to calculate the signature.
255              
256             =head1 AUTHORS
257              
258             =over 4
259              
260             =item *
261              
262             Franck Cuny <franck.cuny@gmail.com>
263              
264             =item *
265              
266             Ash Berlin <ash@cpan.org>
267              
268             =item *
269              
270             Ahmad Fatoum <athreef@cpan.org>
271              
272             =back
273              
274             =head1 COPYRIGHT AND LICENSE
275              
276             This software is copyright (c) 2012 by Linkfluence.
277              
278             This is free software; you can redistribute it and/or modify it under
279             the same terms as the Perl 5 programming language system itself.
280              
281             =cut