File Coverage

lib/OAuthomatic/Caller.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package OAuthomatic::Caller;
2             # ABSTRACT: actually make OAuth-signed calls
3              
4              
5 1     1   868 use Moose;
  0            
  0            
6              
7             use version;
8             use feature 'state';
9             use Const::Fast;
10             use LWP::UserAgent;
11             use URI;
12             use URI::QueryParam;
13             use HTTP::Request;
14             use HTTP::Headers;
15             use Net::OAuth;
16             use OAuthomatic::Error;
17             use OAuthomatic::Internal::Util qw/fill_httpmsg_text fill_httpmsg_form parse_http_msg_form/;
18             use namespace::sweep;
19              
20             const my $OAUTH_REALM => "OAuthomatic";
21              
22             const my $FORM_CONTENT_TYPE => "application/x-www-form-urlencoded";
23             const my $DEFAULT_FORM_CONTENT_TYPE => "application/x-www-form-urlencoded; charset=utf-8";
24             const my $DEFAULT_CONTENT_TYPE => "text/plain; charset=utf-8";
25              
26             const my $_HAS_BUGGY_PROXY_IN_LWP => (
27             version->parse($LWP::UserAgent::VERSION) < version->parse("6.06") );
28              
29              
30             has 'config' => (
31             is => 'ro', isa => 'OAuthomatic::Config', required => 1,
32             handles => ['debug']);
33              
34              
35             has 'server' => (
36             is => 'ro', isa => 'OAuthomatic::Server', required => 1,
37             handles => [
38             'oauth_authorize_page', 'oauth_temporary_url', 'oauth_token_url',
39             'protocol_version', 'signature_method'
40             ]);
41              
42             # Object responsible for executing calls.
43             has 'user_agent' => (
44             is => 'ro', isa => 'LWP::UserAgent', default => sub {
45             # Workaround for SSL-over-proxy problems. Disables buggy proxy behaviour in
46             # LWP (proxy should be handled by Crypt::SSLeay below thanks to env variable).
47             # https://rt.cpan.org/Public/Bug/Display.html?id=1894
48             # http://www.perlmonks.org/?node_id=994683
49             # FIXME: when LWP 6.06 turns popular, drop it and just depend on 6.06
50             my $ua;
51             if($_HAS_BUGGY_PROXY_IN_LWP && $ENV{https_proxy}) {
52             require Net::SSL;
53             local $Net::HTTPS::SSL_SOCKET_CLASS = "Net::SSL"; # Force use of Net::SSL
54             $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0 });
55             $ua->proxy(https => undef);
56             } else {
57             $ua = LWP::UserAgent->new;
58             }
59             return $ua;
60             });
61              
62             # Application identity
63             has 'client_cred' => (
64             is => 'rw', isa => 'Maybe[OAuthomatic::Types::ClientCred]', required => 1,
65             trigger => sub {
66             my ($self, $cred, $old_cred) = @_;
67             return if @_ == 2; # Don't act during object build
68             return if OAuthomatic::Types::ClientCred->equal($cred, $old_cred);
69             # Changed client_cred means access creds are no longer valid.
70             $self->token_cred(undef);
71             });
72              
73             # Current access credentials, for use in normal calls
74             has 'token_cred' => (
75             is => 'rw', isa => 'Maybe[OAuthomatic::Types::TokenCred]', required => 1);
76              
77              
78             sub create_authorization_url {
79             my ($self, $callback_url) = @_;
80              
81             # Make temporary credentials
82             my $temporary_cred = $self->_create_temporary_cred($callback_url);
83              
84             # Calculate authorization url
85             my $url = URI->new($self->oauth_authorize_page);
86             $url->query_param(oauth_token => $temporary_cred->token);
87              
88             $temporary_cred->authorize_page($url);
89              
90             return $temporary_cred;
91             }
92              
93             # Create request token
94             sub _create_temporary_cred {
95             my ($self, $callback_url) = @_;
96              
97             unless ($self->_using_legacy_oauth10) {
98             unless($callback_url) {
99             OAuthomatic::Error::Generic->throw(
100             ident => "missing required argument",
101             extra => "callback_url is required");
102             }
103             }
104              
105             my $response = $self->_execute_oauth_request_ext(
106             class => 'RequestToken', # No token
107             callback => $callback_url,
108             method => 'POST', url => $self->oauth_temporary_url,
109             auth_in_post => 1);
110              
111             my $response_params = _parse_form_reply(
112             $response, ['oauth_token', 'oauth_token_secret']);
113              
114             unless($response_params->{oauth_callback_confirmed}
115             || $self->_using_legacy_oauth10) {
116             OAuthomatic::Error::Protocol->throw(
117             ident => "Bad OAuth reply",
118             extra => "Missing oauth_callback_confirmed (is site using OAuth 1.0?)");
119             }
120              
121             return OAuthomatic::Types::TemporaryCred->new(
122             data => $response_params,
123             remap => {'oauth_token' => 'token', 'oauth_token_secret' => 'secret'});
124             }
125              
126              
127             sub create_token_cred {
128             my ($self, $temporary_cred, $verifier_cred) = @_;
129              
130             unless ($verifier_cred || $self->_using_legacy_oauth10) { # FIXME maybe drop support for it?
131             OAuthomatic::Error::Generic->throw(
132             ident => "Missing parameter",
133             extra => "For OAuth 1.0a verifier is required");
134             }
135              
136             my $response = $self->_execute_oauth_request_ext(
137             class => 'AccessToken',
138             token => $temporary_cred, verifier => $verifier_cred,
139             method => 'POST', url => $self->oauth_token_url,
140             auth_in_post => 1);
141              
142             my $response_params = _parse_form_reply(
143             $response, ['oauth_token', 'oauth_token_secret']);
144              
145             my $cred = OAuthomatic::Types::TokenCred->new(
146             data => $response_params,
147             remap => {'oauth_token' => 'token', 'oauth_token_secret' => 'secret'});
148              
149             $self->token_cred($cred);
150              
151             return $cred;
152             }
153              
154             ###########################################################################
155             # Call-making
156             ###########################################################################
157              
158              
159             ## no critic (RequireArgUnpacking)
160             sub build_oauth_request {
161             my $self = shift;
162              
163             unless($self->token_cred) {
164             OAuthomatic::Error::Generic->throw(
165             ident => "Unauthorized",
166             extra => "Missing token.");
167             }
168              
169             return $self->_build_oauth_request_ext(
170             class => 'ProtectedResource',
171             token => $self->token_cred,
172             @_);
173             }
174             ## use critic
175              
176              
177             ## no critic (RequireArgUnpacking)
178             sub execute_oauth_request {
179             my $self = shift;
180              
181             unless($self->token_cred) {
182             OAuthomatic::Error::Generic->throw(
183             ident => "Unauthorized",
184             extra => "Missing token.");
185             }
186              
187             return $self->_execute_oauth_request_ext(
188             class => 'ProtectedResource',
189             token => $self->token_cred,
190             @_);
191             }
192             ## use critic
193              
194              
195             sub _build_oauth_request_ext {
196             my ($self, %args) = @_;
197              
198             foreach my $req_arg (qw(class method url)) {
199             unless($args{$req_arg}) {
200             OAuthomatic::Error::Generic->throw(
201             ident => "Bad parameter",
202             extra => "Missing required parameter '$req_arg'");
203             }
204             }
205              
206             my $class = $args{class};
207             my $token = $args{token};
208             my $verifier = $args{verifier};
209             my $callback = $args{callback};
210             my $method = $args{method};
211             my $url = $args{url};
212             my $url_args = $args{url_args};
213             my $body_form = $args{body_form};
214             my $body = $args{body};
215             my $content_type = $args{content_type};
216             my $auth_in_post = $args{auth_in_post};
217              
218             # Sanity checks
219              
220             if($method =~ /^(?:POST|PUT)$/x) {
221             $body_form = {} unless ($body || $body_form);
222             OAuthomatic::Error::Generic->throw(
223             ident => "Bad parameter",
224             extra => "Can not specify both body and body_form")
225             if $body && $body_form;
226             OAuthomatic::Error::Generic->throw(
227             ident => "Bad parameter",
228             extra => "Can't use plain body with auth_in_post")
229             if $auth_in_post && $body;
230             }
231             elsif($method =~ /^(?:GET|DELETE)$/x) {
232             OAuthomatic::Error::Generic->throw(
233             ident => "Bad parameter",
234             extra => "Can not specify body* for $method request")
235             if ($body || $body_form);
236             OAuthomatic::Error::Generic->throw(
237             ident => "Bad parameter",
238             extra => "Can't use auth_in_post for $method request")
239             if $auth_in_post;
240             }
241             else {
242             OAuthomatic::Error::Generic->throw(
243             ident => "Bad parameter",
244             extra => "Unknown method: $method (expected GET, POST, PUT or DELETE)");
245             }
246              
247             if($url_args) {
248             unless(ref($url_args) eq 'HASH') {
249             OAuthomatic::Error::Generic->throw(
250             ident => "Bad parameter",
251             extra => "url_args should be specified as hash reference, but are given as " . (ref($url_args) || "scalar value $url_args"));
252             }
253             }
254              
255             if($body_form) {
256             $content_type ||= $DEFAULT_FORM_CONTENT_TYPE;
257             OAuthomatic::Error::Generic->throw(
258             ident => "Bad parameter",
259             extra => "With body_form, the only allowed content_type is $FORM_CONTENT_TYPE (plus coding), but $content_type was given")
260             unless $content_type =~ /^$FORM_CONTENT_TYPE(;.*)?$/;
261             } else {
262             $content_type ||= $DEFAULT_CONTENT_TYPE;
263             OAuthomatic::Error::Generic->throw(
264             ident => "Bad parameter",
265             extra => "Can not specify content_type=$content_type and plain body, use body_form!")
266             if $content_type =~ /^$FORM_CONTENT_TYPE(;.*)?$/;
267             }
268              
269             if($verifier) {
270             OAuthomatic::Error::Generic->throw(
271             ident => "Bad parameter",
272             extra => "Attempt to specify verifier without token")
273             unless $token;
274             OAuthomatic::Error::Generic->throw(
275             ident => "Token mismatch",
276             extra => "Obtained verifier is for token " . $verifier->token
277             . " while (temporary) token is " . $token->token)
278             unless $verifier->token eq $token->token;
279             }
280              
281             # Calculate final URL
282              
283             # FIXME: URI encodes as utf-8 true strings or as Latin-1 binary strings. Consider
284             # using default encoding if non-utf8
285             my $uri = URI->new($url);
286             # Append additional params, if given
287             if($url_args) {
288             foreach my $key (keys %$url_args) {
289             $uri->query_param($key, $url_args->{$key});
290             }
291             }
292              
293             # Net::OAuth is used to
294             # (a) calculate signature
295             # and
296             # (b) render authorization header
297             my $oauth_request = Net::OAuth->request($class)->new(
298             request_method => $method,
299             request_url => $uri,
300             $self->client_cred->as_hash("consumer"), # consumer_key, consumer_secret
301             ($token
302             ? ($token->as_hash()) # token, token_secret
303             : ()),
304             signature_method => $self->signature_method,
305             protocol_version => $self->_net_oauth_version_constant(), # FIXME: isn't it version?
306             # version => $self->protocol_version, # changes oauth_version but better not, bb fails
307             timestamp => time,
308             nonce => $self->_nonce,
309             ($verifier
310             ? (verifier => $verifier->verifier)
311             : ()),
312             ($callback
313             ? (callback => $callback)
314             : ()),
315             ($body_form
316             ? (extra_params => $body_form) # body parts used in signature
317             : ()),
318             );
319             $oauth_request->sign;
320             OAuthomatic::Error::Generic->throw(
321             ident => "OAuth signature verification failed.")
322             unless $oauth_request->verify;
323              
324             my $headers = HTTP::Headers->new();
325             # FIXME: handle custom headers (Accept?)
326              
327             if($auth_in_post) {
328             my $oauth_par = $oauth_request->to_hash();
329             if($body_form && %$body_form) {
330             # Merge OAuth with other post oauth_par
331             @{$body_form}{keys %$oauth_par} = values %$oauth_par;
332             } else {
333             $body_form = $oauth_par;
334             }
335             } else {
336             # This builds "OAuth realm=... oauth_consumer_key=.. ..." text
337             my $oauth_header_text = $oauth_request->to_authorization_header($OAUTH_REALM);
338             $headers->header('Authorization' => $oauth_header_text);
339             }
340              
341             my $http_request = HTTP::Request->new($method, $uri, $headers);
342             if($body) {
343             fill_httpmsg_text($http_request, $body, $content_type);
344             } elsif($body_form) {
345             fill_httpmsg_form($http_request, $body_form);
346             }
347              
348             return $http_request;
349             }
350              
351              
352             ## no critic (RequireArgUnpacking)
353             sub _execute_oauth_request_ext {
354             my $self = shift;
355             my $request = $self->_build_oauth_request_ext(@_);
356              
357             print "[OAuthomatic] Executing request: ", $request->as_string, "\n" if $self->debug;
358              
359             my $response = $self->user_agent->request($request);
360              
361             print "[OAuthomatic] Obtained response: ", $response->as_string, "\n" if $self->debug;
362              
363             OAuthomatic::Error::HTTPFailure->throw(
364             ident => 'OAuth-signed HTTP call failed',
365             request => $request, response => $response)
366             unless $response->is_success;
367              
368             return $response;
369             }
370             ## use critic
371              
372             ###########################################################################
373             # Helpers
374             ###########################################################################
375              
376             sub _net_oauth_version_constant {
377             my $self = shift;
378             my $ver = $self->protocol_version;
379             return Net::OAuth::PROTOCOL_VERSION_1_0A() if $ver eq '1.0a';
380             return Net::OAuth::PROTOCOL_VERSION_1_0() if $ver eq '1.0';
381             return OAuthomatic::Error::Generic->throw(
382             ident => "Invalid parameter",
383             extra => "Invalid protocol version: $ver");
384             }
385              
386             sub _using_legacy_oauth10 {
387             my $self = shift;
388             return 1 if $self->protocol_version eq '1.0';
389             return 0;
390             }
391              
392             # How many requests per second can reasonably happen, as 2 power
393             const my $_NONCE_UNIQ_BITS => 6;
394             const my $_NONCE_UNIQ_MAX => (2 ** $_NONCE_UNIQ_BITS);
395             const my $_NONCE_RANDOM_MAX => (2 ** (31 - $_NONCE_UNIQ_BITS));
396              
397             sub _nonce {
398             # This ensures no collisions in succeessive requests (after all we need no collision within 1s)
399             state $counter = 0;
400             $counter = ($counter + 1) % $_NONCE_UNIQ_MAX;
401             # And this adds general randomness
402             return $counter + $_NONCE_UNIQ_MAX * int(rand($_NONCE_RANDOM_MAX));
403             }
404              
405             # Checks response: throws exception on error, parses and returns param hash
406             # Second param, if present, is a list of required parameters
407             sub _parse_form_reply {
408             my ($http_response, $required_params) = @_;
409              
410             my $params = parse_http_msg_form($http_response, 1);
411              
412             if($required_params) {
413             foreach my $par_name (@$required_params) {
414             # FIXME: bind http_response
415             OAuthomatic::Error::Generic->throw(
416             ident => "Invalid reply obtained",
417             extra => "Missing required item in parsed reply: $par_name\n"
418             . "Reply items: " . join(", ", keys %$params). "\n")
419             unless $params->{$par_name};
420             }
421             }
422              
423             return $params;
424             }
425              
426             1;
427              
428             __END__
429              
430             =pod
431              
432             =encoding UTF-8
433              
434             =head1 NAME
435              
436             OAuthomatic::Caller - actually make OAuth-signed calls
437              
438             =head1 VERSION
439              
440             version 0.0201
441              
442             =head1 DESCRIPTION
443              
444             Sign OAuth calls and execute them.
445              
446             This object is mostly used internally by L<OAuthomatic>, but may be useful
447             separately if you want to implement initialization scheme by yourself but
448             prefer it's API and structural exceptions to raw L<Net::OAuth>.
449              
450             =head1 METHODS
451              
452             =head2 create_authorization_url($callback_url) => TemporaryCred
453              
454             Calculates URL which user should visit to authorize app (and
455             associated temporary token).
456              
457             =head2 create_token_cred
458              
459             Acquires access token, preserves them in the object (so future calls
460             will be authenticated), and return (so it can be saved etc).
461              
462             =head2 build_oauth_request(method => ..., ...)
463              
464             Prepare properly signed L<HTTP::Request> but do not execute it, just
465             return ready-to-be-sent object.
466              
467             Parameters: identical as in L</execute_oauth_request>
468              
469             =head2 execute_oauth_request(method => $method, url => $url, url_args => $args,
470             body_form => $body_form, body => $body,
471             content_type => $content_type)
472              
473             Make a request to C<url> using the given HTTP method and signing
474             request with OAuth credentials.
475              
476             =over 4
477              
478             =item method
479              
480             One of C<GET>, C<POST>, C<PUT>, C<DELETE>.
481              
482             =item url
483              
484             Actual URL to call (C<http://some.site.com/api/...>)
485              
486             =item url_args (optional)
487              
488             Additional arguments to escape and add to the URL. This is simply shortcut,
489             three calls below are equivalent:
490              
491             $c->execute_oauth_request(method => "GET",
492             url => "http://some.where/api?x=1&y=2&z=a+b");
493              
494             $c->execute_oauth_request(method => "GET",
495             url => "http://some.where/api",
496             url_args => {x => 1, y => 2, z => 'a b'});
497              
498             $c->execute_oauth_request(method => "GET",
499             url => "http://some.where/api?x=1",
500             url_args => {y => 2, z => 'a b'});
501              
502             =item body_form OR body
503              
504             Exactly one of those must be specified for POST and PUT (none for GET or DELETE).
505              
506             Specifying C<body_form> means, that we are creating www-urlencoded
507             form. Parameters will be included in OAuth signature. Example:
508              
509             $c->execute_oauth_request(method => "POST",
510             url => "http://some.where/api",
511             body_form => {par1 => 'abc', par2 => 'd f'});
512              
513             Note that this is not just a shortcut for setting body to already
514             serialized form. Case of urlencoded form is treated in a special way
515             by OAuth (those values impact OAuth signature). To avoid signature
516             verification errors, OAuthomatic will reject such attempts:
517              
518             # WRONG AND WILL FAIL. Use body_form if you post form.
519             $c->execute_oauth_request(method => "POST",
520             url => "http://some.where/api",
521             body => 'par1=abc&par2=d+f',
522             content_type => 'application/x-www-form-urlencoded');
523              
524             Specifying C<body> means, that we post non-form body (for example
525             JSON, XML or even binary data). Example:
526              
527             $c->execute_oauth_request(method => "POST",
528             url => "http://some.where/api",
529             body => "<product><item-no>3434</item-no><price>334.22</price></product>",
530             content_type => "application/xml; charset=utf-8");
531              
532             Value of body can be either binary string (which will be posted as-is), or
533             perl unicode string (which will be encoded according to the content type, what by
534             default means utf-8).
535              
536             Such content is not covered by OAuth signature, so less secure (at
537             least if it is posted over non-SSL connection).
538              
539             For longer bodies, references are supported:
540              
541             $c->execute_oauth_request(method => "POST",
542             url => "http://some.where/api",
543             body => \$body_string,
544             content_type => "application/xml; charset=utf-8");
545              
546             =item content_type
547              
548             Used to set content type of the request. If missing, it is set to
549             C<text/plain; charset=utf-8> if C<body> param is specified and to
550             C<application/x-www-form-urlencoded; charset=utf-8> if C<body_form>
551             param is specified.
552              
553             Note that module author does not test behaviour on encodings different
554             than utf-8 (although they may work).
555              
556             =back
557              
558             =head2 _execute_oauth_request_ext
559              
560             Common code for API and OAuth-protocol calls. Uses all parameters
561             described in L</execute_oauth_request> and two additional:
562              
563             =over 4
564              
565             =item class
566              
567             ProtectedResource, UserAuth, RequestToken etc (XXX from
568             Net::Oauth::XXXXRequest)
569              
570             =item token
571              
572             Actual token to use while signing (skip to use only client token) -
573             either $self->token_cred, or some temporary_cred, depending on task at
574             hand.
575              
576             =back
577              
578             =head1 ATTRIBUTES
579              
580             =head2 config
581              
582             L<OAuthomatic::Config> object used to bundle various configuration params.
583              
584             =head2 server
585              
586             L<OAuthomatic::Server> object used to bundle server-related configuration params.
587              
588             =head1 INTERNAL METHODS
589              
590             =head2 _build_oauth_request_ext
591              
592             Common code for API and OAuth-protocol calls. Uses all parameters
593             described in L</execute_oauth_request> and some additional:
594              
595             =over 4
596              
597             =item class
598              
599             ProtectedResource, UserAuth, RequestToken etc (XXX from Net::Oauth::XXXXRequest)
600              
601             =item token
602              
603             Actual token to use while signing (skip to use only client token) - either $self->token_cred,
604             or some temporary_cred, depending on task at hand.
605              
606             =item verifier
607              
608             Verifier to be added to access token creation.
609              
610             =item callback
611              
612             Callback url for temporary token creation.
613              
614             =item auth_in_post
615              
616             True if authorization tokens are to be merged into POST body, false if
617             they are to be preserved in Authorize header.
618              
619             =back
620              
621             =head1 AUTHOR
622              
623             Marcin Kasperski <Marcin.Kasperski@mekk.waw.pl>
624              
625             =head1 COPYRIGHT AND LICENSE
626              
627             This software is copyright (c) 2015 by Marcin Kasperski.
628              
629             This is free software; you can redistribute it and/or modify it under
630             the same terms as the Perl 5 programming language system itself.
631              
632             =cut