Net-OAuth2-0.67/0000755000175000017500000000000014124363460012647 5ustar thomasthomasNet-OAuth2-0.67/Changes0000644000175000017500000001467314124363460014155 0ustar thomasthomasRevision history for Perl distribution Net-OAuth2 All changes by Thomas Uhle unless noted otherwise. 0.67 Mon, 27 Sep 2021 This is a maintenance release. Thomas Uhle is taking over development. Thanks to Mark Overmeer for his work in the past years. * Update maintainer information and URLs. * Reorder changelog entries from newest to oldest (versions 0.01-0.08). * Replace die by Carp::croak. * Fix module dependencies. * Fix client authentication. ----- All changes below by Mark Overmeer unless noted otherwise. 0.66 Tue, 1 Oct 10:58:28 CEST 2019 Improvements: - #3 replace JSON with JSON::MaybeXS [James Raspass] 0.65 Mon, 16 Sep 08:42:09 CEST 2019 Fixes: - #1 set the Host header [Julien Semaan] - #2 session_freeze [prsquee] 0.64 Wed, 21 Mar 09:48:02 CET 2018 Improvements: - Converted to GIT, published on GitHub. - added 'hd' passthru parameter to requests. Implemented by [Diego Garcia del Rio] For usecases, see: https://developers.google.com/identity/protocols/OpenIDConnect#hd-param 0.63 Mon, 18 Jan 13:51:55 CET 2016 Fixes: - instagram does not like a Host header where port 443 is mentioned. Do not use that port if it is the default for the protocol. [Samuel Kaufman] 0.62 Wed, 11 Nov 12:29:40 CET 2015 Improvements: - typo. rt.cpan.org#104332 [Christopher Hoskin, Debian] - added contributed examples/google-refresh [Andreas Hernitscheck] 0.61 Mon, Jun 30 08:53:41 CEST 2014 Fixes: - another regresssion test t/10req.t failed due to hash order randomization. [cpantesters] 0.60 Thu, Jun 26 09:46:53 CEST 2014 Fixes: - regresssion test t/10req.t failed due to hash order randomization. [cpantesters] & rt.cpan.org#96731 [Andreas König] 0.59 Tue, Jun 24 23:56:23 CEST 2014 Fixes: - do not send client_id and client_secret as parameters, because it will get refused by QQ Catalyst. rt.cpan.org#96454 [Scott Weisman] - added 'state' passthru parameter to requests [Bas Bloemsaat] 0.58 Wed, May 28 23:17:09 CEST 2014 Improvements: - generic accessor of ::AccessToken via attribute() [Sergey Lobanov] 0.57 Mon, Mar 24 09:33:07 CET 2014 Fixes: - an update of an access-token may include a new refresh-token. rt.cpan.org#94131 [Joe Papperello] Improvements: - changed documentation style 0.56 Wed, Sep 4 11:50:48 CEST 2013 Fixes: - auto_save option did not work: option processing typo rt.cpan.org#86824 [Hironori Yoshida] - basic-auth header should not contain a \n rt.cpan.org#88409 [Anton Gerasimov] 0.55 Tue, Apr 2 16:13:33 CEST 2013 Fixes: - refreshed token at each access. 0.54 Thu, Mar 28 10:55:51 CET 2013 Fixes: - remove Build.PL Improvements: - rename demo/ into examples/psgi - added t/30refresh.t by [Samuel Kaufman] - Test::Mock::LWP::Dispatch is now optional, because it has a huge dependency tree via Moose. 0.53 Mon, Jan 28 12:01:26 CET 2013 Changes: - default of token_scheme changed to standard compliant auth-header:Bearer rt.cpan.org#82878 [Shmuel Fomberg] - refresh_token renamed to refresh_always. rt.cpan.org#82967 [Samuel Kaufman] Fixes: - data handling in update_token rt.cpan.org#82967 [Samuel Kaufman] Improvements: - add documentation to token_scheme rt.cpan.org#82878 [Shmuel Fomberg] 0.52 Tue, Jan 15 13:21:04 CET 2013 Fixes: - mistake ::AccessToken::freeze() -> ::AccessToken::session_freeze() Improvements: - document how to use freeze and thaw. 0.51 Tue, Jan 8 11:52:17 CET 2013 Fixes: - the new ::WebServer::authorize() was conceptionally broken. Corrected and documented how to be used. Flagged by rt.cpan.org#82556 [Shmuel Fomberg] Improvements: - more info in the demo - improved documentation (still not sufficient) - rename ::AccessToken::to_string() into ::to_json() Old name still usable. - add ::WebServer::autorize_response() for convenience. - remove unused dependency on Test::Mock::LWP::Dispatch - add ::AccessToken::session_freeze() and ::session_thaw() Requested by rt.cpan.org#82554 [Shmuel Fomberg] - error when people use old $profile->authorize_url() 0.50 Mon, Jan 7 12:39:16 CET 2013 New maintainer: Mark Overmeer Changes: - Deprecate use of ::Client, in favor of ::Profile::* - ::Profile::Base merged into ::Profile - *_params() functions return a HASH (ref), not a list of pairs - do not call authorize_url() to initiate the session, but authorize(). Fixes: - added documentation, added regression tests Improvements: - merged/rewrote contributions by [nikopol], refresh - merged/rewrote contributions by [Fukata], refresh - merged/rewrote contributions by [Lamoz], the ::Profile::Password - removed t/manifest and t/pod-coverage ----- All changes below by Keith Grennan 0.08 Wed, 15 Jun 2011 18:15:00 UTC Add bearer_token_scheme parameter to support the various techniques in https://tools.ietf.org/html/draft-ietf-oauth-v2-bearer-02 The default technique is now the authorization header (Authorization: OAuth ) Example values of this parameter: auth-header (default, same as auth-header:OAuth) auth-header:Bearer (custom scheme) auth-header:OAuth2 (custom scheme) uri-query (same as uri-query:oauth_token) uri-query:my_token_param (custom param name) form-body (same as form-body:oauth_token) form-body:my_token_param (custom param name) 0.07 Mon, 03 Jan 2011 18:49:06 UTC Spec V2.15 / Google compatibility * Add scope param to Client * Always include grant_type param * Have POST request send params in body rather than URL query string * Allow user to specify name of access token query param in protected resource requests, since Google calls it oauth_token rather than access_token. This can be passed to the client constructor as access_token_param => 'oauth_token'. * Changed the default access_token_method to POST from GET * Added a Google demo to the demo app that's included with the module package (hosted at http://oauth2.kg23.com). 0.06 Mon, 03 Jan 2011 18:49:06 UTC Merged grant_type param (https://github.com/keeth/Net-OAuth2/issues#issue/3) 0.05 Thu, 23 Dec 2010 18:24:30 UTC Merged param warning fix (https://github.com/keeth/Net-OAuth2/pull/2) 0.04 Fri, 17 Dec 2010 02:04:31 UTC Add missing build require (YAML) 0.03 Thu, 16 Dec 2010 16:58:37 UTC Merged fix for client->site_url (https://github.com/keeth/Net-OAuth2/pull/1) 0.02 Thu, 21 Oct 2010 02:20:39 UTC Added support for Facebook Graph API, made demo generic with support for both 37signals and Facebook 0.01 Mon, 18 Oct 2010 18:29:17 UTC Very basic v0.01, tested against 37Signals API Net-OAuth2-0.67/META.json0000644000175000017500000000335214124363460014273 0ustar thomasthomas{ "abstract" : "OAuth2 authenticating client", "author" : [ "Thomas Uhle " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Net-OAuth2", "no_index" : { "directory" : [ "t", "xt" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "Encode" : "0", "HTTP::Request" : "0", "HTTP::Response" : "0", "HTTP::Status" : "0", "JSON::MaybeXS" : "0", "LWP::UserAgent" : "0", "MIME::Base64" : "0", "Scalar::Util" : "0", "Test::More" : "0", "URI" : "0", "constant" : "0", "strict" : "0", "warnings" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://gitlab.com/uhle/perl-net-oauth2/-/issues" }, "homepage" : "https://search.cpan.org/~uhle/Net-OAuth2/", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "https://gitlab.com/uhle/perl-net-oauth2.git", "web" : "https://gitlab.com/uhle/perl-net-oauth2" } }, "version" : "0.67", "x_serialization_backend" : "JSON::PP version 2.94" } Net-OAuth2-0.67/META.yml0000644000175000017500000000175314124363460014126 0ustar thomasthomas--- abstract: 'OAuth2 authenticating client' author: - 'Thomas Uhle ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Net-OAuth2 no_index: directory: - t - xt requires: Carp: '0' Encode: '0' HTTP::Request: '0' HTTP::Response: '0' HTTP::Status: '0' JSON::MaybeXS: '0' LWP::UserAgent: '0' MIME::Base64: '0' Scalar::Util: '0' Test::More: '0' URI: '0' constant: '0' strict: '0' warnings: '0' resources: bugtracker: https://gitlab.com/uhle/perl-net-oauth2/-/issues homepage: https://search.cpan.org/~uhle/Net-OAuth2/ license: http://dev.perl.org/licenses/ repository: https://gitlab.com/uhle/perl-net-oauth2.git version: '0.67' x_serialization_backend: 'CPAN::Meta::YAML version 0.011' Net-OAuth2-0.67/Makefile.PL0000644000175000017500000000313214124363460014620 0ustar thomasthomas use ExtUtils::MakeMaker; WriteMakefile ( NAME => 'Net::OAuth2' , VERSION => '0.67' , PREREQ_PM => { 'Test::More' => 0, 'constant' => 0, 'strict' => 0, 'warnings' => 0, 'Carp' => 0, 'Encode' => 0, 'Scalar::Util' => 0, 'MIME::Base64' => 0, 'URI' => '0', 'JSON::MaybeXS' => 0, 'LWP::UserAgent' => 0, 'HTTP::Request' => 0, 'HTTP::Response' => 0, 'HTTP::Status' => 0, # optional # 'Test::Mock::LWP::Dispatch' => 0 } , AUTHOR => 'Thomas Uhle ' , ABSTRACT => 'OAuth2 authenticating client' , LICENSE => 'perl_5' , META_MERGE => { 'meta-spec' => { version => 2 } , resources => { homepage => 'https://search.cpan.org/~uhle/Net-OAuth2/', repository => { type => 'git', url => 'https://gitlab.com/uhle/perl-net-oauth2.git', web => 'https://gitlab.com/uhle/perl-net-oauth2' }, bugtracker => { web => 'https://gitlab.com/uhle/perl-net-oauth2/-/issues', }, license => 'http://dev.perl.org/licenses/', } } ); #### the next lines are added for OODoc, which generates the #### distribution. sub MY::postamble { <<'__POSTAMBLE' } # for DIST RAWDIR = ../public_html/net-oauth2/raw DISTDIR = ../public_html/net-oauth2/source # for POD FIRST_YEAR = 2013 EMAIL = uhle@cpan.org WEBSITE = https://search.cpan.org/~uhle/Net-OAuth2/ __POSTAMBLE Net-OAuth2-0.67/README0000644000175000017500000000130314124363460013524 0ustar thomasthomas=== README for Net-OAuth2 version 0.67 There are various ways to install this module: (1) if you have a command-line, you can do: perl -MCPAN -e 'install ' (2) if you use Windows, have a look at http://ppm.activestate.com/ (3) if you have downloaded this module manually (as root/administrator) gzip -d Net-OAuth2-0.67.tar.gz tar -xf Net-OAuth2-0.67.tar cd Net-OAuth2-0.67 perl Makefile.PL make make test # optional make install For usage, see the included manual-pages or https://search.cpan.org/dist/Net-OAuth2-0.67/ Please report problems to https://gitlab.com/uhle/perl-net-oauth2/-/issues Net-OAuth2-0.67/README.md0000644000175000017500000000226314124363460014131 0ustar thomasthomas# Perl distribution Net-OAuth2 This distribution implements an OAuth2 client, with knowledge about various services. ## Development → Release Important to know, is that I use an extension on POD to write the manuals. The "raw" unprocessed version is visible on GitLab. It will run without problems, but does not contain manual-pages. Releases to CPAN are different: "raw" documentation gets removed from the code and translated into real POD and clean HTML. Clone from GitLab for the "raw" version. For instance, when you want to contribute a new feature. On CPAN, you can find the processed version for each release. Simply run the following command to get it installed: ```sh cpan -i Net::OAuth2 ``` ## Contributing When you submit an extension, please contribute a set with 1. code 2. code documentation 3. regression tests in t/ **Please note:** When you contribute in any way, you automatically agree that your contribution is released under the same license as this project: licensed as Perl itself. ## Copyright and License This project is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See Net-OAuth2-0.67/xt/0000755000175000017500000000000013544612532013304 5ustar thomasthomasNet-OAuth2-0.67/xt/99pod.t0000644000175000017500000000041213537627336014444 0ustar thomasthomas#!/usr/bin/perl use warnings; use strict; use Test::More; BEGIN { eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; plan skip_all => "devel home uses OODoc" if $ENV{MARKOV_DEVEL}; } all_pod_files_ok(); Net-OAuth2-0.67/MANIFEST0000644000175000017500000000130514124363460013777 0ustar thomasthomasChanges MANIFEST Makefile.PL README README.md examples/.htaccess examples/psgi/app.psgi examples/psgi/config.yml examples/psgi/dispatch.cgi lib/Net/OAuth2.pm lib/Net/OAuth2.pod lib/Net/OAuth2/AccessToken.pm lib/Net/OAuth2/AccessToken.pod lib/Net/OAuth2/Client.pm lib/Net/OAuth2/Client.pod lib/Net/OAuth2/Profile.pm lib/Net/OAuth2/Profile.pod lib/Net/OAuth2/Profile/Password.pm lib/Net/OAuth2/Profile/Password.pod lib/Net/OAuth2/Profile/WebServer.pm lib/Net/OAuth2/Profile/WebServer.pod t/01use.t t/10web.t t/20req.t t/30refresh.t xt/99pod.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Net-OAuth2-0.67/examples/0000755000175000017500000000000013544612532014467 5ustar thomasthomasNet-OAuth2-0.67/examples/psgi/0000755000175000017500000000000013544612532015431 5ustar thomasthomasNet-OAuth2-0.67/examples/psgi/app.psgi0000644000175000017500000000517713537627336017121 0ustar thomasthomas#!/usr/bin/env perl # # This plack demo shows the logic which your website needs to facilitate # third-party OAuth2 authorization. # This code only works when you plack server runs in a single process: # otherwise you will need to keep the session information in some # shared store, for instance a database. That makes life considerable # harder. use strict; use warnings; use Dancer; use Net::OAuth2::Client; use HTML::Entities; get '/get/:site_id' => sub { redirect client(params->{site_id})->authorize; }; get '/got/:site_id' => sub { defined params->{code} or return html_page("Error: Missing access code"); my $site_id = params->{site_id}; my $access_token = client($site_id)->get_access_token(params->{code}); return html_page("Error: " . $access_token->to_string) if $access_token->{error}; my $content = "

Access token retrieved successfully!

\n" . '

'.encode_entities($access_token->to_string)."

\n"; $content .= "

State passthru

" . encode_entities(params->{state}) if params->{state}; $content .= "

HD passthru

" . encode_entities(params->{hd}) if params->{hd}; my $this_site = config->{sites}{$site_id}; my $response = $access_token->get($this_site->{protected_resource_url} || $this_site->{protected_resource_path}); if ($response->is_success) { $content .= "

Protected resource retrieved successfully!

\n" . '

'.encode_entities($response->decoded_content).'

'; } else { $content .= '

Error: '. $response->status_line."

\n"; } $content =~ s[\n][
\n]g; html_page($content); }; get '/' => sub { my $content = ''; while (my ($k,$v) = each %{config->{sites}}) { $content .= qq{

$v->{name}: /get/$k

\n} if $v->{client_id} && $v->{client_secret}; } $content ||= "

You haven't configured any sites yet.
\n" . "Edit your config.yml file!

\n"; html_page($content); }; dance; exit 0; ### Helpers sub html_page($) { my $content = shift; return < OAuth 2 Test

OAuth 2 Test

$content EOT } sub client($) { my $site_id = shift; my $site_config = config->{sites}{$site_id} || {}; my $redirect = uri_for("/got/$site_id"); $redirect =~ s,/dispatch\.cgi,,; Net::OAuth2::Profile::WebServer->new ( %$site_config , redirect_uri => $redirect ); } Net-OAuth2-0.67/examples/psgi/config.yml0000644000175000017500000000407213537627336017436 0ustar thomasthomaslog: 'core' access_log: 1 show_errors: 1 sites: 37signals: name: '37Signals' client_id: '' client_secret: '' site: 'https://launchpad.37signals.com/' authorize_path: '/authorization/new' access_token_path: '/authorization/token' protected_resource_path: '/authorization.xml' facebook: name: 'Facebook' client_id: '' client_secret: '' site: 'https://graph.facebook.com' protected_resource_path: '/me' mixi: name: 'mixi' client_id: '' client_secret: '' site: 'https://mixi.jp' authorize_url: 'https://mixi.jp/connect_authorize.pl' access_token_url: 'https://secure.mixi-platform.com/2/token' google: name: 'Google Contacts' client_id: '' client_secret: '' site: 'https://accounts.google.com' authorize_path: '/o/oauth2/auth' access_token_path: '/o/oauth2/token' scope: 'openid profile email' state: '1a2b3c' hd: 'gmail.com' protected_resource_url: 'https://www.googleapis.com/userinfo/v2/me' yandex: name: 'Yandex Direct' client_id: '' client_secret: '' username: '' password: '' site: 'https://oauth.yandex.ru' authorize_path: '/authorize' access_token_path: '/token' bearer_token_scheme: 'auth-header' protected_resource_url: 'http://api-fotki.yandex.ru/api/me/' instagram: client_id: '' client_secret: '' site: 'https://api.instagram.com' authorize_path: '/oauth/authorize' access_token_path: '/oauth/access_token' scope: 'comments relationships likes' Net-OAuth2-0.67/examples/psgi/dispatch.cgi0000644000175000017500000000023513537627336017726 0ustar thomasthomas#!/usr/bin/perl use strict; use warnings; use Plack::Util; use Plack::Loader; my $app = Plack::Util::load_psgi("app.psgi"); Plack::Loader->auto->run($app); Net-OAuth2-0.67/examples/.htaccess0000644000175000017500000000023613537627336016300 0ustar thomasthomasRewriteEngine On RewriteCond %{REQUEST_FILENAME} !-f RewriteRule ^(.*)$ /dispatch.cgi/$1 [QSA,L] Order allow,deny Deny from all Net-OAuth2-0.67/lib/0000755000175000017500000000000013544612532013417 5ustar thomasthomasNet-OAuth2-0.67/lib/Net/0000755000175000017500000000000013544612532014145 5ustar thomasthomasNet-OAuth2-0.67/lib/Net/OAuth2.pod0000644000175000017500000000202514124363460015750 0ustar thomasthomas=encoding utf8 =head1 NAME Net::OAuth2 - OAuth 2.0 implementation =head1 SYNOPSIS See Net::OAuth2::Profile::WebServer->new =head1 DESCRIPTION OAuth version 2.0 is a follow-up on OAuth 1.0, which is not supported by this module. The specification for version 2.0 can be found in =over 4 =item . RFC6749, Authorization framework: L =item . RFC6750, Bearer token usage: L =back Start with one these modules: =over 4 =item . L =item . L =back =head1 COPYRIGHTS Copyrights 2013-2019 on the perl code and the related documentation by [Mark Overmeer ] for SURFnet bv, The Netherlands. For other contributors see L. Copyrights 2011-2012 by Keith Grennan. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Net-OAuth2-0.67/lib/Net/OAuth2.pm0000644000175000017500000000076514124363460015613 0ustar thomasthomas# Copyrights 2013-2019 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Net-OAuth2. Meta-POD processed # with OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Net::OAuth2; use vars '$VERSION'; $VERSION = '0.67'; use warnings; use strict; 1; Net-OAuth2-0.67/lib/Net/OAuth2/0000755000175000017500000000000013544612532015247 5ustar thomasthomasNet-OAuth2-0.67/lib/Net/OAuth2/Profile.pm0000644000175000017500000002244214124363460017207 0ustar thomasthomas# Copyrights 2013-2019 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Net-OAuth2. Meta-POD processed # with OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Net::OAuth2::Profile; use vars '$VERSION'; $VERSION = '0.67'; use warnings; use strict; use Carp qw(carp croak confess); use MIME::Base64 qw(encode_base64); use LWP::UserAgent (); use URI (); use JSON::MaybeXS qw/decode_json/; use Scalar::Util qw/blessed/; use Encode qw/encode/; use constant MIME_URLENC => 'application/x-www-form-urlencoded'; # old names still supported: # bearer_token_scheme => token_scheme sub new(@) { my $class = shift; $class ne __PACKAGE__ or carp 'you need to create an extension, not base-class '.__PACKAGE__; (bless {}, $class)->init( {@_} ); } # rfc6849 Appendix B, http://www.w3.org/TR/1999/REC-html401-19991224 sub _url_enc($) { my $x = encode 'utf8', shift; # make bytes $x =~ s/([^A-Za-z0-9 ])/sprintf("%%%02x", ord $1)/ge; $x =~ s/ /+/g; $x; } sub init($) { my ($self, $args) = @_; my $id = $self->{NOP_id} = $args->{client_id} or carp "profile needs id"; my $secret = $self->{NOP_secret} = $args->{client_secret} or carp "profile needs secret"; $self->{NOP_id_enc} = _url_enc $id; $self->{NOP_secret_enc} = _url_enc $secret; $self->{NOP_agent} = $args->{user_agent} || LWP::UserAgent->new; $self->{NOP_scheme} = $args->{token_scheme} || $args->{bearer_token_scheme} || 'auth-header:Bearer'; $self->{NOP_scope} = $args->{scope}; $self->{NOP_state} = $args->{state}; $self->{NOP_hd} = $args->{hd}; $self->{NOP_method} = $args->{access_token_method} || 'POST'; $self->{NOP_acc_param} = $args->{access_token_param} || []; $self->{NOP_init_params} = $args->{init_params}; $self->{NOP_grant_type} = $args->{grant_type}; $self->{NOP_show_secret} = exists $args->{secrets_in_params} ? $args->{secrets_in_params} : 1; my $site = $self->{NOP_site} = $args->{site}; foreach my $c (qw/access_token protected_resource authorize refresh_token/) { my $link = $args->{$c.'_url'} || $args->{$c.'_path'} || "/oauth/$c"; $self->{"NOP_${c}_url"} = $self->site_url($link); $self->{"NOP_${c}_method"} = $args->{$c.'_method'} || 'POST'; $self->{"NOP_${c}_param"} = $args->{$c.'_param'} || []; } $self; } #---------------- sub id() {shift->{NOP_id}} sub id_enc() {shift->{NOP_id_enc}} sub secret() {shift->{NOP_secret}} sub secret_enc() {shift->{NOP_secret_enc}} sub user_agent() {shift->{NOP_agent}} sub site() {shift->{NOP_site}} sub scope() {shift->{NOP_scope}} sub state() {shift->{NOP_state}} sub hd() {shift->{NOP_hd}} sub grant_type() {shift->{NOP_grant_type}} sub bearer_token_scheme() {shift->{NOP_scheme}} #---------------- sub request($@) { my ($self, $request) = (shift, shift); #print $request->as_string; my $response = $self->user_agent->request($request, @_); #print $response->as_string; #$response; } sub request_auth(@) { my ($self, $token) = (shift, shift); my $request; if(@_==1) { $request = shift } else { my ($method, $uri, $header, $content) = @_; $request = HTTP::Request->new ( $method => $self->site_url($uri) , $header, $content ); } $self->add_token($request, $token, $self->bearer_token_scheme); $self->request($request); } #-------------------- sub site_url($@) { my ($self, $path) = (shift, shift); my @params = @_==1 && ref $_[0] eq 'HASH' ? %{$_[0]} : @_; my $site = $self->site; my $uri = $site ? URI->new_abs($path, $site) : URI->new($path); $uri->query_form($uri->query_form, @params) if @params; $uri; } sub add_token($$$) { my ($self, $request, $token, $bearer) = @_; my $access = $token->access_token; my ($scheme, $opt) = split ':', $bearer; $scheme = lc $scheme; if($scheme eq 'auth-header') { # Specs suggest using Bearer or OAuth2 for this value, but OAuth # appears to be the de facto accepted value. # Going to use OAuth until there is wide acceptance of something else. my $auth_scheme = $opt || 'OAuth'; $request->headers->header(Authorization => "$auth_scheme $access"); } elsif($scheme eq 'uri-query') { my $query_param = $opt || 'oauth_token'; $request->uri->query_form($request->uri->query_form , $query_param => $access); } elsif($scheme eq 'form-body') { $request->headers->content_type eq MIME_URLENC or croak "embedding access token in request body is only valid " . "for 'MIME_URLENC' content type"; my $query_param = $opt || 'oauth_token'; my $content = $request->content; $request->add_content(($content && length $content ? '&' : '') . uri_escape($query_param).'='.uri_escape($access)); } else { carp "unknown bearer schema $bearer"; } $request; } sub build_request($$$) { my ($self, $method, $uri_base, $params) = @_; my %params = ref $params eq 'HASH' ? %$params : @$params; my $basic; # rfc6749 section "2.3.1. Client Password" # The Auth Header is always supported, but client_id/client_secret as # parameters may be as well. We do the latter when ->new(secrets_in_params) # to support old servers. unless ($self->{NOP_show_secret}) { $basic = encode_base64("$params{client_id}:$params{client_secret}", ''); delete @params{qw/client_id client_secret/}; } my $request; if($method eq 'POST') { my $p = URI->new('http:'); # taken from HTTP::Request::Common $p->query_form(%params); $request = HTTP::Request->new ( $method => $uri_base , [Content_Type => MIME_URLENC] , $p->query ); } elsif($method eq 'GET') { my $uri = blessed $uri_base && $uri_base->isa('URI') ? $uri_base->clone : URI->new($uri_base); $uri->query_form($uri->query_form, %params); $request = HTTP::Request->new($method, $uri); } else { confess "unknown request method $method"; } my $uri = $request->uri; my $head = $request->headers; $request->protocol('HTTP/1.1'); # 2016-01-15 Instagram does not like the portnumber to appear # my ($host, $port) = ($uri->host, $uri->port); # $host .= ':'.$port if $port != $uri->default_port; $head->header(Host => $uri->host); $head->header(Connection => 'Keep-Alive'); $head->header(Authorization => "Basic $basic") if $basic; $request; } sub params_from_response($$) { my ($self, $response, $why) = @_; my ($error, $content); $content = $response->decoded_content || $response->content if $response; if(!$response) { $error = 'no response received'; } elsif(!$response->is_success) { $error = 'received error: '.$response->status_line; } else { # application/json is often not correctly configured: is not # (yet) an apache pre-configured extension :( if(my $params = eval {decode_json $content} ) { # content is JSON return ref $params eq 'HASH' ? %$params : @$params; } # otherwise form-encoded parameters (I hope) my $uri = URI->new; $uri->query($content); my @res_params = $uri->query_form; return @res_params if @res_params; $error = "cannot read parameters from response"; } substr($content, 200) = '...' if length $content > 200; croak "failed oauth call $why: $error\n$content\n"; } sub authorize_method() {panic} # user must use autorize url sub access_token_method() {shift->{NOP_access_token_method} } sub refresh_token_method() {shift->{NOP_refresh_token_method} } sub protected_resource_method() {shift->{NOP_protected_resource_method} } sub authorize_url() {shift->{NOP_authorize_url}} sub access_token_url() {shift->{NOP_access_token_url}} sub refresh_token_url() {shift->{NOP_refresh_token_url}} sub protected_resource_url() {shift->{NOP_protected_resource_url}} sub authorize_params(%) { my $self = shift; my %params = (@{$self->{NOP_authorize_param}}, @_); $params{scope} ||= $self->scope; $params{state} ||= $self->state; $params{hd} ||= $self->hd; $params{client_id} ||= $self->id; \%params; } sub access_token_params(%) { my $self = shift; my %params = (@{$self->{NOP_access_token_param}}, @_); $params{code} ||= ''; $params{client_id} ||= $self->id; $params{client_secret} ||= $self->secret; $params{grant_type} ||= $self->grant_type; \%params; } sub refresh_token_params(%) { my $self = shift; my %params = (@{$self->{NOP_refresh_token_param}}, @_); $params{client_id} ||= $self->id; $params{client_secret} ||= $self->secret; \%params; } sub protected_resource_params(%) { my $self = shift; my %params = (@{$self->{NOP_protected_resource_param}}, @_); \%params; } 1; Net-OAuth2-0.67/lib/Net/OAuth2/AccessToken.pm0000644000175000017500000001127514124363460020013 0ustar thomasthomas# Copyrights 2013-2019 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Net-OAuth2. Meta-POD processed # with OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Net::OAuth2::AccessToken; use vars '$VERSION'; $VERSION = '0.67'; use warnings; use strict; our $VERSION; # to be able to test in devel environment use Carp qw(croak); use JSON::MaybeXS qw/encode_json/; # Attributes to be saved to preserve the session. my @session = qw/access_token token_type refresh_token expires_at scope state auto_refresh/; # This class name is kept for backwards compatibility: a better name # would have been: Net::OAuth2::Session, with a ::Token::Bearer split-off. # In the future, most of this functionality will probably need to be # split-off in a base class ::Token, to be shared with a new extension # which supports HTTP-MAC tokens as proposed by ietf dragt # http://datatracker.ietf.org/doc/draft-ietf-oauth-v2-http-mac/ sub new(@) { my $class = shift; (bless {}, $class)->init({@_}) } sub init($) { my ($self, $args) = @_; $self->{NOA_expires_at} = $args->{expires_at} || ($args->{expires_in} ? time()+$args->{expires_in} : undef); # client is the pre-v0.50 name my $profile = $self->{NOA_profile} = $args->{profile} || $args->{client} or croak "::AccessToken needs profile object"; $self->{NOA_access_token} = $args->{access_token}; $self->{NOA_refresh_token} = $args->{refresh_token}; $self->{NOA_refresh_always}= $args->{refresh_always}; $self->{NOA_scope} = $args->{scope}; $self->{NOA_state} = $args->{state}; $self->{NOA_hd} = $args->{hd}; $self->{NOA_token_type} = $args->{token_type}; $self->{NOA_auto_refresh} = $args->{auto_refresh}; $self->{NOA_changed} = $args->{changed}; $self->{NOA_error} = $args->{error}; $self->{NOA_error_uri} = $args->{error_uri}; $self->{NOA_error_descr} = $args->{error_description} || $args->{error}; $self->{NOA_attr} = $args; $self; } sub session_thaw($%) { my ($class, $session) = (shift, shift); # we can use $session->{net_oauth2_version} to upgrade the info $class->new(%$session, @_); } #-------------- sub token_type() {shift->{NOA_token_type}} sub scope() {shift->{NOA_scope}} sub state() {shift->{NOA_state}} sub hd() {shift->{NOA_hd}} sub profile() {shift->{NOA_profile}} sub attribute($) { $_[0]->{NOA_attr}{$_[1]} } sub changed(;$) { my $s = shift; @_ ? $s->{NOA_changed} = shift : $s->{NOA_changed} } sub access_token() { my $self = shift; if($self->expired) { delete $self->{NOA_access_token}; $self->{NOA_changed} = 1; $self->refresh if $self->auto_refresh; } elsif($self->refresh_always) { $self->refresh; } $self->{NOA_access_token}; } #--------------- sub error() {shift->{NOA_error}} sub error_uri() {shift->{NOA_error_uri}} sub error_description() {shift->{NOA_error_descr}} #--------------- sub refresh_token() {shift->{NOA_refresh_token}} sub refresh_always() {shift->{NOA_refresh_always}} sub auto_refresh() {shift->{NOA_auto_refresh}} sub expires_at() { shift->{NOA_expires_at} } sub expires_in() { shift->expires_at - time() } sub expired(;$) { my ($self, $after) = @_; my $when = $self->expires_at or return; $after = 15 unless defined $after; $when < time() + $after; } sub update_token($$$;$) { my ($self, $token, $type, $exp, $refresh) = @_; $self->{NOA_access_token} = $token; $self->{NOA_token_type} = $type if $type; $self->{NOA_expires_at} = $exp; $self->{NOA_refresh_token} = $refresh if defined $refresh; $token; } #-------------- sub to_json() { my $self = shift; encode_json $self->session_freeze; } *to_string = \&to_json; # until v0.50 sub session_freeze(%) { my ($self, %args) = @_; my %data = (net_oauth2_version => $VERSION); defined $self->{"NOA_$_"} && ($data{$_} = $self->{"NOA_$_"}) for @session; $self->changed(0); \%data; } sub refresh() { my $self = shift; $self->profile->update_access_token($self); } #-------------- sub request{ my $s = shift; $s->profile->request_auth($s, @_) } sub get { my $s = shift; $s->profile->request_auth($s, 'GET', @_) } sub post { my $s = shift; $s->profile->request_auth($s, 'POST', @_) } sub delete { my $s = shift; $s->profile->request_auth($s, 'DELETE', @_) } sub put { my $s = shift; $s->profile->request_auth($s, 'PUT', @_) } 1; Net-OAuth2-0.67/lib/Net/OAuth2/Profile.pod0000644000175000017500000001455114124363460017357 0ustar thomasthomas=encoding utf8 =head1 NAME Net::OAuth2::Profile - OAuth2 access profiles =head1 INHERITANCE Net::OAuth2::Profile is extended by Net::OAuth2::Profile::Password Net::OAuth2::Profile::WebServer =head1 SYNOPSIS See Net::OAuth2::Profile::WebServer and Net::OAuth2::Profile::Password =head1 DESCRIPTION Base class for OAuth `profiles'. Currently implemented: =over 4 =item * L =item * L =back You may want to use the L to understand the process and the parameters. =head1 METHODS =head2 Constructors =over 4 =item Net::OAuth2::Profile-EB(%options) Next to the %options listed below, it is possible to provide settings for each of the <${commands}> C, C, C, and C. For each command, you can set =over 4 =item * ${command}_url => URI|STRING The absolute uri which needs to be used to be addressed to execute the C<$command>. May be specified as URI object or STRING. =item * ${command}_path => PATH As previous, but relative to the C option value. =item * ${command}_method => 'GET'|'POST' Which method to use for the call (by default POST). =item * ${command}_param => [] Additional parameters for the command. =back -Option --Default client_id client_secret grant_type hd undef scope undef secrets_in_params site undef state undef token_scheme 'auth-header:Bearer' user_agent =over 2 =item client_id => STRING =item client_secret => STRING =item grant_type => STRING =item hd => STRING Passthrough parameter that allows you to restrict one's login to a particular Google Apps domain. The application making the call should check that the returned value for hd matches the expected domain, as the user can change the hd parameter in the original request. See F for more details. =item scope => STRING =item secrets_in_params => BOOLEAN The client secrets are passed both via an Authentication header, as via query parameters in the URI. The former is required to be accepted by rfc6749, the latter is optional. However: many servers use the query parameters only. QQ Catalyst, on the other hand, does refuse requests with these parameters in the query. So, with this flag explicitly set to false, only the Auth header gets included. =item site => URI =item state => STRING =item token_scheme => SCHEME See L for the supported SCHEMEs. Scheme C is probably the only sane default, because that works with any kind of http requests, where the other options have limited or possible disturbing application. Before [0.53], the default was 'auth-header:OAuth'. Specify the method to submit authenticated requests to the service. By default, add the access token as a header, such as: "Authorization: Bearer TOKEN". Some services require that the header will be different, i.e. "Authorization: OAuth TOKEN", for which case specify token_scheme 'auth-header:Oauth'. To add the access token as a uri-parameter: 'uri-query:oauth_token' (in this case, the parameter name will be oauth_token) Merge the access token inside a form body via 'form-body:oauth_token' =item user_agent => LWP::UserAgent object =back =back =head2 Accessors =over 4 =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =back =head2 Actions =head3 HTTP =over 4 =item $obj-EB( $request, [$more] ) Send the $request (a HTTP::Request object) to the server, calling LWP::UserAgent method C. This method will NOT add security token information to the message. =item $obj-EB( $token, <$request | <$method, $uri, [$header, $content]>> ) Send an authorized request: the $token information gets included in the request object. Returns the answer (HTTP::Response). example: my $auth = Net::OAuth2::Profile::WebServer->new(...); my $token = $auth->get_access_token($code, ...); # possible... my $resp = $auth->request_auth($token, GET => $uri, $header, $content); my $resp = $auth->request_auth($token, $request); # nicer (?) my $resp = $token->get($uri, $header, $content); my $resp = $token->request($request); =back =head2 Helpers =over 4 =item $obj-EB($request, $token, $scheme) Merge information from the $token into the $request following the the bearer token $scheme. Supported schemes: =over 4 =item * auth-header or auth-header:REALM Adds an C header to requests. The default REALM is C, but C and C may work as well. =item * uri-query or uri-query:FIELD Adds the token to the query parameter list. The default FIELD name used is C. =item * form-body or form-body:FIELD Adds the token to the www-form-urlencoded body of the request. The default FIELD name used is C. =back =item $obj-EB($method, $uri, $params) Returns a HTTP::Request object. $params is an HASH or an ARRAY-of-PAIRS of query parameters. =item $obj-EB($response, $reason) Decode information from the $response by the server (an HTTP::Response object). The $reason for this answer is used in error messages. =item $obj-EB( <$uri|$path>, $params ) Construct a URL to address the site. When a full $uri is passed, it appends the $params as query parameters. When a $path is provided, it is relative to L. =back =head1 COPYRIGHTS Copyrights 2013-2019 on the perl code and the related documentation by [Mark Overmeer ] for SURFnet bv, The Netherlands. For other contributors see L. Copyrights 2011-2012 by Keith Grennan. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Net-OAuth2-0.67/lib/Net/OAuth2/Client.pod0000644000175000017500000000404414124363460017171 0ustar thomasthomas=encoding utf8 =head1 NAME Net::OAuth2::Client - client for OAuth2 access, deprecated interface =head1 SYNOPSIS # This module provides the deprecated interface my $client = Net::OAuth2::Client->new( $client_id, $client_secret, site => $site ); my $auth = $client->web_server( redirect_path => "$site/auth/facebook/callback" ); # interface since v0.50 my $client = Net::OAuth2::Profile::WebServer->new( client_id => $client_id, client_secret => $client_secret, site => $site redirect_uri => "$site/auth/facebook/callback" ); =head1 DESCRIPTION This module is kept to translate the expired interface into the new interface. =head1 METHODS =head2 Constructors =over 4 =item Net::OAuth2::Client-EB($id, $secret, %options) This object collects all %options to be used when L creates a profile. The $id will be translated into OPTION C, and $secret to C. =back =head2 Accessors =over 4 =item $obj-EB() =item $obj-EB() =item $obj-EB() =back =head2 Actions =over 4 =item $obj-EB(%options) Create a L object, based on all options passed with L, overruled/extended by the %options passed here. =item $obj-EB(%options) Create a L object, based on all options passed with L, overruled/extended by the %options passed here. =back =head1 COPYRIGHTS Copyrights 2013-2019 on the perl code and the related documentation by [Mark Overmeer ] for SURFnet bv, The Netherlands. For other contributors see L. Copyrights 2011-2012 by Keith Grennan. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Net-OAuth2-0.67/lib/Net/OAuth2/AccessToken.pod0000644000175000017500000001602214124363460020154 0ustar thomasthomas=encoding utf8 =head1 NAME Net::OAuth2::AccessToken - OAuth2 bearer token =head1 SYNOPSIS my $auth = Net::OAuth2::Profile::WebServer->new(...); my $session = $auth->get_access_token($code, ...); # $session is a Net::OAuth2::AccessToken object if($session->error) { print $session->error_description; } my $response = $session->get($request); my $response = $session->get($header, $content); print $session->to_string; # JSON # probably better to set new(auto_refresh), but you may do: $session->refresh if $session->expired; =head1 DESCRIPTION This object represents a received (bearer) token, and offers ways to use it and maintain it. A better name for this module would include B. A "bearer token" is an abstract proof of your existence: different services or potentially different physical servers are able to exchange information about your session based on this, for instance whether someone logged-in while showing the token. =head1 METHODS =head2 Constructors =over 4 =item Net::OAuth2::AccessToken-EB(%options) -Option --Default access_token undef auto_refresh changed error undef error_description error_uri undef expires_at undef expires_in undef profile refresh_always BOOLEAN refresh_token false scope undef token_type undef =over 2 =item access_token => STRING =item auto_refresh => BOOLEAN Refresh the token when expired. =item changed => BOOLEAN [0.52] The token (session) needs to be saved. =item error => STRING Set when an error has occured, the token is not valid. This is not numerical. =item error_description => STRING A humanly readible explanation on the error. This defaults to the string set with the C option, which is not nice to read. =item error_uri => URI Where to find more details about the error. =item expires_at => TIMESTAMP Expire this token after TIMESTAMP (as produced by the time() function) =item expires_in => SECONDS Expire the token SECONDS after the initiation of this object. =item profile => L object =item refresh_always => BOOLEAN [0.53] Auto-refresh the token at each use. =item refresh_token => STRING [0.53] Token which can be used to refresh the token, after it has expired or earlier. =item scope => URL =item token_type => TYPE =back =item Net::OAuth2::AccessToken-EB($session, %options) Pass in the output of a L call in the past (maybe even for an older version of this module) and get the token object revived. This $session is a HASH. You may pass any of the parameters for L as %options, to overrule the values inside the $session. -Option --Default profile =over 2 =item profile => L object =back example: my $auth = Net::OAuth2::Profile::WebServer->new(...); my $token = $auth->get_access_token(...); my $session = $token->session_freeze; # now save $session in database or file ... # restore session my $auth = Net::OAuth2::Profile::WebServer->new(...); my $token = Net::OAuth2::AccessToken->session_thaw($session , profile => $auth); =back =head2 Accessors =over 4 =item $obj-EB() Returns the (base64 encoded version of the) access token. The token will get updated first, if it has expired and refresh_token is enabled, or when L is set. It does not matter that the token is base64 encoded or not: it will always need to be base64 encoded during transport. =item $obj-EB(NAME) [0.58] Sometimes, the token gets attributes which are not standard; they have no official accessor (yet?). You can get them with this generic accessor. =item $obj-EB( [BOOLEAN] ) [0.52] The session (token) needs to be saved, because any of the crucial parameters have been modified and C is not defined by the profile. =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =back =head3 errors When the token is received (hence this object created) it be the result of an error. It is the way the original code was designed... =over 4 =item $obj-EB() =item $obj-EB() =item $obj-EB() =back =head3 Expiration =over 4 =item $obj-EB() =item $obj-EB( [$after] ) Returns true when the token has an expiration set and that time has passed. We use this token $after this check: to avoid the token to timeout inbetween, we take (by default 15 seconds) margin. =item $obj-EB( [$timestamp] ) Returns the expiration timestamp of this token (true) or C (false) when it is not set. =item $obj-EB() Returns the number of seconds left, before the token is expired. That may be negative. =item $obj-EB() =item $obj-EB() =item $obj-EB( $token, $tokentype, $expires_at, [$refresh_token] ) Change the token. =back =head2 Actions =over 4 =item $obj-EB() Refresh the token, even if it has not expired yet. Returned is the new access_token value, which may be undef on failure. =item $obj-EB(%options) This returns a SESSION (a flat HASH) containing all token parameters which needs to be saved to be able to restore this token later. This SESSION can be passed to L to get revived. The C flag will be cleared by this method. Be sure that your storage is character-set aware. For instance, you probably want to set 'mysql_enable_utf8' when you store this in a MySQL database. Perl's JSON module will output utf8 by default. =item $obj-EB() Freeze this object into JSON. The JSON syntax is also used by the OAuth2 protocol, so a logical choice to provide. However, generically, the L method provided. =back =head3 HTTP The token can be encoded in transport protocol in different ways. Using these method will add the token to the HTTP messages sent. =over 4 =item $obj-EB( $uri, [$header, [$content]] ) =item $obj-EB( $uri, [$header, [$content]] ) =item $obj-EB( $uri, [$header, [$content]] ) =item $obj-EB( $uri, [$header, [$content]] ) =item $obj-EB($request) =back =head1 COPYRIGHTS Copyrights 2013-2019 on the perl code and the related documentation by [Mark Overmeer ] for SURFnet bv, The Netherlands. For other contributors see L. Copyrights 2011-2012 by Keith Grennan. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Net-OAuth2-0.67/lib/Net/OAuth2/Client.pm0000644000175000017500000000226614124363460017027 0ustar thomasthomas# Copyrights 2013-2019 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Net-OAuth2. Meta-POD processed # with OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Net::OAuth2::Client; use vars '$VERSION'; $VERSION = '0.67'; use warnings; use strict; use LWP::UserAgent (); use URI (); use Net::OAuth2::Profile::WebServer; use Net::OAuth2::Profile::Password; sub new($$@) { my ($class, $id, $secret, %opts) = @_; $opts{client_id} = $id; $opts{client_secret} = $secret; # auto-shared user-agent $opts{user_agent} ||= LWP::UserAgent->new; bless \%opts, $class; } #---------------- sub id() {shift->{NOC_id}} sub secret() {shift->{NOC_secret}} sub user_agent() {shift->{NOC_agent}} #---------------- sub web_server(@) { my $self = shift; Net::OAuth2::Profile::WebServer->new(%$self, @_); } sub password(@) { my $self = shift; Net::OAuth2::Profile::Password->new(%$self, @_); } 1; Net-OAuth2-0.67/lib/Net/OAuth2/Profile/0000755000175000017500000000000013544612532016647 5ustar thomasthomasNet-OAuth2-0.67/lib/Net/OAuth2/Profile/WebServer.pm0000644000175000017500000001072114124363460021110 0ustar thomasthomas# Copyrights 2013-2019 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Net-OAuth2. Meta-POD processed # with OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Net::OAuth2::Profile::WebServer; use vars '$VERSION'; $VERSION = '0.67'; use base 'Net::OAuth2::Profile'; use warnings; use strict; use Carp qw(croak); use Net::OAuth2::AccessToken; use Scalar::Util 'blessed'; use HTTP::Request (); use HTTP::Response (); use HTTP::Status qw(HTTP_TEMPORARY_REDIRECT); sub init($) { my ($self, $args) = @_; $args->{grant_type} ||= 'authorization_code'; $self->SUPER::init($args); $self->{NOPW_redirect} = $args->{redirect_uri}; $self->{NOPW_referer} = $args->{referer}; $self->{NOPW_auto_save} = $args->{auto_save} || sub { my $token = shift; $token->changed(1) }; $self; } #------------------- sub redirect_uri() {shift->{NOPW_redirect}} sub referer(;$) { my $s = shift; @_ ? $s->{NOPW_referer} = shift : $s->{NOPW_referer} } sub auto_save() {shift->{NOPW_auto_save}} #-------------------- sub authorize(@) { my ($self, @req_params) = @_; # temporary, for backward compatibility warning my $uri_base = $self->SUPER::authorize_url; # my $uri_base = $self->authorize_url; my $uri = blessed $uri_base && $uri_base->isa('URI') ? $uri_base->clone : URI->new($uri_base); my $params = $self->authorize_params(@req_params); $uri->query_form($uri->query_form, %$params); $uri; } # Net::OAuth2 returned the url+params here, but this should return the # accessor to the parameter with this name. The internals of that code # was so confused that it filled-in the params multiple times. sub authorize_url() { require Carp; Carp::confess("do not use authorize_url() but authorize()! (since v0.50)"); } sub authorize_response(;$) { my ($self, $request) = @_; my $resp = HTTP::Response->new ( HTTP_TEMPORARY_REDIRECT => 'Get authorization grant' , [ Location => $self->authorize ] ); $resp->request($request) if $request; $resp; } sub get_access_token($@) { my ($self, $code, @req_params) = @_; my $params = $self->access_token_params(code => $code, @req_params); my $request = $self->build_request ( $self->access_token_method , $self->access_token_url , $params ); my $response = $self->request($request); Net::OAuth2::AccessToken->new ( profile => $self , auto_refresh => !!$self->auto_save , $self->params_from_response($response, 'access token') ); } sub update_access_token($@) { my ($self, $access, @req_params) = @_; my $refresh = $access->refresh_token or croak 'unable to refresh token without refresh_token'; my $req = $self->build_request ( $self->refresh_token_method , $self->refresh_token_url , $self->refresh_token_params(refresh_token => $refresh, @req_params) ); my $resp = $self->request($req); my %data = $self->params_from_response($resp, 'update token'); my $token = $data{access_token} or croak "no access token found in refresh data"; my $type = $data{token_type}; my $exp = $data{expires_in} or croak "no expires_in found in refresh data"; $access->update_token($token, $type, $exp+time(), $data{refresh_token}); } sub authorize_params(%) { my $self = shift; my $params = $self->SUPER::authorize_params(@_); $params->{response_type} ||= 'code'; # should not be required: usually the related between client_id and # redirect_uri is fixed to avoid security issues. my $r = $self->redirect_uri; $params->{redirect_uri} ||= $r if $r; $params; } sub access_token_params(%) { my $self = shift; my $params = $self->SUPER::access_token_params(@_); $params->{redirect_uri} ||= $self->redirect_uri; $params; } sub refresh_token_params(%) { my $self = shift; my $params = $self->SUPER::refresh_token_params(@_); $params->{grant_type} ||= 'refresh_token'; $params; } #-------------------- sub build_request($$$) { my $self = shift; my $request = $self->SUPER::build_request(@_); if(my $r = $self->referer) { $request->header(Referer => $r); } $request; } #-------------------- 1; Net-OAuth2-0.67/lib/Net/OAuth2/Profile/Password.pod0000644000175000017500000000706714124363460021165 0ustar thomasthomas=encoding utf8 =head1 NAME Net::OAuth2::Profile::Password - OAuth2 for web-server use =head1 INHERITANCE Net::OAuth2::Profile::Password is a Net::OAuth2::Profile =head1 SYNOPSIS my $auth = Net::OAuth2::Profile::Password->new(...); $auth->get_access_token(...); =head1 DESCRIPTION Extends L<"DESCRIPTION" in Net::OAuth2::Profile|Net::OAuth2::Profile/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Net::OAuth2::Profile|Net::OAuth2::Profile/"METHODS">. =head2 Constructors Extends L<"Constructors" in Net::OAuth2::Profile|Net::OAuth2::Profile/"Constructors">. =over 4 =item Net::OAuth2::Profile::Password-EB(%options) -Option --Defined in --Default client_id Net::OAuth2::Profile client_secret Net::OAuth2::Profile grant_type Net::OAuth2::Profile 'password' hd Net::OAuth2::Profile undef scope Net::OAuth2::Profile undef secrets_in_params Net::OAuth2::Profile site Net::OAuth2::Profile undef state Net::OAuth2::Profile undef token_scheme Net::OAuth2::Profile 'auth-header:Bearer' user_agent Net::OAuth2::Profile =over 2 =item client_id => STRING =item client_secret => STRING =item grant_type => STRING =item hd => STRING =item scope => STRING =item secrets_in_params => BOOLEAN =item site => URI =item state => STRING =item token_scheme => SCHEME =item user_agent => LWP::UserAgent object =back =back =head2 Accessors Extends L<"Accessors" in Net::OAuth2::Profile|Net::OAuth2::Profile/"Accessors">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Actions Extends L<"Actions" in Net::OAuth2::Profile|Net::OAuth2::Profile/"Actions">. =head2 Helpers Extends L<"Helpers" in Net::OAuth2::Profile|Net::OAuth2::Profile/"Helpers">. =over 4 =item $obj-EB($request, $token, $scheme) Inherited, see L =item $obj-EB($method, $uri, $params) Inherited, see L =item $obj-EB($response, $reason) Inherited, see L =item $obj-EB( <$uri|$path>, $params ) Inherited, see L =back =head2 Action =over 4 =item $obj-EB(%options) -Option --Default password username =over 2 =item password => PASSWORD =item username => USER =back =back =head1 COPYRIGHTS Copyrights 2013-2019 on the perl code and the related documentation by [Mark Overmeer ] for SURFnet bv, The Netherlands. For other contributors see L. Copyrights 2011-2012 by Keith Grennan. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Net-OAuth2-0.67/lib/Net/OAuth2/Profile/Password.pm0000644000175000017500000000217614124363460021013 0ustar thomasthomas# Copyrights 2013-2019 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Net-OAuth2. Meta-POD processed # with OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Net::OAuth2::Profile::Password; use vars '$VERSION'; $VERSION = '0.67'; use base 'Net::OAuth2::Profile'; use warnings; use strict; use URI; use Net::OAuth2::AccessToken; use HTTP::Request; sub init($) { my ($self, $args) = @_; $args->{grant_type} ||= 'password'; $self->SUPER::init($args); $self; } #------------------- #-------------------- sub get_access_token(@) { my $self = shift; my $request = $self->build_request ( $self->access_token_method , $self->access_token_url , $self->access_token_params(@_) ); my $response = $self->request($request); Net::OAuth2::AccessToken->new(client => $self , $self->params_from_response($response, 'access token')); } 1; Net-OAuth2-0.67/lib/Net/OAuth2/Profile/WebServer.pod0000644000175000017500000002300514124363460021255 0ustar thomasthomas=encoding utf8 =head1 NAME Net::OAuth2::Profile::WebServer - OAuth2 for web-server use =head1 INHERITANCE Net::OAuth2::Profile::WebServer is a Net::OAuth2::Profile =head1 SYNOPSIS # See examples/psgi/ my $auth = Net::OAuth2::Profile::WebServer->new ( name => 'Google Contacts' , client_id => $id , client_secret => $secret , site => 'https://accounts.google.com' , scope => 'https://www.google.com/m8/feeds/' , authorize_path => '/o/oauth2/auth' , access_token_path => '/o/oauth2/token' , protected_resource_url => 'https://www.google.com/m8/feeds/contacts/default/full' ); # Let user ask for a grant from the resource owner print $auth->authorize_response->as_string; # or, in Plack: redirect $auth->authorize; # Prove your identity at the authorization server # The $info are the parameters from the callback to your service, it # will contain a 'code' value. my $access_token = $auth->get_access_token($info->{code}); # communicate with the resource serve my $response = $access_token->get('/me'); $response->is_success or die "error: " . $response->status_line; print "Yay, it worked: " . $response->decoded_content; =head1 DESCRIPTION Use OAuth2 in a WebServer context. Read the DETAILS section, far below this man-page before you start implementing this interface. Extends L<"DESCRIPTION" in Net::OAuth2::Profile|Net::OAuth2::Profile/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Net::OAuth2::Profile|Net::OAuth2::Profile/"METHODS">. =head2 Constructors Extends L<"Constructors" in Net::OAuth2::Profile|Net::OAuth2::Profile/"Constructors">. =over 4 =item Net::OAuth2::Profile::WebServer-EB(%options) -Option --Defined in --Default auto_save client_id Net::OAuth2::Profile client_secret Net::OAuth2::Profile grant_type Net::OAuth2::Profile 'authorization_code' hd Net::OAuth2::Profile undef redirect_uri undef referer undef scope Net::OAuth2::Profile undef secrets_in_params Net::OAuth2::Profile site Net::OAuth2::Profile undef state Net::OAuth2::Profile undef token_scheme Net::OAuth2::Profile 'auth-header:Bearer' user_agent Net::OAuth2::Profile =over 2 =item auto_save => CODE When a new token is received or refreshed, it usually needs to get save into a database or file. The moment you receive a new token is clear, but being aware of refreshes in your main program is a hassle. Read more about configuring this in the L section below. =item client_id => STRING =item client_secret => STRING =item grant_type => STRING =item hd => STRING =item redirect_uri => URI =item referer => URI Adds a C header to each request. Some servers check whether provided redirection uris point to the same server the page where the link was found. =item scope => STRING =item secrets_in_params => BOOLEAN =item site => URI =item state => STRING =item token_scheme => SCHEME =item user_agent => LWP::UserAgent object =back =back =head2 Accessors Extends L<"Accessors" in Net::OAuth2::Profile|Net::OAuth2::Profile/"Accessors">. =over 4 =item $obj-EB() =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() =item $obj-EB( [$uri] ) =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Actions Extends L<"Actions" in Net::OAuth2::Profile|Net::OAuth2::Profile/"Actions">. =over 4 =item $obj-EB(%options) On initial contact of a new user, you have to redirect to the resource owner. Somewhere in the near future, your application will be contacted again by the same user but then with an authorization grant code. Only the most common %options are listed... there may be more: read the docs on what your server expects. -Option --Default client_id new(client_id) response_type 'code' scope undef state undef =over 2 =item client_id => STRING =item response_type => STRING =item scope => STRING =item state => STRING =back example: my $auth = Net::OAuth2::Profile::WebServer->new(...); # From the Plack demo, included in this distribution (on CPAN) get '/get' => sub { redirect $auth->authorize }; # In generic HTTP, see method authorize_response use HTTP::Status 'HTTP_TEMPORARY_REDIRECT'; # 307 print HTTP::Response->new ( HTTP_TEMPORARY_REDIRECT => 'Get authorization grant' , [ Location => $auth->authorize ] )->as_string; =item $obj-EB( [$request] ) Convenience wrapper around L, to produce a complete HTTP::Response object to be sent back. =item $obj-EB(CODE, %options) -Option --Default client_id new(client_id) client_secret new(client_secret) =over 2 =item client_id => STRING =item client_secret => STRING =back =item $obj-EB($token, %options) Ask the server for a new token. You may pass additional %options as pairs. However, this method is often triggered automatically, in which case you can to use the C option of L. example: $auth->update_access_token($token); $token->refresh; # nicer =back =head2 Helpers Extends L<"Helpers" in Net::OAuth2::Profile|Net::OAuth2::Profile/"Helpers">. =over 4 =item $obj-EB($request, $token, $scheme) Inherited, see L =item $obj-EB($method, $uri, $params) Inherited, see L =item $obj-EB($response, $reason) Inherited, see L =item $obj-EB( <$uri|$path>, $params ) Inherited, see L =back =head1 DETAILS OAuth2 is a server-server protocol, not the usual client-server set-up. The consequence is that the protocol handlers on both sides will not wait for another during the communication: the remote uses callback urls to pass on the response. Your side of the communication, your webservice, needs to re-group these separate processing steps into logical sessions. =head2 The process The client side of the process has three steps, nicely described in L =over 4 =item 1. Send an authorization request to resource owner It needs a C: usually the name of the service where you want get access to. The answer is a redirect, based on the C which you usually pass on. Additional C, C, and C parameters can be needed or useful. The redirect will provide you with (amongst other things) a C parameter. =item 2. Translate the code into an access token With the code, you go to an authorization server which will validate your existence. An access token (and sometimes a refresh token) are returned. =item 3. Address the protected resource The access token, usually a 'bearer' token, is added to each request to the resource you want to address. The token may refresh itself when needed. =back =head2 Saving the token Your application must implement a persistent session, probably in a database or file. The session information is kept in an L object, and does contain more facts than just the access token. Let's discuss the three approaches. =head3 no saving The Plack example contained in the CPAN distribution of this module is a single process server. The tokens are administered in the memory of the process. It is nice to test your settings, but probably not realistic for any real-life application. =head3 automatic saving When your own code is imperative: my $auth = Net::OAuth2::Profile::WebServer->new ( ... , auto_save => \&save_session ); sub save_session($$) { my ($profile, $token) = @_; ... } When your own code is object oriented: sub init(...) { my ($self, ...) = @_; my $auth = Net::OAuth2::Profile::WebServer->new ( ... , auto_save => sub { $self->save_session(@_) } ); } sub save_session($$) { my ($self, $profile, $token) = @_; ... } =head3 explicit saving In this case, do not use L. =head1 COPYRIGHTS Copyrights 2013-2019 on the perl code and the related documentation by [Mark Overmeer ] for SURFnet bv, The Netherlands. For other contributors see L. Copyrights 2011-2012 by Keith Grennan. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Net-OAuth2-0.67/t/0000755000175000017500000000000013544612532013114 5ustar thomasthomasNet-OAuth2-0.67/t/01use.t0000644000175000017500000000056713537627336014260 0ustar thomasthomas#!/usr/bin/env perl use warnings; use strict; use lib 'lib', '../lib'; use Test::More tests => 6; use_ok('Net::OAuth2'); diag( "Testing Net::OAuth2 $Net::OAuth2::VERSION, Perl $], $^X" ); use_ok('Net::OAuth2::Client'); use_ok('Net::OAuth2::AccessToken'); use_ok('Net::OAuth2::Profile'); use_ok('Net::OAuth2::Profile::WebServer'); use_ok('Net::OAuth2::Profile::Password'); Net-OAuth2-0.67/t/20req.t0000644000175000017500000000352313537627336014247 0ustar thomasthomas#!/usr/bin/env perl # Check creation of request and decoding response use warnings; use strict; use lib 'lib', '../lib'; use Test::More tests => 16; use Data::Dumper; use Net::OAuth2::Profile::WebServer; my $id = 'my-id'; my $secret = 'my-secret'; my $base = 'http://my-site/a/b'; my $ct_urlenc = 'application/x-www-form-urlencoded'; my $ct_json = 'application/json'; use_ok('Net::OAuth2::Profile::WebServer'); my $auth = Net::OAuth2::Profile::WebServer->new ( client_id => $id , client_secret => $secret ); isa_ok($auth, 'Net::OAuth2::Profile::WebServer'); ### BUILD REQUEST my @params = (c => 1, d => 2); my $req1 = $auth->build_request(GET => $base, \@params); isa_ok($req1, 'HTTP::Request', 'created request GET @params'); like($req1->uri->as_string, qr!^http://my-site/a/b\?(?:c\=1\&d\=2|d\=2\&c\=1)!); my $req2 = $auth->build_request(GET => $base, {@params}); #params random order isa_ok($req2, 'HTTP::Request', 'created request GET %params'); my $uri2 = $req2->uri; my %p2 = $uri2->query_form; cmp_ok(scalar keys %p2, '==', 2); is($p2{c}, 1); is($p2{d}, 2); my $req3 = $auth->build_request(POST => $base, \@params); isa_ok($req3, 'HTTP::Request', 'created request POST @params'); is($req3->uri->as_string, 'http://my-site/a/b'); ok($req3->content eq 'c=1&d=2' || $req3->content eq 'd=2&c=1', 'content'); is($req3->content_type, $ct_urlenc, 'content-type'); ### DECODE RESPONSE my $resp1 = HTTP::Response->new ( 200, 'OK' , [ Content_Type => $ct_urlenc ] , 'e=3&f=4' ); my $r1 = join ';', $auth->params_from_response($resp1, 'test1'); is($r1, 'e;3;f;4', 'response 1, url-enc'); my $resp2 = HTTP::Response->new ( 200, 'OK' , [ Content_Type => $ct_json ] , '{ "g": 5, "h": 6 }' ); my %r2 = $auth->params_from_response($resp2, 'test2'); cmp_ok(scalar keys %r2, '==', 2, 'response 2, json'); is($r2{g}, 5); is($r2{h}, 6); Net-OAuth2-0.67/t/30refresh.t0000644000175000017500000000415713544612531015110 0ustar thomasthomas#!/usr/bin/env perl use strict; use warnings FATAL => "all"; use Test::More; use HTTP::Response; use JSON::MaybeXS; use Net::OAuth2; use Net::OAuth2::AccessToken; use Net::OAuth2::Profile::WebServer; my $json = JSON::MaybeXS->new; BEGIN { eval "require Test::Mock::LWP::Dispatch"; plan skip_all => "Test::Mock::LWP::Dispatch not installed" if $@; Test::Mock::LWP::Dispatch->import; plan tests => 7; } my $at_response = { token_type => 'Bearer', expires_in => time(), access_token => 'my-new-access-token', id_token => 'my-new-id-token', }; my %p = ( access_token_path => "/o/oauth2/token", authorize_path => "/o/oauth2/auth", client_id => "my-id", client_secret => "my-secret", refresh_token_path => "/o/oauth2/token", scope => "http://www.google.com/reader/api http://www.google.com/reader/atom", site => "https://accounts.google.com" ); $mock_ua->map( "$p{site}$p{refresh_token_path}" => sub { my $req = shift; # diag Dumper $req->content; HTTP::Response->new( 200, "OK", [ "content-type" => "application/json", ], $json->encode($at_response), ); } ); my $id = 'my-id'; my $secret = 'my-secret'; my $access_token_str = 'my-access_token'; my $refresh_token_str = 'my-refresh_token'; ok my $profile = Net::OAuth2::Profile::WebServer->new(%p) ,'instantiate Net::OAuth2::Profile::WebServer'; ok my $access_token = Net::OAuth2::AccessToken->new( refresh_token => $refresh_token_str, access_token => $access_token_str, profile => $profile) ,'instantiate Net::OAuth2::AccessToken with Webserver Profile'; ok $access_token->refresh, 'access_token->refresh'; is $access_token->access_token, $at_response->{access_token}, 'response access token has been set'; is $access_token->refresh_token, $refresh_token_str, 'refresh token remains unchanged'; $at_response->{refresh_token} = 'new-refresh-token'; ok $access_token->refresh, 'access_token->refresh'; is $access_token->refresh_token, $at_response->{refresh_token}, 'new response refresh token has been set'; Net-OAuth2-0.67/t/10web.t0000644000175000017500000000375313537627336014241 0ustar thomasthomas#!/usr/bin/env perl # Check usage of the ::WebServer use warnings; use strict; use lib 'lib', '../lib'; use Test::More tests => 19; my $id = 'my-id'; my $secret = 'my-secret'; my $site = 'http://my-site'; use_ok('Net::OAuth2::Profile::WebServer'); my $auth = Net::OAuth2::Profile::WebServer->new ( client_id => $id , client_secret => $secret , site => $site , access_token_url => "$site/a/ccess_token" , authorize_path => "au/htorize" , refresh_token_method => 'PUT' , access_token_params => [ tic => 'tac', toe => 0 ] , authorize_params => [ more => 'and more' ] ); isa_ok($auth, 'Net::OAuth2::Profile::WebServer'); is($auth->id, $id); is($auth->secret, $secret); is($auth->site, $site, 'check site_url()'); is($auth->site_url('/b/xyz', a => 1, b => 2), 'http://my-site/b/xyz?a=1&b=2'); my $uri = $auth->site_url('/b/xyz', {a => 1, b => 2}); # param order random my %qp = $uri->query_form; cmp_ok(scalar keys %qp, '==', 2, join(';',%qp)); cmp_ok($qp{a}, '==', 1); cmp_ok($qp{b}, '==', 2); is($auth->access_token_url, "$site/a/ccess_token"); TODO: { local $TODO = 'until error for rename of authorize_url is removed'; is(eval {$auth->authorize_url}, "$site/au/htorize"); } my $redirect = $auth->authorize(scope => 'read'); ok(defined $redirect, 'authorize'); isa_ok($redirect, 'URI'); my %qf = $redirect->query_form; is($qf{response_type}, 'code'); is($qf{scope}, 'read'); is($auth->refresh_token_method, 'PUT'); is($auth->refresh_token_url, "$site/oauth/refresh_token"); my $atp = $auth->access_token_params ( even => 'more' , params => 'here' , type => 'web_server' # may still be required for 37signals ); is_deeply($atp, { params => 'here', , even => 'more', , type => 'web_server', , code => '' , grant_type => 'authorization_code', , redirect_uri => undef, , client_secret => 'my-secret', , client_id => 'my-id', } ); my $ua = $auth->user_agent; isa_ok($ua, 'LWP::UserAgent');