Build.PL100664001750001750 45512755342515 14473 0ustar00ritouritou000000000000OAuth-Lite2-0.11# ========================================================================= # THIS FILE IS AUTOMATICALLY GENERATED BY MINILLA. # DO NOT EDIT DIRECTLY. # ========================================================================= use 5.008_001; use strict; use Module::Build::Tiny 0.035; Build_PL(); Changes100664001750001750 624312755342515 14513 0ustar00ritouritou000000000000OAuth-Lite2-0.11Revision history for Perl extension OAuth::Lite2. 0.11 2016-08-18T14:25:05Z - Force numeric context for 'expires_in'. - https://github.com/ritou/p5-oauth-lite2/pull/8 Thanks to GeJ 0.10 2014-07-31T09:30:02Z - add errors defined in RFC6749 0.09 2014-07-22T07:36:43Z - rename grant_type to external_service - rename params for grant_type=external_service 0.08 2014-06-03T07:54:41Z - add support for new grant types - "urn:ietf:params:oauth:grant-type:federated-assertion" : obtain access_token from external service assertion 0.07 2013-11-08T16:12:48Z - replace JSON to JSON::XS 0.06 2013-10-15T09:10:21Z - update POD by matthewfranglen - https://github.com/ritou/p5-oauth-lite2/pull/1 - https://github.com/ritou/p5-oauth-lite2/pull/2 - add support for two new grant types - "grouping_refresh_token" : obtain access_token from refresh_token of the same grouped client - "server_state" : for CSRF Protection of Authorization Code grant - fix some bugs and WARNINGs 0.05 2013-07-30T05:16:26Z - rebuild 0.04 2013-07-30T04:46:27Z - fixed some bugs and WARNINGs - migrated to Minilla - removed podchecker's WARNINGs - fixed uuv for parsing Basic Auth header - fixed tests for Perl 5.18.0 env - used authorization_basic method to generate basic authorization header - removed unused method 0.03 Sun Mar 03 00:57:00 2013 - bugfix by ritou - https://github.com/lyokato/p5-oauth-lite2/pull/8 - https://github.com/lyokato/p5-oauth-lite2/pull/7 0.02_03 Wed Jun 20 17:40:00 2012 - bugfix by ritou - https://github.com/lyokato/p5-oauth-lite2/pull/6 0.02_01 Sat Jun 15 09:20:00 2012 - updated to draft27 spec - https://github.com/lyokato/p5-oauth-lite2/pull/5 Thanks to ritou 0.01_14 Mon Nov 7 19:50:00 2011 - removed non-SSL warning 0.01_13 Wed Sep 14 15:43:00 2011 - fixed typo thanks to fukumura 0.01_12 Tue May 17 19:43:00 2011 - client credentials grant handler now works as expected when client_user_id == 0 0.01_10 Thu Mar 17 13:28:00 2011 - removed Context. Now, DataHandler has request object, and you pick it up by DataHandler::request. 0.01_09 Mon Feb 14 17:07:00 2011 - added client_secret value as parameter for get_client_user_id method 0.01_08 Mon Feb 14 17:07:00 2011 - support client_credentials profile 0.01_07 Tue Jan 04 10:40:00 2010 - added last_request/last_response on clients to access HTTP::Request/HTTP::Response internally used. https://github.com/lyokato/p5-oauth-lite2/issues#issue/4 0.01_06 Tue Nov 10 00:12:00 2010 - accepted pull request http://github.com/lyokato/p5-oauth-lite2/pull/3 0.01_05 Tue Oct 05 01:00:00 2010 - accepted pull request http://github.com/lyokato/p5-oauth-lite2/pull/1 0.01_04 Tue Sep 9 03:22:00 2010 - fixed exception: inefficient -> insufficient 0.01_03 Tue Aug 02 16:25:00 2010 - fixed model classes. changed setting for Params::Validatea 0.01_02 Tue Jul 27 09:27:00 2010 - fixed dependency setting in Makefile.PL 0.01_01 Wed Jul 22 12:31:00 2010 - initial release for draft-v10 LICENSE100664001750001750 4374012755342515 14250 0ustar00ritouritou000000000000OAuth-Lite2-0.11This software is copyright (c) 2013 by Lyo Kato, . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2013 by Lyo Kato, . This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2013 by Lyo Kato, . This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End META.json100664001750001750 2430712755342515 14662 0ustar00ritouritou000000000000OAuth-Lite2-0.11{ "abstract" : "OAuth 2.0 Library", "author" : [ "Ryo Ito, " ], "dynamic_config" : 0, "generated_by" : "Minilla/v3.0.0", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "OAuth-Lite2", "no_index" : { "directory" : [ "t", "xt", "inc", "share", "eg", "examples", "author", "builder" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "6.36", "Test::More" : "0" } }, "configure" : { "requires" : { "Module::Build::Tiny" : "0.035" } }, "develop" : { "requires" : { "Test::CPAN::Meta" : "0", "Test::MinimumVersion::Fast" : "0.04", "Test::PAUSE::Permissions" : "0.04", "Test::Pod" : "1.41", "Test::Spellunker" : "v0.2.7" } }, "runtime" : { "requires" : { "Class::Accessor::Fast" : "0.34", "Class::ErrorHandler" : "0.01", "Data::Dump" : "1.17", "Digest::SHA" : "5.48", "Hash::MultiValue" : "0.08", "IO::String" : "1.08", "JSON::XS" : "0", "LWP::UserAgent" : "0", "Params::Validate" : "0.95", "Plack" : "0.09942", "Scalar::Util" : "1.23", "String::Random" : "0.22", "Try::Tiny" : "0.06", "URI" : "1.54", "XML::LibXML" : "1.7" } } }, "provides" : { "OAuth::Lite2" : { "file" : "lib/OAuth/Lite2.pm", "version" : "0.11" }, "OAuth::Lite2::Agent" : { "file" : "lib/OAuth/Lite2/Agent.pm" }, "OAuth::Lite2::Agent::Dump" : { "file" : "lib/OAuth/Lite2/Agent/Dump.pm" }, "OAuth::Lite2::Agent::PSGIMock" : { "file" : "lib/OAuth/Lite2/Agent/PSGIMock.pm" }, "OAuth::Lite2::Agent::Strict" : { "file" : "lib/OAuth/Lite2/Agent/Strict.pm" }, "OAuth::Lite2::Client::ClientCredentials" : { "file" : "lib/OAuth/Lite2/Client/ClientCredentials.pm" }, "OAuth::Lite2::Client::Error" : { "file" : "lib/OAuth/Lite2/Client/Error.pm" }, "OAuth::Lite2::Client::Error::InsecureRequest" : { "file" : "lib/OAuth/Lite2/Client/Error.pm" }, "OAuth::Lite2::Client::Error::InsecureResponse" : { "file" : "lib/OAuth/Lite2/Client/Error.pm" }, "OAuth::Lite2::Client::Error::InvalidResponse" : { "file" : "lib/OAuth/Lite2/Client/Error.pm" }, "OAuth::Lite2::Client::ExternalService" : { "file" : "lib/OAuth/Lite2/Client/ExternalService.pm" }, "OAuth::Lite2::Client::ServerState" : { "file" : "lib/OAuth/Lite2/Client/ServerState.pm" }, "OAuth::Lite2::Client::StateResponseParser" : { "file" : "lib/OAuth/Lite2/Client/StateResponseParser.pm" }, "OAuth::Lite2::Client::Token" : { "file" : "lib/OAuth/Lite2/Client/Token.pm" }, "OAuth::Lite2::Client::TokenResponseParser" : { "file" : "lib/OAuth/Lite2/Client/TokenResponseParser.pm" }, "OAuth::Lite2::Client::UsernameAndPassword" : { "file" : "lib/OAuth/Lite2/Client/UsernameAndPassword.pm" }, "OAuth::Lite2::Client::WebServer" : { "file" : "lib/OAuth/Lite2/Client/WebServer.pm" }, "OAuth::Lite2::Formatter" : { "file" : "lib/OAuth/Lite2/Formatter.pm" }, "OAuth::Lite2::Formatter::FormURLEncoded" : { "file" : "lib/OAuth/Lite2/Formatter/FormURLEncoded.pm" }, "OAuth::Lite2::Formatter::JSON" : { "file" : "lib/OAuth/Lite2/Formatter/JSON.pm" }, "OAuth::Lite2::Formatter::Text" : { "file" : "lib/OAuth/Lite2/Formatter/Text.pm" }, "OAuth::Lite2::Formatter::XML" : { "file" : "lib/OAuth/Lite2/Formatter/XML.pm" }, "OAuth::Lite2::Formatters" : { "file" : "lib/OAuth/Lite2/Formatters.pm" }, "OAuth::Lite2::Model::AccessToken" : { "file" : "lib/OAuth/Lite2/Model/AccessToken.pm" }, "OAuth::Lite2::Model::AuthInfo" : { "file" : "lib/OAuth/Lite2/Model/AuthInfo.pm" }, "OAuth::Lite2::Model::ServerState" : { "file" : "lib/OAuth/Lite2/Model/ServerState.pm" }, "OAuth::Lite2::ParamMethod" : { "file" : "lib/OAuth/Lite2/ParamMethod.pm" }, "OAuth::Lite2::ParamMethod::AuthHeader" : { "file" : "lib/OAuth/Lite2/ParamMethod/AuthHeader.pm" }, "OAuth::Lite2::ParamMethod::FormEncodedBody" : { "file" : "lib/OAuth/Lite2/ParamMethod/FormEncodedBody.pm" }, "OAuth::Lite2::ParamMethod::URIQueryParameter" : { "file" : "lib/OAuth/Lite2/ParamMethod/URIQueryParameter.pm" }, "OAuth::Lite2::ParamMethods" : { "file" : "lib/OAuth/Lite2/ParamMethods.pm" }, "OAuth::Lite2::Server::Context" : { "file" : "lib/OAuth/Lite2/Server/Context.pm" }, "OAuth::Lite2::Server::DataHandler" : { "file" : "lib/OAuth/Lite2/Server/DataHandler.pm" }, "OAuth::Lite2::Server::Endpoint::Token" : { "file" : "lib/OAuth/Lite2/Server/Endpoint/Token.pm" }, "OAuth::Lite2::Server::Error" : { "file" : "lib/OAuth/Lite2/Server/Error.pm" }, "OAuth::Lite2::Server::Error::AccessDenied" : { "file" : "lib/OAuth/Lite2/Server/Error.pm" }, "OAuth::Lite2::Server::Error::ExpiredToken" : { "file" : "lib/OAuth/Lite2/Server/Error.pm" }, "OAuth::Lite2::Server::Error::ExpiredTokenLegacy" : { "file" : "lib/OAuth/Lite2/Server/Error.pm" }, "OAuth::Lite2::Server::Error::InsufficientScope" : { "file" : "lib/OAuth/Lite2/Server/Error.pm" }, "OAuth::Lite2::Server::Error::InvalidClient" : { "file" : "lib/OAuth/Lite2/Server/Error.pm" }, "OAuth::Lite2::Server::Error::InvalidGrant" : { "file" : "lib/OAuth/Lite2/Server/Error.pm" }, "OAuth::Lite2::Server::Error::InvalidRequest" : { "file" : "lib/OAuth/Lite2/Server/Error.pm" }, "OAuth::Lite2::Server::Error::InvalidScope" : { "file" : "lib/OAuth/Lite2/Server/Error.pm" }, "OAuth::Lite2::Server::Error::InvalidServerState" : { "file" : "lib/OAuth/Lite2/Server/Error.pm" }, "OAuth::Lite2::Server::Error::InvalidToken" : { "file" : "lib/OAuth/Lite2/Server/Error.pm" }, "OAuth::Lite2::Server::Error::RedirectURIMismatch" : { "file" : "lib/OAuth/Lite2/Server/Error.pm" }, "OAuth::Lite2::Server::Error::ServerError" : { "file" : "lib/OAuth/Lite2/Server/Error.pm" }, "OAuth::Lite2::Server::Error::TemporarilyUnavailable" : { "file" : "lib/OAuth/Lite2/Server/Error.pm" }, "OAuth::Lite2::Server::Error::UnauthorizedClient" : { "file" : "lib/OAuth/Lite2/Server/Error.pm" }, "OAuth::Lite2::Server::Error::UnsupportedGrantType" : { "file" : "lib/OAuth/Lite2/Server/Error.pm" }, "OAuth::Lite2::Server::Error::UnsupportedResourceType" : { "file" : "lib/OAuth/Lite2/Server/Error.pm" }, "OAuth::Lite2::Server::Error::UnsupportedResponseType" : { "file" : "lib/OAuth/Lite2/Server/Error.pm" }, "OAuth::Lite2::Server::GrantHandler" : { "file" : "lib/OAuth/Lite2/Server/GrantHandler.pm" }, "OAuth::Lite2::Server::GrantHandler::AuthorizationCode" : { "file" : "lib/OAuth/Lite2/Server/GrantHandler/AuthorizationCode.pm" }, "OAuth::Lite2::Server::GrantHandler::ClientCredentials" : { "file" : "lib/OAuth/Lite2/Server/GrantHandler/ClientCredentials.pm" }, "OAuth::Lite2::Server::GrantHandler::ExternalService" : { "file" : "lib/OAuth/Lite2/Server/GrantHandler/ExternalService.pm" }, "OAuth::Lite2::Server::GrantHandler::GroupingRefreshToken" : { "file" : "lib/OAuth/Lite2/Server/GrantHandler/GroupingRefreshToken.pm" }, "OAuth::Lite2::Server::GrantHandler::Password" : { "file" : "lib/OAuth/Lite2/Server/GrantHandler/Password.pm" }, "OAuth::Lite2::Server::GrantHandler::RefreshToken" : { "file" : "lib/OAuth/Lite2/Server/GrantHandler/RefreshToken.pm" }, "OAuth::Lite2::Server::GrantHandler::ServerState" : { "file" : "lib/OAuth/Lite2/Server/GrantHandler/ServerState.pm" }, "OAuth::Lite2::Server::GrantHandlers" : { "file" : "lib/OAuth/Lite2/Server/GrantHandlers.pm" }, "OAuth::Lite2::Signer" : { "file" : "lib/OAuth/Lite2/Signer.pm" }, "OAuth::Lite2::Signer::Algorithm" : { "file" : "lib/OAuth/Lite2/Signer/Algorithm.pm" }, "OAuth::Lite2::Signer::Algorithm::HMAC_SHA1" : { "file" : "lib/OAuth/Lite2/Signer/Algorithm/HMAC_SHA1.pm" }, "OAuth::Lite2::Signer::Algorithm::HMAC_SHA256" : { "file" : "lib/OAuth/Lite2/Signer/Algorithm/HMAC_SHA256.pm" }, "OAuth::Lite2::Signer::Algorithms" : { "file" : "lib/OAuth/Lite2/Signer/Algorithms.pm" }, "OAuth::Lite2::Util" : { "file" : "lib/OAuth/Lite2/Util.pm" }, "Plack::Middleware::Auth::OAuth2::ProtectedResource" : { "file" : "lib/Plack/Middleware/Auth/OAuth2/ProtectedResource.pm" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/ritou/p5-oauth-lite2/issues" }, "homepage" : "https://github.com/ritou/p5-oauth-lite2", "repository" : { "url" : "git://github.com/ritou/p5-oauth-lite2.git", "web" : "https://github.com/ritou/p5-oauth-lite2" } }, "version" : "0.11", "x_contributors" : [ "Kato Kazuyoshi ", "HIROSE Masaaki ", "Dann ", "lyokato ", "Matthew Franglen ", "Géraud CONTINSOUZAS " ], "x_serialization_backend" : "JSON::PP version 2.27203" } README.md100664001750001750 206412755342515 14474 0ustar00ritouritou000000000000OAuth-Lite2-0.11# NAME OAuth::Lite2 - OAuth 2.0 Library ## DESCRIPTION OAuth 2.0 Library The maintainer of this CPAN module was transferred to ritou by lyokato. Main repository is [https://github.com/ritou/p5-oauth-lite2](https://github.com/ritou/p5-oauth-lite2). ## SEE ALSO ### Client - [OAuth::Lite2::Client::WebServer](https://metacpan.org/pod/OAuth::Lite2::Client::WebServer) - [OAuth::Lite2::Client::UsernameAndPassword](https://metacpan.org/pod/OAuth::Lite2::Client::UsernameAndPassword) ### Server - [OAuth::Lite2::Server::Endpoint::Token](https://metacpan.org/pod/OAuth::Lite2::Server::Endpoint::Token) - [Plack::Middleware::Auth::OAuth2::ProtectedResource](https://metacpan.org/pod/Plack::Middleware::Auth::OAuth2::ProtectedResource) ## AUTHOR Ryo Ito, Lyo Kato, ## COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. cpanfile100664001750001750 110212755342515 14711 0ustar00ritouritou000000000000OAuth-Lite2-0.11requires 'Class::Accessor::Fast', '0.34'; requires 'Class::ErrorHandler', '0.01'; requires 'Data::Dump', '1.17'; requires 'Digest::SHA', '5.48'; requires 'Hash::MultiValue', '0.08'; requires 'IO::String', '1.08'; requires 'JSON::XS', '0'; requires 'LWP::UserAgent'; requires 'Params::Validate', '0.95'; requires 'Plack', '0.09942'; requires 'Scalar::Util', '1.23'; requires 'String::Random', '0.22'; requires 'Try::Tiny', '0.06'; requires 'URI', '1.54'; requires 'XML::LibXML', '1.7'; on build => sub { requires 'ExtUtils::MakeMaker', '6.36'; requires 'Test::More'; }; Lite2.pm100664001750001750 167612755342515 16330 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuthpackage OAuth::Lite2; use strict; use warnings; our $VERSION = '0.11'; 1; __END__ =head1 NAME OAuth::Lite2 - OAuth 2.0 Library =head2 DESCRIPTION OAuth 2.0 Library The maintainer of this CPAN module was transferred to ritou by lyokato. Main repository is L. =head2 SEE ALSO =head3 Client =over 4 =item L =item L =back =head3 Server =over 4 =item L =item L =back =head2 AUTHOR Ryo Ito, Eritou.06@gmail.comE Lyo Kato, Elyo.kato@gmail.comE =head2 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut Agent.pm100664001750001750 262012755342515 17354 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2package OAuth::Lite2::Agent; use strict; use warnings; use LWP::UserAgent; =head1 NAME OAuth::Lite2::Agent - Base class of preset-agents. =head1 SYNOPSIS my $agent = OAuth::Lite2::Client::Agent->new; my $res = $agent->request( $req ); =head1 DESCRIPTION Base class of preset-agents. =head1 METHODS =head2 new (%args) Constructor you can set 'agent' that has same 'request' interface method as LWP::UserAgent. If you omit that, a simple LWP::UserAgent object is set by default. my $agent = $class->new( agent => YourCustomAgent->new ); =cut sub new { my $class = shift; my $self = bless { @_ }, $class; unless ($self->{agent}) { $self->{agent} = LWP::UserAgent->new; $self->{agent}->agent( join "/", __PACKAGE__, $OAuth::Lite2::Client::VERSION ); } return $self; } =head2 request ($req) Returns L object. =cut sub request { my ($self, $req) = @_; return $self->{agent}->request($req); } 1; =head1 SEE ALSO L, L =head1 AUTHOR Lyo Kato, C =head1 COPYRIGHT AND LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut Dump.pm100664001750001750 207012755342515 20260 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Agentpackage OAuth::Lite2::Agent::Dump; use strict; use warnings; use parent 'OAuth::Lite2::Agent'; use Data::Dump qw(dump); =head1 NAME OAuth::Lite2::Agent::Dump - Preset User Agent class for debug =head1 SYNOPSIS my $client = OAuth::Lite2::Client::WebApp->new( ..., # other params agent => OAuth::Lite2::Client::Agent::Dump->new, ); =head1 DESCRIPTION This is useful for debug. =head1 METHODS =head2 request ($req) Append to the behavior of parent class, this method dumps the request and response object. =cut sub request { my ($self, $req) = @_; warn dump($req); my $res = $self->SUPER::request($req); warn dump($res); return $res; } 1; =head1 SEE ALSO L, L =head1 AUTHOR Lyo Kato, C =head1 COPYRIGHT AND LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut PSGIMock.pm100664001750001750 400412755342515 20726 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Agentpackage OAuth::Lite2::Agent::PSGIMock; use strict; use warnings; use Params::Validate qw(CODEREF); use HTTP::Response; use HTTP::Message::PSGI; use Try::Tiny qw/try catch/; =head1 NAME OAuth::Lite2::Agent::PSGIMock - Agent class for test which use PSGI App =head2 SYNOPSIS use Test::More; my $endpoint = OAuth::Lite2::Server::Endpoint::Token->new( data_handler => 'YourApp::DataHandler', ); my $agent = OAuth::Lite2::Agent::PSGIMock->new( app => $endpoint ); my $client = OAuth::Lite2::Client::UsernameAndPassword->new( client_id => q{foo}, client_secret => q{bar}, agent => $agent, ); my $res = $client->get_access_token( username => q{buz}, password => q{huga}, scope => q{email}, ); is($res->access_token, ...); is($res->refresh_token, ...); =head1 DESCRIPTION This class is useful for test to check if your PSGI based server application acts as expected. =head1 METHODS =head2 new (%args) parameters =over 4 =item app (PSGI application) =back =cut sub new { my $class = shift; my %args = Params::Validate::validate(@_, { app => 1, }); my $self = bless { app => $args{app}, }, $class; return $self; } =head2 request ($req) handle request with PSIG application you set at constructor =cut sub request { my ($self, $req) = @_; my $res = try { HTTP::Response->from_psgi($self->{app}->($req->to_psgi)); } catch { HTTP::Response->from_psgi([500, [ "Content-Type" => "text/plain" ], [ $_ ] ]); }; return $res; } 1; =head1 SEE ALSO L, L L =head1 AUTHOR Lyo Kato, C =head1 COPYRIGHT AND LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut Strict.pm100664001750001750 466312755342515 20635 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Agentpackage OAuth::Lite2::Agent::Strict; use strict; use warnings; use parent 'OAuth::Lite2::Agent'; use OAuth::Lite2::Client::Error; =head1 NAME OAuth::Lite2::Agent::Strict - Preset User Agent class for strict SSL =head1 SYNOPSIS my $client = OAuth::Lite2::Client::WebApp->new( ..., # other params agent => OAuth::Lite2::Client::Agent::Strict->new( https_version => $https_version, ..., # https parameters ), ); =head1 DESCRIPTION This module is one of preset user-agent class. This is useful when you want check the SSL strictly. =head1 METHODS =head2 request ($req) Append to the behavior of parent class, this method verify the SSL, and if it fails, it throws the exception. =cut sub request { my ($self, $req) = @_; OAuth::Lite2::Client::Error::InsecureRequest->throw( message => sprintf q{request url should start with https, but found "%s"}, $req->uri) unless $req->uri =~ /^https/; local $ENV{HTTPS_DEBUG} = $self->{https_debug} if $self->{https_debug}; local $ENV{HTTPS_CA_FILE} = $self->{https_ca_file} if $self->{https_ca_file}; local $ENV{HTTPS_CA_DIR} = $self->{https_ca_dir} if $self->{https_ca_dir}; local $ENV{HTTPS_CERT_FILE} = $self->{https_cert_file} if $self->{https_cert_file}; local $ENV{HTTPS_KEY_FILE} = $self->{https_key_file} if $self->{https_key_file}; local $ENV{HTTPS_VERSION} = $self->{https_version} if $self->{https_version}; local $ENV{HTTPS_PROXY} = $self->{https_proxy} if $self->{https_proxy}; local $ENV{HTTPS_PROXY_USERNAME} = $self->{https_proxy_username} if $self->{https_proxy_username}; local $ENV{HTTPS_PROXY_PASSWORD} = $self->{https_proxy_password} if $self->{https_proxy_password}; my $res = $self->SUPER::request($req); OAuth::Lite2::Client::Error::InsecureResponse->throw( message => "SSL Warning: Unauthorized access to blocked host" ) if $res->header('Client-SSL-Warning'); return $res; } 1; =head1 SEE ALSO L, L =head1 AUTHOR Lyo Kato, C =head1 COPYRIGHT AND LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut ClientCredentials.pm100664001750001750 2255412755342515 23160 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Clientpackage OAuth::Lite2::Client::ClientCredentials; use strict; use warnings; use base 'Class::ErrorHandler'; use bytes (); use Carp (); use Try::Tiny qw/try catch/; use LWP::UserAgent; use MIME::Base64 qw(encode_base64); use HTTP::Request; use HTTP::Headers; use Params::Validate qw(HASHREF); use OAuth::Lite2; use OAuth::Lite2::Util qw(build_content); use OAuth::Lite2::Client::TokenResponseParser; =head1 NAME OAuth::Lite2::Client::ClientCredentials - OAuth 2.0 ClientCredentials Profile Client =head1 SYNOPSIS my $client = OAuth::Lite2::Client::WebServer->new( id => q{my_client_id}, secret => q{my_client_secret}, access_token_uri => q{http://example.org/token}, ); sub get_access_token { my $your_app = shift; my $access_token = $client->get_access_token( scope => q{photo}, ) or return $your_app->error( $client->errstr ); $your_app->store->save( access_token => $access_token->access_token ); $your_app->store->save( expires_at => time() + $access_token->expires_in ); $your_app->store->save( refresh_token => $access_token->refresh_token ); } sub refresh_access_token { my $your_app = shift; my $access_token = $client->refresh_access_token( refresh_token => $refresh_token, ) or return $your_app->error( $client->errstr ); $your_app->store->save( access_token => $access_token->access_token ); $your_app->store->save( expires_at => time() + $access_token->expires_in ); $your_app->store->save( refresh_token => $access_token->refresh_token ); } sub access_to_protected_resource { my $your_app = shift; my $access_token = $your_app->store->get("access_token"); my $expires_at = $your_app->store->get("expires_at"); my $refresh_token = $your_app->store->get("refresh_token"); unless ($access_token) { $your_app->show_reauthorize_page(); return; } if ($expires_at < time()) { $your_app->refresh_access_token(); return; } my $req = HTTP::Request->new( GET => q{http://example.org/photo} ); $req->header( Authorization => sprintf(q{OAuth %s}, $access_token) ); my $agent = LWP::UserAgent->new; my $res = $agent->request($req); ... } =head1 DESCRIPTION OAuth 2.0 ClientCredentials Profile Client. =head2 new( %params ) =over 4 =item id Client ID =item secret Client secret =item access_token_uri token endpoint uri on auth-server. =item refresh_token_uri refresh-token endpoint uri on auth-server. if you omit this, access_token_uri is used instead. =item agent user agent. if you omit this, LWP::UserAgent's object is set by default. You can use your custom agent or preset-agents. See also L L L =back =cut sub new { my $class = shift; my %args = Params::Validate::validate(@_, { id => 1, secret => 1, # format => { optional => 1 }, access_token_uri => { optional => 1 }, refresh_token_uri => { optional => 1 }, agent => { optional => 1 }, }); my $self = bless { id => undef, secret => undef, access_token_uri => undef, refresh_token_uri => undef, last_request => undef, last_response => undef, %args, }, $class; unless ($self->{agent}) { $self->{agent} = LWP::UserAgent->new; $self->{agent}->agent( join "/", __PACKAGE__, $OAuth::Lite2::VERSION); } # $self->{format} ||= 'json'; $self->{response_parser} = OAuth::Lite2::Client::TokenResponseParser->new; return $self; } =head2 get_access_token( %params ) =over 4 =item scope =back =cut sub get_access_token { my $self = shift; my %args = Params::Validate::validate(@_, { scope => { optional => 1 }, uri => { optional => 1 }, use_basic_schema => { optional => 1 }, # secret_type => { optional => 1 }, # format => { optional => 1 }, }); unless (exists $args{uri}) { $args{uri} = $self->{access_token_uri} || Carp::croak "uri not found"; } # $args{format} ||= $self->{format}; my %params = ( grant_type => 'client_credentials', # format => $args{format}, ); unless ($args{use_basic_schema}){ $params{client_id} = $self->{id}; $params{client_secret} = $self->{secret}; } $params{scope} = $args{scope} if $args{scope}; # $params{secret_type} = $args{secret_type} # if $args{secret_type}; my $content = build_content(\%params); my $headers = HTTP::Headers->new; $headers->header("Content-Type" => q{application/x-www-form-urlencoded}); $headers->header("Content-Length" => bytes::length($content)); $headers->authorization_basic($self->{id}, $self->{secret}) if($args{use_basic_schema}); my $req = HTTP::Request->new( POST => $args{uri}, $headers, $content ); my $res = $self->{agent}->request($req); $self->{last_request} = $req; $self->{last_response} = $res; my ($token, $errmsg); try { $token = $self->{response_parser}->parse($res); } catch { $errmsg = "$_"; }; return $token || $self->error($errmsg); } =head2 refresh_access_token( %params ) =over 4 =item refresh_token =back =cut sub refresh_access_token { my $self = shift; my %args = Params::Validate::validate(@_, { refresh_token => 1, uri => { optional => 1 }, use_basic_schema => { optional => 1 }, # secret_type => { optional => 1 }, # format => { optional => 1 }, }); unless (exists $args{uri}) { $args{uri} = $self->{access_token_uri} || Carp::croak "uri not found"; } # $args{format} ||= $self->{format}; my %params = ( grant_type => 'refresh_token', refresh_token => $args{refresh_token}, # format => $args{format}, ); unless ($args{use_basic_schema}){ $params{client_id} = $self->{id}; $params{client_secret} = $self->{secret}; } # $params{secret_type} = $args{secret_type} # if $args{secret_type}; my $content = build_content(\%params); my $headers = HTTP::Headers->new; $headers->header("Content-Type" => q{application/x-www-form-urlencoded}); $headers->header("Content-Length" => bytes::length($content)); $headers->authorization_basic($self->{id}, $self->{secret}) if($args{use_basic_schema}); my $req = HTTP::Request->new( POST => $args{uri}, $headers, $content ); my $res = $self->{agent}->request($req); $self->{last_request} = $req; $self->{last_response} = $res; my ($token, $errmsg); try { $token = $self->{response_parser}->parse($res); } catch { $errmsg = "$_"; }; return $token || $self->error($errmsg); } =head2 get_grouping_refresh_token( %params ) =over 4 =item client_id =item client_secret =item refresh_token =item scope =back =cut sub get_grouping_refresh_token { my $self = shift; my %args = Params::Validate::validate(@_, { refresh_token => 1, scope => { optional => 1 }, uri => { optional => 1 }, use_basic_schema => { optional => 1 }, }); unless (exists $args{uri}) { $args{uri} = $self->{access_token_uri} || Carp::croak "uri not found"; } my %params = ( grant_type => 'grouping_refresh_token', refresh_token => $args{refresh_token}, ); $params{scope} = $args{scope} if $args{scope}; unless ($args{use_basic_schema}){ $params{client_id} = $self->{id}; $params{client_secret} = $self->{secret}; } my $content = build_content(\%params); my $headers = HTTP::Headers->new; $headers->header("Content-Type" => q{application/x-www-form-urlencoded}); $headers->header("Content-Length" => bytes::length($content)); $headers->authorization_basic($self->{id}, $self->{secret}) if($args{use_basic_schema}); my $req = HTTP::Request->new( POST => $args{uri}, $headers, $content ); my $res = $self->{agent}->request($req); $self->{last_request} = $req; $self->{last_response} = $res; my ($token, $errmsg); try { $token = $self->{response_parser}->parse($res); } catch { $errmsg = "$_"; }; return $token || $self->error($errmsg); } =head2 last_request Returns a HTTP::Request object that is used when you obtain or refresh access token last time internally. =head2 last_request Returns a HTTP::Response object that is used when you obtain or refresh access token last time internally. =cut sub last_request { $_[0]->{last_request} } sub last_response { $_[0]->{last_response} } =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; Error.pm100664001750001750 317512755342515 20633 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Clientpackage OAuth::Lite2::Client::Error; use strict; use warnings; use overload q{""} => sub { shift->message }, fallback => 1; sub default_message { "error" } sub new { my ($class, %args) = @_; bless { message => $args{message} || $class->default_message, }, $class; } sub throw { my ($class, %args) = @_; die $class->new(%args); } sub message { my $self = shift; return $self->{message}; } package OAuth::Lite2::Client::Error::InvalidResponse; our @ISA = qw(OAuth::Lite2::Client::Error); sub default_message { "invalid response" } package OAuth::Lite2::Client::Error::InsecureRequest; our @ISA = qw(OAuth::Lite2::Client::Error); sub default_message { "insecure request" } package OAuth::Lite2::Client::Error::InsecureResponse; our @ISA = qw(OAuth::Lite2::Client::Error); sub default_message { "insecure response" } package OAuth::Lite2::Client::Error; =head1 NAME OAuth::Lite2::Client::Error - OAuth 2.0 client error =head1 SYNOPSIS OAuth::Lite2::Client::Error::InvalidResponse->throw( message => q{invalid format}, ); =head1 DESCRIPTION OAuth 2.0 client error =head1 ERRORS =over 4 =item OAuth::Lite2::Client::Error::InvalidResponse =item OAuth::Lite2::Client::Error::InsecureRequest =item OAuth::Lite2::Client::Error::InsecureResponse =back =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; ExternalService.pm100664001750001750 1733612755342515 22671 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Clientpackage OAuth::Lite2::Client::ExternalService; use strict; use warnings; use base 'Class::ErrorHandler'; use bytes (); use Carp (); use Try::Tiny qw/try catch/; use LWP::UserAgent; use MIME::Base64 qw(encode_base64); use HTTP::Request; use HTTP::Headers; use Params::Validate qw(HASHREF); use OAuth::Lite2; use OAuth::Lite2::Util qw(build_content); use OAuth::Lite2::Client::TokenResponseParser; =head1 NAME OAuth::Lite2::Client::ExternalService - OAuth 2.0 Federated Assertion Profile Client =head1 SYNOPSIS my $client = OAuth::Lite2::Client::ExternalService->new( id => q{my_client_id}, secret => q{my_client_secret}, access_token_uri => q{http://example.org/token}, ); sub get_access_token { my $your_app = shift; my $access_token = $client->get_access_token( assertion => $your_app->request->param("assertion"), scope => q{photo}, ) or return $your_app->error( $client->errstr ); $your_app->store->save( access_token => $access_token->access_token ); $your_app->store->save( expires_at => time() + $access_token->expires_in ); $your_app->store->save( refresh_token => $access_token->refresh_token ); } sub refresh_access_token { my $your_app = shift; my $access_token = $client->refresh_access_token( refresh_token => $refresh_token, ) or return $your_app->error( $client->errstr ); $your_app->store->save( access_token => $access_token->access_token ); $your_app->store->save( expires_at => time() + $access_token->expires_in ); $your_app->store->save( refresh_token => $access_token->refresh_token ); } sub access_to_protected_resource { my $your_app = shift; my $access_token = $your_app->store->get("access_token"); my $expires_at = $your_app->store->get("expires_at"); my $refresh_token = $your_app->store->get("refresh_token"); unless ($access_token) { $your_app->show_reauthorize_page(); return; } if ($expires_at < time()) { $your_app->refresh_access_token(); return; } my $req = HTTP::Request->new( GET => q{http://example.org/photo} ); $req->header( Authorization => sprintf(q{OAuth %s}, $access_token) ); my $agent = LWP::UserAgent->new; my $res = $agent->request($req); ... } =head1 DESCRIPTION OAuth 2.0 Federated Assertion Profile Client. =head2 new( %params ) =over 4 =item id Client ID =item secret Client secret =item access_token_uri token endpoint uri on auth-server. =item refresh_token_uri refresh-token endpoint uri on auth-server. if you omit this, access_token_uri is used instead. =item agent user agent. if you omit this, LWP::UserAgent's object is set by default. You can use your custom agent or preset-agents. See also L L L =back =cut sub new { my $class = shift; my %args = Params::Validate::validate(@_, { id => 1, secret => 1, access_token_uri => { optional => 1 }, refresh_token_uri => { optional => 1 }, agent => { optional => 1 }, }); my $self = bless { id => undef, secret => undef, access_token_uri => undef, refresh_token_uri => undef, last_request => undef, last_response => undef, %args, }, $class; unless ($self->{agent}) { $self->{agent} = LWP::UserAgent->new; $self->{agent}->agent( join "/", __PACKAGE__, $OAuth::Lite2::VERSION); } # $self->{format} ||= 'json'; $self->{response_parser} = OAuth::Lite2::Client::TokenResponseParser->new; return $self; } =head2 get_access_token( %params ) =over 4 =item assertion =item type =item iss =item aud =item scope =back =cut sub get_access_token { my $self = shift; my %args = Params::Validate::validate(@_, { assertion => 1, type => { optional => 1 }, iss => { optional => 1 }, aud => { optional => 1 }, scope => { optional => 1 }, uri => { optional => 1 }, use_basic_schema => { optional => 1 }, }); unless (exists $args{uri}) { $args{uri} = $self->{access_token_uri} || Carp::croak "uri not found"; } my %params = ( grant_type => 'external_service', assertion => $args{assertion}, ); unless ($args{use_basic_schema}){ $params{client_id} = $self->{id}; $params{client_secret} = $self->{secret}; } # optional params $params{type} = $args{type} if $args{type}; $params{iss} = $args{iss} if $args{iss}; $params{aud} = $args{aud} if $args{aud}; $params{scope} = $args{scope} if $args{scope}; my $content = build_content(\%params); my $headers = HTTP::Headers->new; $headers->header("Content-Type" => q{application/x-www-form-urlencoded}); $headers->header("Content-Length" => bytes::length($content)); $headers->authorization_basic($self->{id}, $self->{secret}) if($args{use_basic_schema}); my $req = HTTP::Request->new( POST => $args{uri}, $headers, $content ); my $res = $self->{agent}->request($req); $self->{last_request} = $req; $self->{last_response} = $res; my ($token, $errmsg); try { $token = $self->{response_parser}->parse($res); } catch { $errmsg = "$_"; }; return $token || $self->error($errmsg); } =head2 refresh_access_token( %params ) =over 4 =item refresh_token =back =cut sub refresh_access_token { my $self = shift; my %args = Params::Validate::validate(@_, { refresh_token => 1, uri => { optional => 1 }, use_basic_schema => { optional => 1 }, }); unless (exists $args{uri}) { $args{uri} = $self->{access_token_uri} || Carp::croak "uri not found"; } my %params = ( grant_type => 'refresh_token', refresh_token => $args{refresh_token}, ); unless ($args{use_basic_schema}){ $params{client_id} = $self->{id}; $params{client_secret} = $self->{secret}; } my $content = build_content(\%params); my $headers = HTTP::Headers->new; $headers->header("Content-Type" => q{application/x-www-form-urlencoded}); $headers->header("Content-Length" => bytes::length($content)); $headers->authorization_basic($self->{id}, $self->{secret}) if($args{use_basic_schema}); my $req = HTTP::Request->new( POST => $args{uri}, $headers, $content ); my $res = $self->{agent}->request($req); $self->{last_request} = $req; $self->{last_response} = $res; my ($token, $errmsg); try { $token = $self->{response_parser}->parse($res); } catch { $errmsg = "$_"; }; return $token || $self->error($errmsg); } =head2 last_request Returns a HTTP::Request object that is used when you obtain or refresh access token last time internally. =head2 last_response Returns a HTTP::Response object that is used when you obtain or refresh access token last time internally. =cut sub last_request { $_[0]->{last_request} } sub last_response { $_[0]->{last_response} } =head1 AUTHOR Ryo Ito, Eritou.06@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2014 by Ryo Ito This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; ServerState.pm100664001750001750 160412755342515 22004 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Clientpackage OAuth::Lite2::Client::ServerState; use strict; use warnings; use base 'Class::Accessor::Fast'; __PACKAGE__->mk_accessors(qw( server_state expires_in )); =head1 NAME OAuth::Lite2::Client::ServerState - Class represents server-state response =head1 SYNOPSIS my $t = $client->get_server_state( ... ); $t->server_state; $t->expires_in; =head1 DESCRIPTION Class represents server-state response =head1 ACCESSORS =head2 server_state server_state string =head2 expires_in Seconds to expires =head1 AUTHOR Ryo Ito, Eritou.06@gmail.comE Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; StateResponseParser.pm100664001750001750 444112755342515 23513 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Clientpackage OAuth::Lite2::Client::StateResponseParser; use strict; use warnings; use Try::Tiny qw/try catch/; use OAuth::Lite2::Formatters; use OAuth::Lite2::Client::Error; use OAuth::Lite2::Client::ServerState; =head1 NAME OAuth::Lite2::Client::StateResponseParser - Server state response parser =head1 DESCRIPTION Server state response parser =cut sub new { bless {}, $_[0]; } sub parse { my ($self, $http_res) = @_; my $formatter = OAuth::Lite2::Formatters->get_formatter_by_type( $http_res->content_type); my $state; if ($http_res->is_success) { OAuth::Lite2::Client::Error::InvalidResponse->throw( message => sprintf(q{Invalid response content-type: %s}, $http_res->content_type||'') ) unless $formatter; my $result = try { return $formatter->parse($http_res->content); } catch { OAuth::Lite2::Client::Error::InvalidResponse->throw( message => sprintf(q{Invalid response format: %s}, $_), ); }; OAuth::Lite2::Client::Error::InvalidResponse->throw( message => sprintf("Response doesn't include 'server_state'") ) unless exists $result->{server_state}; OAuth::Lite2::Client::Error::InvalidResponse->throw( message => sprintf("Response doesn't include 'expires_in'") ) unless exists $result->{expires_in}; $state = OAuth::Lite2::Client::ServerState->new($result); } else { my $errmsg = $http_res->content || $http_res->status_line; if ($formatter && $http_res->content) { try { my $result = $formatter->parse($http_res->content); $errmsg = $result->{error} if exists $result->{error}; } catch { return }; } OAuth::Lite2::Client::Error::InvalidResponse->throw( message => $errmsg ); } return $state; } =head1 AUTHOR Ryo Ito, Eritou.06@gmail.comE Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; Token.pm100664001750001750 226412755342515 20620 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Clientpackage OAuth::Lite2::Client::Token; use strict; use warnings; use base 'Class::Accessor::Fast'; __PACKAGE__->mk_accessors(qw( access_token expires_in refresh_token access_token_secret scope )); =head1 NAME OAuth::Lite2::Client::Token - Class represents access-token response =head1 SYNOPSIS my $t = $client->get_access_token( ... ); $t->access_token; $t->expires_in; $t->refresh_token; $t->scope; =head1 DESCRIPTION Class represents access-token response =head1 ACCESSORS =head2 access_token The access token issued by the authorization serve =head2 expires_in The lifetime in seconds of the access token =head2 refresh_token The refresh token, which can be used to obtain new access tokens using the same authorization grant =head2 scope The scope of the access token =head2 access_token_secret DEPRECATED. =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; TokenResponseParser.pm100664001750001750 313712755342515 23514 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Clientpackage OAuth::Lite2::Client::TokenResponseParser; use strict; use warnings; use Try::Tiny qw/try catch/; use OAuth::Lite2::Formatters; use OAuth::Lite2::Client::Error; use OAuth::Lite2::Client::Token; sub new { bless {}, $_[0]; } sub parse { my ($self, $http_res) = @_; my $formatter = OAuth::Lite2::Formatters->get_formatter_by_type( $http_res->content_type); my $token; if ($http_res->is_success) { OAuth::Lite2::Client::Error::InvalidResponse->throw( message => sprintf(q{Invalid response content-type: %s}, $http_res->content_type||'') ) unless $formatter; my $result = try { return $formatter->parse($http_res->content); } catch { OAuth::Lite2::Client::Error::InvalidResponse->throw( message => sprintf(q{Invalid response format: %s}, $_), ); }; OAuth::Lite2::Client::Error::InvalidResponse->throw( message => sprintf("Response doesn't include 'access_token'") ) unless exists $result->{access_token}; $token = OAuth::Lite2::Client::Token->new($result); } else { my $errmsg = $http_res->content || $http_res->status_line; if ($formatter && $http_res->content) { try { my $result = $formatter->parse($http_res->content); $errmsg = $result->{error} if exists $result->{error}; } catch { return }; } OAuth::Lite2::Client::Error::InvalidResponse->throw( message => $errmsg ); } return $token; } 1; UsernameAndPassword.pm100664001750001750 2011312755342515 23476 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Clientpackage OAuth::Lite2::Client::UsernameAndPassword; use strict; use warnings; use base 'Class::ErrorHandler'; use bytes (); use Carp (); use Try::Tiny qw/try catch/; use LWP::UserAgent; use MIME::Base64 qw(encode_base64); use HTTP::Request; use HTTP::Headers; use Params::Validate qw(HASHREF); use OAuth::Lite2; use OAuth::Lite2::Util qw(build_content); use OAuth::Lite2::Client::TokenResponseParser; =head1 NAME OAuth::Lite2::Client::UsernameAndPassword - OAuth 2.0 Username And Password Profile Client =head1 SYNOPSIS my $client = OAuth::Lite2::Client::WebServer->new( id => q{my_client_id}, secret => q{my_client_secret}, access_token_uri => q{http://example.org/token}, ); sub get_access_token { my $your_app = shift; my $access_token = $client->get_access_token( username => $your_app->request->param("username"), password => $your_app->request->param("password"), scope => q{photo}, ) or return $your_app->error( $client->errstr ); $your_app->store->save( access_token => $access_token->access_token ); $your_app->store->save( expires_at => time() + $access_token->expires_in ); $your_app->store->save( refresh_token => $access_token->refresh_token ); } sub refresh_access_token { my $your_app = shift; my $access_token = $client->refresh_access_token( refresh_token => $refresh_token, ) or return $your_app->error( $client->errstr ); $your_app->store->save( access_token => $access_token->access_token ); $your_app->store->save( expires_at => time() + $access_token->expires_in ); $your_app->store->save( refresh_token => $access_token->refresh_token ); } sub access_to_protected_resource { my $your_app = shift; my $access_token = $your_app->store->get("access_token"); my $expires_at = $your_app->store->get("expires_at"); my $refresh_token = $your_app->store->get("refresh_token"); unless ($access_token) { $your_app->show_reauthorize_page(); return; } if ($expires_at < time()) { $your_app->refresh_access_token(); return; } my $req = HTTP::Request->new( GET => q{http://example.org/photo} ); $req->header( Authorization => sprintf(q{OAuth %s}, $access_token) ); my $agent = LWP::UserAgent->new; my $res = $agent->request($req); ... } =head1 DESCRIPTION OAuth 2.0 Username And Password Profile Client. =head2 new( %params ) =over 4 =item id Client ID =item secret Client secret =item access_token_uri token endpoint uri on auth-server. =item refresh_token_uri refresh-token endpoint uri on auth-server. if you omit this, access_token_uri is used instead. =item agent user agent. if you omit this, LWP::UserAgent's object is set by default. You can use your custom agent or preset-agents. See also L L L =back =cut sub new { my $class = shift; my %args = Params::Validate::validate(@_, { id => 1, secret => 1, # format => { optional => 1 }, access_token_uri => { optional => 1 }, refresh_token_uri => { optional => 1 }, agent => { optional => 1 }, }); my $self = bless { id => undef, secret => undef, access_token_uri => undef, refresh_token_uri => undef, last_request => undef, last_response => undef, %args, }, $class; unless ($self->{agent}) { $self->{agent} = LWP::UserAgent->new; $self->{agent}->agent( join "/", __PACKAGE__, $OAuth::Lite2::VERSION); } # $self->{format} ||= 'json'; $self->{response_parser} = OAuth::Lite2::Client::TokenResponseParser->new; return $self; } =head2 get_access_token( %params ) =over 4 =item username =item password =item scope =back =cut sub get_access_token { my $self = shift; my %args = Params::Validate::validate(@_, { username => 1, password => 1, scope => { optional => 1 }, uri => { optional => 1 }, use_basic_schema => { optional => 1 }, # secret_type => { optional => 1 }, # format => { optional => 1 }, }); unless (exists $args{uri}) { $args{uri} = $self->{access_token_uri} || Carp::croak "uri not found"; } # $args{format} ||= $self->{format}; my %params = ( grant_type => 'password', username => $args{username}, password => $args{password}, # format => $args{format}, ); unless ($args{use_basic_schema}){ $params{client_id} = $self->{id}; $params{client_secret} = $self->{secret}; } $params{scope} = $args{scope} if $args{scope}; # $params{secret_type} = $args{secret_type} # if $args{secret_type}; my $content = build_content(\%params); my $headers = HTTP::Headers->new; $headers->header("Content-Type" => q{application/x-www-form-urlencoded}); $headers->header("Content-Length" => bytes::length($content)); $headers->authorization_basic($self->{id}, $self->{secret}) if($args{use_basic_schema}); my $req = HTTP::Request->new( POST => $args{uri}, $headers, $content ); my $res = $self->{agent}->request($req); $self->{last_request} = $req; $self->{last_response} = $res; my ($token, $errmsg); try { $token = $self->{response_parser}->parse($res); } catch { $errmsg = "$_"; }; return $token || $self->error($errmsg); } =head2 refresh_access_token( %params ) =over 4 =item refresh_token =back =cut sub refresh_access_token { my $self = shift; my %args = Params::Validate::validate(@_, { refresh_token => 1, uri => { optional => 1 }, use_basic_schema => { optional => 1 }, # secret_type => { optional => 1 }, # format => { optional => 1 }, }); unless (exists $args{uri}) { $args{uri} = $self->{access_token_uri} || Carp::croak "uri not found"; } # $args{format} ||= $self->{format}; my %params = ( grant_type => 'refresh_token', refresh_token => $args{refresh_token}, # format => $args{format}, ); unless ($args{use_basic_schema}){ $params{client_id} = $self->{id}; $params{client_secret} = $self->{secret}; } # $params{secret_type} = $args{secret_type} # if $args{secret_type}; my $content = build_content(\%params); my $headers = HTTP::Headers->new; $headers->header("Content-Type" => q{application/x-www-form-urlencoded}); $headers->header("Content-Length" => bytes::length($content)); $headers->authorization_basic($self->{id}, $self->{secret}) if($args{use_basic_schema}); my $req = HTTP::Request->new( POST => $args{uri}, $headers, $content ); my $res = $self->{agent}->request($req); $self->{last_request} = $req; $self->{last_response} = $res; my ($token, $errmsg); try { $token = $self->{response_parser}->parse($res); } catch { $errmsg = "$_"; }; return $token || $self->error($errmsg); } =head2 last_request Returns a HTTP::Request object that is used when you obtain or refresh access token last time internally. =head2 last_request Returns a HTTP::Response object that is used when you obtain or refresh access token last time internally. =cut sub last_request { $_[0]->{last_request} } sub last_response { $_[0]->{last_response} } =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; WebServer.pm100664001750001750 2626612755342515 21474 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Clientpackage OAuth::Lite2::Client::WebServer; use strict; use warnings; use base 'Class::ErrorHandler'; use bytes (); use URI; use Carp (); use Try::Tiny qw/try catch/; use LWP::UserAgent; use MIME::Base64 qw(encode_base64); use HTTP::Request; use HTTP::Headers; use Params::Validate qw(HASHREF); use OAuth::Lite2; use OAuth::Lite2::Util qw(build_content); use OAuth::Lite2::Client::TokenResponseParser; use OAuth::Lite2::Client::StateResponseParser; =head1 NAME OAuth::Lite2::Client::WebServer - OAuth 2.0 Web Server Profile Client =head1 SYNOPSIS my $client = OAuth::Lite2::Client::WebServer->new( id => q{my_client_id}, secret => q{my_client_secret}, authorize_uri => q{http://example.org/authorize}, access_token_uri => q{http://example.org/token}, ); # redirect user to authorize page. sub start_authorize { my $your_app = shift; my $redirect_url = $client->uri_to_redirect( redirect_uri => q{http://yourapp/callback}, scope => q{photo}, state => q{optional_state}, ); $your_app->res->redirect( $redirect_url ); } # this method corresponds to the url 'http://yourapp/callback' sub callback { my $your_app = shift; my $code = $your_app->request->param("code"); my $access_token = $client->get_access_token( code => $code, redirect_uri => q{http://yourapp/callback}, ) or return $your_app->error( $client->errstr ); $your_app->store->save( access_token => $access_token->access_token ); $your_app->store->save( expires_at => time() + $access_token->expires_in ); $your_app->store->save( refresh_token => $access_token->refresh_token ); } sub refresh_access_token { my $your_app = shift; my $access_token = $client->refresh_access_token( refresh_token => $refresh_token, ) or return $your_app->error( $client->errstr ); $your_app->store->save( access_token => $access_token->access_token ); $your_app->store->save( expires_at => time() + $access_token->expires_in ); $your_app->store->save( refresh_token => $access_token->refresh_token ); } sub access_to_protected_resource { my $your_app = shift; my $access_token = $your_app->store->get("access_token"); my $expires_at = $your_app->store->get("expires_at"); my $refresh_token = $your_app->store->get("refresh_token"); unless ($access_token) { $your_app->start_authorize(); return; } if ($expires_at < time()) { $your_app->refresh_access_token(); return; } my $req = HTTP::Request->new( GET => q{http://example.org/photo} ); $req->header( Authorization => sprintf(q{OAuth %s}, $access_token) ); my $agent = LWP::UserAgent->new; my $res = $agent->request($req); ... } =head1 DESCRIPTION Client library for OAuth 2.0 Web Server Profile. =head1 METHODS =head2 new( %params ) =over 4 =item id Client ID =item secret Client secret =item authorize_uri authorization page uri on auth-server. =item access_token_uri token endpoint uri on auth-server. =item refresh_token_uri refresh-token endpoint uri on auth-server. if you omit this, access_token_uri is used instead. =item agent user agent. if you omit this, LWP::UserAgent's object is set by default. You can use your custom agent or preset-agents. See also L L L =back =cut sub new { my $class = shift; my %args = Params::Validate::validate(@_, { id => 1, secret => 1, # format => { optional => 1 }, authorize_uri => { optional => 1 }, access_token_uri => { optional => 1 }, refresh_token_uri => { optional => 1 }, agent => { optional => 1 }, }); my $self = bless { id => undef, secret => undef, authorize_uri => undef, access_token_uri => undef, refresh_token_uri => undef, last_request => undef, last_response => undef, %args, }, $class; unless ($self->{agent}) { $self->{agent} = LWP::UserAgent->new; $self->{agent}->agent( join "/", __PACKAGE__, $OAuth::Lite2::VERSION); } $self->{format} ||= 'json'; $self->{response_parser} = OAuth::Lite2::Client::TokenResponseParser->new; $self->{state_response_parser} = OAuth::Lite2::Client::StateResponseParser->new; return $self; } =head2 uri_to_redirect( %params ) =cut sub uri_to_redirect { my $self = shift; my %args = Params::Validate::validate(@_, { redirect_uri => 1, state => { optional => 1 }, scope => { optional => 1 }, immediate => { optional => 1 }, uri => { optional => 1 }, extra => { optional => 1, type => HASHREF }, }); my %params = ( response_type => 'code', client_id => $self->{id}, redirect_uri => $args{redirect_uri}, ); $params{state} = $args{state} if $args{state}; $params{scope} = $args{scope} if $args{scope}; $params{immediate} = $args{immediate} if $args{immediate}; if ($args{extra}) { for my $key ( keys %{$args{extra}} ) { $params{$key} = $args{extra}{$key}; } } my $uri = $args{uri} || $self->{authorize_uri} || Carp::croak "uri not found"; $uri = URI->new($uri); $uri->query_form(%params); return $uri->as_string; } =head2 get_access_token( %params ) execute verification, and returns L object. =over 4 =item code Authorization-code that is issued beforehand by server =item redirect_uri The URL that has used for user authorization's callback =back =cut sub get_access_token { my $self = shift; my %args = Params::Validate::validate(@_, { code => 1, redirect_uri => 1, server_state => { optional => 1 }, uri => { optional => 1 }, use_basic_schema => { optional => 1 }, # secret_type => { optional => 1 }, # format => { optional => 1 }, }); unless (exists $args{uri}) { $args{uri} = $self->{access_token_uri} || Carp::croak "uri not found"; } # $args{format} ||= $self->{format}; my %params = ( grant_type => 'authorization_code', code => $args{code}, redirect_uri => $args{redirect_uri}, # format => $args{format}, ); $params{server_state} = $args{server_state} if $args{server_state}; unless ($args{use_basic_schema}){ $params{client_id} = $self->{id}; $params{client_secret} = $self->{secret}; } # $params{secret_type} = $args{secret_type} # if $args{secret_type}; my $content = build_content(\%params); my $headers = HTTP::Headers->new; $headers->header("Content-Type" => q{application/x-www-form-urlencoded}); $headers->header("Content-Length" => bytes::length($content)); $headers->authorization_basic($self->{id}, $self->{secret}) if($args{use_basic_schema}); my $req = HTTP::Request->new( POST => $args{uri}, $headers, $content ); my $res = $self->{agent}->request($req); $self->{last_request} = $req; $self->{last_response} = $res; my ($token, $errmsg); try { $token = $self->{response_parser}->parse($res); } catch { $errmsg = "$_"; }; return $token || $self->error($errmsg); } =head2 refresh_access_token( %params ) Refresh access token by refresh_token, returns L object. =over 4 =item refresh_token =back =cut sub refresh_access_token { my $self = shift; my %args = Params::Validate::validate(@_, { refresh_token => 1, # secret_type => { optional => 1 }, # format => { optional => 1 }, uri => { optional => 1 }, use_basic_schema => { optional => 1 }, }); unless (exists $args{uri}) { $args{uri} = $self->{access_token_uri} || Carp::croak "uri not found"; } # $args{format} ||= $self->{format}; my %params = ( grant_type => 'refresh_token', refresh_token => $args{refresh_token}, # format => $args{format}, ); unless ($args{use_basic_schema}){ $params{client_id} = $self->{id}; $params{client_secret} = $self->{secret}; } # $params{secret_type} = $args{secret_type} # if $args{secret_type}; my $content = build_content(\%params); my $headers = HTTP::Headers->new; $headers->header("Content-Type" => q{application/x-www-form-urlencoded}); $headers->header("Content-Length" => bytes::length($content)); $headers->authorization_basic($self->{id}, $self->{secret}) if($args{use_basic_schema}); my $req = HTTP::Request->new( POST => $args{uri}, $headers, $content ); my $res = $self->{agent}->request($req); $self->{last_request} = $req; $self->{last_response} = $res; my ($token, $errmsg); try { $token = $self->{response_parser}->parse($res); } catch { $errmsg = "$_"; }; return $token || $self->error($errmsg); } =head2 get_server_state Obtain L object. =cut sub get_server_state { my $self = shift; my %args = Params::Validate::validate(@_, { uri => { optional => 1 }, }); unless (exists $args{uri}) { $args{uri} = $self->{access_token_uri} || Carp::croak "uri not found"; } my %params = ( grant_type => 'server_state', client_id => $self->{id}, ); my $content = build_content(\%params); my $headers = HTTP::Headers->new; $headers->header("Content-Type" => q{application/x-www-form-urlencoded}); $headers->header("Content-Length" => bytes::length($content)); my $req = HTTP::Request->new( POST => $args{uri}, $headers, $content ); my $res = $self->{agent}->request($req); $self->{last_request} = $req; $self->{last_response} = $res; my ($state, $errmsg); try { $state = $self->{state_response_parser}->parse($res); } catch { $errmsg = "$_"; }; return $state || $self->error($errmsg); } =head2 last_request Returns a HTTP::Request object that is used when you obtain or refresh access token last time internally. =head2 last_request Returns a HTTP::Response object that is used when you obtain or refresh access token last time internally. =cut sub last_request { $_[0]->{last_request} } sub last_response { $_[0]->{last_response} } =head1 AUTHOR Ryo Ito, Eritou.06@gmail.comE Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; Formatter.pm100664001750001750 266512755342515 20272 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2package OAuth::Lite2::Formatter; use strict; use warnings; sub new { bless {}, $_[0] } sub name { die "abstract method" } sub type { die "abstract method" } sub format { my ($self, $hash) = @_; die "abstract method"; } sub parse { my ($self, $content) = @_; die "abstract method"; } =head1 NAME OAuth::Lite2::Formatter - OAuth 2.0 formatter base class =head1 SYNOPSIS package OAuth::Lite2::Formatter::Foo; use parent 'OAuth::Lite2::Formatter'; ... my $formatter = OAuth::Lite2::Formatter::Foo->new; my $obj = $formatter->parse( $string ); $string = $formatter->format( $obj ); =head1 DESCRIPTION OAuth 2.0 formatter base class =head1 METHODS =head2 name Accessor for name of this format. =head2 type Accessor for content-type of this format. =head2 format( $object ) my $formatted_string = $formatter->format( $obj ); =head2 parse( $formatted_string ) my $obj = $formatter->parse( $formatted_string ); =head1 SEE ALSO L L L L =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; FormURLEncoded.pm100664001750001750 305212755342515 23031 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Formatterpackage OAuth::Lite2::Formatter::FormURLEncoded; use strict; use warnings; use parent 'OAuth::Lite2::Formatter'; use OAuth::Lite2::Util qw( build_content parse_content); sub name { "form" } sub type { "application/x-www-form-urlencoded" } sub format { my ($self, $hash) = @_; return build_content($hash); } sub parse { my ($self, $content) = @_; return parse_content($content)->as_hashref_mixed; } =head1 NAME OAuth::Lite2::Formatter::FormURLEncoded - OAuth 2.0 form-urlencoded formatters store =head1 SYNOPSIS my $formatter = OAuth::Lite2::Formatter::FormURLEncoded->new; my $obj = $formatter->parse( $string ); $string = $formatter->format( $obj ); =head1 DESCRIPTION DEPRECATED. OAuth 2.0 form-urlencoded formatter =head1 METHODS =head2 name Accessor for name of this format, "form". =head2 type Accessor for content-type of this format, "application/x-www-form-urlencoded". =head2 format( $object ) my $formatted_string = $formatter->format( $obj ); =head2 parse( $formatted_string ) my $obj = $formatter->parse( $formatted_string ); =head1 SEE ALSO L L L L =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; JSON.pm100664001750001750 263312755342515 21036 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Formatterpackage OAuth::Lite2::Formatter::JSON; use strict; use warnings; use parent 'OAuth::Lite2::Formatter'; use JSON::XS; use Try::Tiny; sub name { "json" } sub type { "application/json" }; sub format { my ($self, $hash) = @_; return JSON::XS->new->encode($hash); } sub parse { my ($self, $json) = @_; return JSON::XS->new->decode($json); } =head1 NAME OAuth::Lite2::Formatter::JSON - OAuth 2.0 JSON formatters store =head1 SYNOPSIS my $formatter = OAuth::Lite2::Formatter::JSON->new; my $obj = $formatter->parse( $string ); $string = $formatter->format( $obj ); =head1 DESCRIPTION OAuth 2.0 JSON formatter =head1 METHODS =head2 name Accessor for name of this format, "json". =head2 type Accessor for content-type of this format, "application/json". =head2 format( $json_object ) my $json_string = $formatter->format( $obj ); =head2 parse( $json_string ) my $obj = $formatter->parse( $json_string ); =head1 SEE ALSO L L L L =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; Text.pm100664001750001750 300212755342515 21200 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Formatterpackage OAuth::Lite2::Formatter::Text; use strict; use warnings; use parent 'OAuth::Lite2::Formatter'; use OAuth::Lite2::Util qw( build_content parse_content); sub name { "text" } sub type { "text/plain" } sub format { my ($self, $hash) = @_; return build_content($hash); } sub parse { my ($self, $content) = @_; return parse_content($content)->as_hashref_mixed; } =head1 NAME OAuth::Lite2::Formatter::Text - OAuth 2.0 text/plain formatters store =head1 SYNOPSIS my $formatter = OAuth::Lite2::Formatter::Text->new; my $obj = $formatter->parse( $string ); $string = $formatter->format( $obj ); =head1 DESCRIPTION DEPRECATED. OAuth 2.0 text/plain formatter =head1 METHODS =head2 name Accessor for name of this format, "text". =head2 type Accessor for content-type of this format, "text/plain". =head2 format( $object ) my $formatted_string = $formatter->format( $obj ); =head2 parse( $formatted_string ) my $obj = $formatter->parse( $formatted_string ); =head1 SEE ALSO L L L L L =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; XML.pm100664001750001750 414312755342515 20723 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Formatterpackage OAuth::Lite2::Formatter::XML; use strict; use warnings; use parent 'OAuth::Lite2::Formatter'; use Try::Tiny; use XML::LibXML; use Carp (); sub name { "xml" } sub type { "application/xml" } sub format { my ($self, $hash) = @_; my $xml = ''; $xml .= ''; for my $key ( keys %$hash ) { $xml .= sprintf(q{<%s>%s}, $key, $hash->{$key}, $key); } $xml .= ''; return $xml; } sub parse { my ($self, $xml) = @_; my $parser = XML::LibXML->new; my $doc = $parser->parse_string($xml); my $root = $doc->documentElement(); Carp::croak " Element not found: " . $xml unless $root->nodeName eq 'OAuth'; my $hash = {}; my @children = $root->childNodes(); for my $child ( @children ) { next unless $child->nodeType == 1; my $key = $child->nodeName(); next unless $key; my $value = $child->textContent() || ''; $hash->{$key} = $value; } return $hash; } =head1 NAME OAuth::Lite2::Formatter::XML - OAuth 2.0 XML formatters store =head1 SYNOPSIS my $formatter = OAuth::Lite2::Formatter::XML->new; my $obj = $formatter->parse( $string ); $string = $formatter->format( $obj ); =head1 DESCRIPTION DEPRECATED. OAuth 2.0 XML formatter. =head1 METHODS =head2 name Accessor for name of this format, "xml". =head2 type Accessor for content-type of this format, "application/xml". =head2 format( $object ) my $xml_string = $formatter->format( $obj ); =head2 parse( $xml_string ) my $obj = $formatter->parse( $xml_string ); =head1 SEE ALSO L L L L =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; Formatters.pm100664001750001750 425712755342515 20454 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2package OAuth::Lite2::Formatters; use strict; use warnings; use OAuth::Lite2::Formatter::JSON; use OAuth::Lite2::Formatter::XML; use OAuth::Lite2::Formatter::FormURLEncoded; use OAuth::Lite2::Formatter::Text; my %FORMATTERS_BY_TYPE; my %FORMATTERS_BY_NAME; sub add_formatter { my ($class, $formatter) = @_; $FORMATTERS_BY_NAME{$formatter->name} = $formatter; $FORMATTERS_BY_TYPE{$formatter->type} = $formatter; } __PACKAGE__->add_formatter( OAuth::Lite2::Formatter::JSON->new ); __PACKAGE__->add_formatter( OAuth::Lite2::Formatter::XML->new ); __PACKAGE__->add_formatter( OAuth::Lite2::Formatter::FormURLEncoded->new ); __PACKAGE__->add_formatter( OAuth::Lite2::Formatter::Text->new ); sub get_formatter_by_name { my ($class, $name) = @_; return unless $name; return $FORMATTERS_BY_NAME{$name}; } sub get_formatter_by_type { my ($class, $type) = @_; return unless $type; # If content-type includes subtype, top-level media type is only used. if ($type =~ /;/){ $type = $`; } return $FORMATTERS_BY_TYPE{$type}; } =head1 NAME OAuth::Lite2::Formatters - OAuth 2.0 formatters store =head1 SYNOPSIS my $formatter = OAuth::Lite2::Formatter->get_formatter_by_name("json"); my $formatter = OAuth::Lite2::Formatter->get_formatter_by_type("application/json"); my $obj = $formatter->parse( $string ); $string = $formatter->format( $obj ); =head1 DESCRIPTION OAuth 2.0 formatters store. from draft-v8, specification requires only JSON format. This library leaves the other formatters for interop. =head1 METHODS =head2 get_formatter_by_name( $name ) return formatter by name =head2 get_formatter_by_type( $content_type ) return formatter by content type =head1 SEE ALSO L L L L =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; AccessToken.pm100664001750001750 270612755342515 21565 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Modelpackage OAuth::Lite2::Model::AccessToken; use strict; use warnings; use base 'Class::Accessor::Fast'; __PACKAGE__->mk_accessors(qw( auth_id token expires_in secret secret_type created_on )); use Params::Validate; sub new { my $class = shift; my @args = @_ == 1 ? %{$_[0]} : @_; my %params = Params::Validate::validate_with( params => \@args, spec => { auth_id => 1, token => 1, expires_in => { optional => 1 }, created_on => { optional => 1 }, secret => { optional => 1 }, secret_type => { optional => 1 }, }, allow_extra => 1, ); my $self = bless \%params, $class; return $self; } =head1 NAME OAuth::Lite2::Model::AccessToken - model class that represents access token =head1 ACCESSORS =head2 auth_id Identifier of L. =head2 token Access token string. =head2 expires_in Seconds to expires from 'created_on' =head2 created_on UNIX time when access token created. =head2 secret DEPRECATED. =head2 secret_type DEPRECATED. =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; AuthInfo.pm100664001750001750 343412755342515 21077 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Modelpackage OAuth::Lite2::Model::AuthInfo; use strict; use warnings; use base 'Class::Accessor::Fast'; __PACKAGE__->mk_accessors(qw( id user_id client_id scope refresh_token code redirect_uri server_state )); use Params::Validate; sub new { my $class = shift; my @args = @_ == 1 ? %{$_[0]} : @_; my %params = Params::Validate::validate_with( params => \@args, spec => { id => 1, user_id => 1, client_id => 1, scope => { optional => 1 }, refresh_token => { optional => 1 }, code => { optional => 1 }, redirect_uri => { optional => 1 }, server_state => { optional => 1 }, }, allow_extra => 1, ); my $self = bless \%params, $class; return $self; } =head1 NAME OAuth::Lite2::Model::AuthInfo - model class that represents authorization info. =head1 ACCESSORS =head2 id Identifier of this authorization info. =head2 user_id User identifier for resource owner =head2 client_id CLient identifier for obtain token =head2 scope Scope string for authorization info =head2 refresh_token Refresh token related with authorization info =head2 code Authorization code related with authorization info =head2 redirect_uri Redirect URI related with authorization info =head2 server_state Server State for CSRF Protection =head1 AUTHOR Ryo Ito, Eritou.06@gmail.comE Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; ServerState.pm100664001750001750 243712755342515 21633 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Modelpackage OAuth::Lite2::Model::ServerState; use strict; use warnings; use base 'Class::Accessor::Fast'; __PACKAGE__->mk_accessors(qw( client_id server_state expires_in created_on )); use Params::Validate; sub new { my $class = shift; my @args = @_ == 1 ? %{$_[0]} : @_; my %params = Params::Validate::validate_with( params => \@args, spec => { client_id => 1, server_state => 1, expires_in => 1, created_on => { optional => 1 }, }, allow_extra => 1, ); my $self = bless \%params, $class; return $self; } =head1 NAME OAuth::Lite2::Model::ServerState - model class that represents Server State =head1 ACCESSORS =head2 client_id Client Identifier =head2 server_state Server State string. =head2 expires_in Seconds to expires from 'created_on' =head2 created_on UNIX time when Server State created. =head1 AUTHOR Ryo Ito, Eritou.06@gmail.comE Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; ParamMethod.pm100664001750001750 375112755342515 20525 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2package OAuth::Lite2::ParamMethod; use strict; use warnings; sub new { bless {}, $_[0]; } sub match { my ($self, $req) = @_; die "abstract method"; } sub parse { my ($self, $req) = @_; die "abstract method"; } sub build_request { my ($self, %params) = @_; die "abstract method"; } =head1 NAME OAuth::Lite2::ParamMethod - base class of builder/parser for OAuth 2.0 parameters =head1 SYNOPSIS my $meth = OAuth::Lite2::ParamMethod::Foo->new; # server side if ($meth->match( $plack_request )) { my ($token, $params) = $meth->parse( $plack_request ); } # client side my $http_req = $meth->request_builder(...); =head1 DESCRIPTION base class of builder/parser for OAuth 2.0 parameters =head1 METHODS =head2 new Constructor =head2 match( $plack_request ) Returns true if passed L object is matched for the type of this method. if ( $meth->match( $plack_request ) ) { ... } =head2 parse( $plack_request ) Parse the L, and returns access token and oauth parameters. my ($token, $params) = $meth->parse( $plack_request ); =head2 build_request( %params ) Build L object. my $req = $meth->build_request( url => $url, method => $http_method, token => $access_token, oauth_params => $oauth_params, params => $params, content => $content, headers => $headers, ); =head1 SEE ALSO L L L L =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; AuthHeader.pm100664001750001750 1400112755342515 22545 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/ParamMethodpackage OAuth::Lite2::ParamMethod::AuthHeader; use strict; use warnings; use bytes (); use parent 'OAuth::Lite2::ParamMethod'; use URI; use MIME::Base64 qw(decode_base64); use Hash::MultiValue; use HTTP::Request; use HTTP::Headers; use Params::Validate; use OAuth::Lite2::Util qw(encode_param decode_param build_content); =head1 NAME OAuth::Lite2::ParamMethod::AuthHeader - builder/parser for OAuth 2.0 AuthHeader type of parameter =head1 SYNOPSIS my $meth = OAuth::Lite2::ParamMethod::AuthHeader->new; # server side if ($meth->match( $plack_request )) { my ($token, $params) = $meth->parse( $plack_request ); } # client side my $http_req = $meth->request_builder(...); =head1 DESCRIPTION builder/parser for OAuth 2.0 AuthHeader type of parameter =head1 METHODS =head2 new Constructor =head2 match( $plack_request ) Returns true if passed L object is matched for the type of this method. if ( $meth->match( $plack_request ) ) { ... } =cut sub match { my ($self, $req) = @_; my $header = $req->header("Authorization"); return ($header && $header =~ /^\s*(OAuth|Bearer)(.*)$/); } =head2 parse( $plack_request ) Parse the L, and returns access token and oauth parameters. my ($token, $params) = $meth->parse( $plack_request ); =cut sub parse { my ($self, $req) = @_; my $header = $req->header("Authorization"); my $token; if ($header =~ s/^\s*(OAuth|Bearer)\s+([^\s\,]*)//){ $token = $2; } my $params = Hash::MultiValue->new; $header =~ s/^\s*(OAuth|Bearer)\s*([^\s\,]*)//; if ($header) { $header =~ s/^\s*\,\s*//; for my $attr (split /,\s*/, $header) { my ($key, $val) = split /=/, $attr, 2; $val =~ s/^"//; $val =~ s/"$//; $params->add($key, decode_param($val)); } } return ($token, $params); } =head2 build_request( %params ) Build L object. my $req = $meth->build_request( url => $url, method => $http_method, token => $access_token, oauth_params => $oauth_params, params => $params, content => $content, headers => $headers, ); =cut sub build_request { my $self = shift; my %args = Params::Validate::validate(@_, { url => 1, method => 1, token => 1, oauth_params => 1, params => { optional => 1 }, content => { optional => 1 }, headers => { optional => 1 }, }); my $oauth_params = $args{oauth_params} || {}; my @pairs = sort map { sprintf q{%s="%s"}, encode_param($_), encode_param($oauth_params->{$_}) } keys %$oauth_params; my $params = $args{params} || {}; my $method = uc $args{method}; my $headers = $args{headers}; if (defined $headers) { if (ref($headers) eq 'ARRAY') { $headers = HTTP::Headers->new(@$headers); } else { $headers = $headers->clone; } } else { $headers = HTTP::Headers->new; } my $auth_header = sprintf(q{Bearer %s}, $args{token}); $auth_header .= ", " . join(", ", @pairs) if @pairs > 0; $headers->header(Authorization => $auth_header); if ($method eq 'GET' || $method eq 'DELETE') { my $url = URI->new($args{url}); $url->query_form(%$params); my $req = HTTP::Request->new($method, $url->as_string, $headers); return $req; } else { unless ($headers->header("Content-Type")) { $headers->header("Content-Type", "application/x-www-form-urlencoded"); } my $content_type = $headers->header("Content-Type"); my $content = ($content_type eq "application/x-www-form-urlencoded") ? build_content($params) : $args{content} || build_content($params); $headers->header("Content-Length", bytes::length($content)); my $req = HTTP::Request->new($method, $args{url}, $headers, $content); return $req; } } =head2 is_legacy( $plack_request ) Returns true if passed L object is based draft version 10. if ( $meth->is_legacy( $plack_request ) ) { ... } =cut sub is_legacy { my ($self, $req) = @_; my $header = $req->header("Authorization"); return ($header && $header =~ /^\s*OAuth(.*)$/); } =head2 basic_clientcredentials( $plack_request ) Returns Hash reference if passed L object has client credentials in Authorization header. my $basic_clientcredentials = $meth->basic_credentials( $plack_request ); if( defined($basic_clientcredentials) ){ my $client_id = $basic_clientcredentials->{client_id}; my $client_secret = $basic_clientcredentials->{client_secret}; } =cut sub basic_credentials{ my ($self, $req) = @_; my %credentials = ( client_id => '', client_secret => '' ); my $header = $req->header("Authorization"); return \%credentials unless (defined($header)); my $decoded; if ( $header =~ /\A\s*(Basic)\s([^\s\,]*)/ ){ $decoded = decode_base64($2); return \%credentials unless (index($decoded,':') > 0); my @split_credentials = split(/:/, $decoded); return \%credentials unless (scalar(@split_credentials) == 2); %credentials = ( client_id => $split_credentials[0], client_secret => $split_credentials[1] ); } return \%credentials; }; =head1 SEE ALSO L L L L =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; FormEncodedBody.pm100664001750001750 1114212755342515 23541 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/ParamMethodpackage OAuth::Lite2::ParamMethod::FormEncodedBody; use strict; use warnings; use parent 'OAuth::Lite2::ParamMethod'; use HTTP::Request; use HTTP::Headers; use Carp (); use bytes (); use Params::Validate; use OAuth::Lite2::Util qw(build_content); =head1 NAME OAuth::Lite2::ParamMethod::FormEncodedBody - builder/parser for OAuth 2.0 FormEncodedBody type of parameter =head1 SYNOPSIS my $meth = OAuth::Lite2::ParamMethod::FormEncodedBody->new; # server side if ($meth->match( $plack_request )) { my ($token, $params) = $meth->parse( $plack_request ); } # client side my $http_req = $meth->request_builder(...); =head1 DESCRIPTION builder/parser for OAuth 2.0 FormEncodedBody type of parameter =head1 METHODS =head2 new Constructor =head2 match( $plack_request ) Returns true if passed L object is matched for the type of this method. if ( $meth->match( $plack_request ) ) { ... } =cut sub match { my ($self, $req) = @_; my $method = lc $req->method; return (($method eq 'post' || $method eq 'put' || $method eq 'delete') && $req->content_type eq 'application/x-www-form-urlencoded' && ($req->body_parameters->{oauth_token} || $req->body_parameters->{access_token})); } =head2 parse( $plack_request ) Parse the L, and returns access token and oauth parameters. my ($token, $params) = $meth->parse( $plack_request ); =cut sub parse { my ($self, $req) = @_; my $params = $req->body_parameters; my $token = $params->{access_token}; $params->remove('access_token'); if($params->{oauth_token}){ $token = $params->{oauth_token}; $params->remove('oauth_token'); } return ($token, $params); } =head2 build_request( %params ) Build L object. my $req = $meth->build_request( url => $url, method => $http_method, token => $access_token, oauth_params => $oauth_params, params => $params, content => $content, headers => $headers, ); =cut sub build_request { my $self = shift; my %args = Params::Validate::validate(@_, { url => 1, method => 1, token => 1, oauth_params => 1, params => { optional => 1 }, content => { optional => 1 }, headers => { optional => 1 }, }); my $method = uc $args{method}; if ($method eq 'GET' || $method eq 'DELETE') { Carp::croak qq{When you request with GET or DELETE method, } .qq{You can't use FormEncodedBody type OAuth parameters.} } else { my $oauth_params = $args{oauth_params} || {}; $oauth_params->{access_token} = $args{token}; my $headers = $args{headers}; if (defined $headers) { if (ref($headers) eq 'ARRAY') { $headers = HTTP::Headers->new(@$headers); } else { $headers = $headers->clone; } } else { $headers = HTTP::Headers->new; } unless ($headers->header("Content-Type")) { $headers->header("Content-Type", "application/x-www-form-urlencoded"); } my $content_type = $headers->header("Content-Type"); my $params = $args{params} || {}; if ($content_type ne "application/x-www-form-urlencoded") { Carp::croak qq{When you use FormEncodedBody-type OAuth parameters,} .qq{Content-Type header must be application/x-www-form-urlencoded.} } my $content = build_content({%$params, %$oauth_params}); $headers->header("Content-Length", bytes::length($content)); my $req = HTTP::Request->new($method, $args{url}, $headers, $content); return $req; } } =head2 is_legacy( $plack_request ) Returns true if passed L object is based draft version 10. if ( $meth->is_legacy( $plack_request ) ) { ... } =cut sub is_legacy { my ($self, $req) = @_; return (exists $req->body_parameters->{oauth_token}); } =head1 SEE ALSO L L L L =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; URIQueryParameter.pm100664001750001750 1057412755342515 24074 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/ParamMethodpackage OAuth::Lite2::ParamMethod::URIQueryParameter; use strict; use warnings; use parent 'OAuth::Lite2::ParamMethod'; use HTTP::Request; use HTTP::Headers; use bytes (); use Params::Validate; use OAuth::Lite2::Util qw(build_content); =head1 NAME OAuth::Lite2::ParamMethod::URIQueryParameter - builder/parser for OAuth 2.0 uri-query type of parameter =head1 SYNOPSIS my $meth = OAuth::Lite2::ParamMethod::URIQueryParameter->new; # server side if ($meth->match( $plack_request )) { my ($token, $params) = $meth->parse( $plack_request ); } # client side my $http_req = $meth->request_builder(...); =head1 DESCRIPTION builder/parser for OAuth 2.0 uri-query type of parameter =head1 METHODS =head2 new Constructor =head2 match( $plack_request ) Returns true if passed L object is matched for the type of this method. if ( $meth->match( $plack_request ) ) { ... } =cut sub match { my ($self, $req) = @_; return (exists $req->query_parameters->{oauth_token} || exists $req->query_parameters->{access_token}); } =head2 parse( $plack_request ) Parse the L, and returns access token and oauth parameters. my ($token, $params) = $meth->parse( $plack_request ); =cut sub parse { my ($self, $req) = @_; my $params = $req->query_parameters; my $token = $params->{access_token}; $params->remove('access_token'); if($params->{oauth_token}){ $token = $params->{oauth_token}; $params->remove('oauth_token'); } return ($token, $params); } =head2 build_request( %params ) Build L object. my $req = $meth->build_request( url => $url, method => $http_method, token => $access_token, oauth_params => $oauth_params, params => $params, content => $content, headers => $headers, ); =cut sub build_request { my $self = shift; my %args = Params::Validate::validate(@_, { url => 1, method => 1, token => 1, oauth_params => 1, params => { optional => 1 }, content => { optional => 1 }, headers => { optional => 1 }, }); my $oauth_params = $args{oauth_params} || {}; $oauth_params->{access_token} = $args{token}; my $params = $args{params} || {}; my $method = uc $args{method}; my $headers = $args{headers}; if (defined $headers) { if (ref($headers) eq 'ARRAY') { $headers = HTTP::Headers->new(@$headers); } else { $headers = $headers->clone; } } else { $headers = HTTP::Headers->new; } if ($method eq 'GET' || $method eq 'DELETE') { my $query = build_content({%$params, %$oauth_params}); my $url = sprintf q{%s?%s}, $args{url}, $query; my $req = HTTP::Request->new($method, $url, $headers); return $req; } else { my $query = build_content($oauth_params); my $url = sprintf q{%s?%s}, $args{url}, $query; unless ($headers->header("Content-Type")) { $headers->header("Content-Type", "application/x-www-form-urlencoded"); } my $content_type = $headers->header("Content-Type"); my $content = ($content_type eq "application/x-www-form-urlencoded") ? build_content($params) : $args{content} || build_content($params); $headers->header("Content-Length", bytes::length($content)); my $req = HTTP::Request->new($method, $url, $headers, $content); return $req; } } =head2 is_legacy( $plack_request ) Returns true if passed L object is based draft version 10. if ( $meth->is_legacy( $plack_request ) ) { ... } =cut sub is_legacy { my ($self, $req) = @_; return (exists $req->query_parameters->{oauth_token}); } =head1 SEE ALSO L L L L =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; ParamMethods.pm100664001750001750 505512755342515 20707 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2package OAuth::Lite2::ParamMethods; use strict; use warnings; use OAuth::Lite2::ParamMethod::AuthHeader; use OAuth::Lite2::ParamMethod::FormEncodedBody; use OAuth::Lite2::ParamMethod::URIQueryParameter; use base 'Exporter'; our %EXPORT_TAGS = ( all => [qw/ AUTH_HEADER FORM_BODY URI_QUERY /] ); our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; use constant AUTH_HEADER => 0; use constant FORM_BODY => 1; use constant URI_QUERY => 2; my @METHODS = ( OAuth::Lite2::ParamMethod::AuthHeader->new, OAuth::Lite2::ParamMethod::FormEncodedBody->new, OAuth::Lite2::ParamMethod::URIQueryParameter->new, ); sub get_param_parser { my ($self, $req) = @_; for my $method ( @METHODS ) { return $method if $method->match($req) } return; } sub get_request_builder { my ($self, $type) = @_; return $METHODS[ $type ]; } =head1 NAME OAuth::Lite2::ParamMethods - store of builders/parsers for OAuth 2.0 parameters =head1 SYNOPSIS use OAuth::Lite2::ParamMethods qw(AUTH_HEADER FORM_BODY URI_QUERY); # client side my $builder = OAuth::Lite2::ParamMethods->get_request_builder( AUTH_HEADER ); my $req = $builder->build_request(...); # server side my $parser = OAuth::Lite2::ParamMethods->get_param_parser( $plack_request ) or $app->error("This is not OAuth 2.0 request"); my ($token, $params) = $parser->parse( $plack_request ); =head1 DESCRIPTION Store of builders/parsers for OAuth 2.0 parameters =head1 CONSTANTS =over 4 =item AUTH_HEADER =item FORM_BODY =item URI_QUERY =back =head1 METHODS =head2 get_param_parser( $plack_request ) Pass a L object and proper parser for the request. my $parser = OAuth::Lite2::ParamMethods->get_param_parser( $plack_request ) or $app->error("This is not OAuth 2.0 request"); my ($token, $params) = $parser->parse( $plack_request ); =head2 get_request_builder( $type ) Returns proper HTTP request builder for the passed $type. my $builder = OAuth::Lite2::ParamMethods->get_request_builder( AUTH_HEADER ); my $req = $builder->build_request(...); =head1 SEE ALSO L L L =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; Context.pm100664001750001750 172112755342515 21211 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Serverpackage OAuth::Lite2::Server::Context; use strict; use warnings; use base 'Class::Accessor::Fast'; __PACKAGE__->mk_accessors(qw(request data_handler)); =head1 NAME OAuth::Lite2::Server::Context - request context object. =head1 SYNOPSIS my $context = OAuth::Lite2::Server::Context->new({ request => $req, data_handler => YourDataHandler->new, }); =head1 DESCRIPTION request context object. =head1 METHODS =head2 request accessor for current L object. =head2 data_handler accessor for L object. =head1 SEE ALSO L =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; DataHandler.pm100664001750001750 1443412755342515 21761 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Serverpackage OAuth::Lite2::Server::DataHandler; use strict; use warnings; use Params::Validate; use OAuth::Lite2::Server::Error; sub new { my ($class, %args) = @_; my $self = bless { request => undef, %args }, $class; $self->init; $self; } sub request { my $self = shift; return $self->{request}; } sub init { my $self = shift; # template method } sub validate_client { my ($self, $client_id, $client_secret, $grant_type) = @_; die "abstract method"; } sub get_user_id { my ($self, $username, $password) = @_; die "abstract method"; } sub create_or_update_auth_info { my ($self, %args) = @_; Params::Validate::validate(@_, { client_id => 1, user_id => 1, scope => { optional => 1 }, }); die "abstract method"; } sub create_or_update_access_token { my ($self, %args) = @_; Params::Validate::validate(@_, { auth_info => 1, # secret_type => 1, }); die "abstract method"; } sub get_auth_info_by_code { my ($self, $code) = @_; die "abstract method"; } sub get_auth_info_by_refresh_token { my ($self, $refresh_token) = @_; die "abstract method"; } sub get_client_user_id { my ($self, $client_id) = @_; die "abstract method"; } sub validate_client_by_id { my ($self, $client_id) = @_; 1; } sub validate_user_by_id { my ($self, $user_id) = @_; 1; } sub get_access_token { my ($self, $token) = @_; die "abstract method"; } sub get_auth_info_by_id { my ($self, $id) = @_; die "abstract method"; } sub get_group_id_by_client_id { my ($self, $client_id) = @_; die "abstract method"; } sub validate_grouping_scope { my ($self, $client_id, $scope) = @_; die "abstract method"; } sub create_server_state { my ($self, %args) = @_; die "abstract method"; } sub get_user_id_by_external_assertion{ my ($self, %args) = @_; die "abstract method"; } =head1 NAME OAuth::Lite2::Server::DataHandler - Base class that specifies interface for data handler for your service. =head1 DESCRIPTION This connects OAuth::Lite2 library to your service. This specifies an interface to handle data stored in your application. You must inherit this and implement the subroutines according to the interface contract. =head1 SYNOPSIS package YourDataHandler; use strict; use warnings; use parent 'OAuth::Lite2::Server::DataHandler'; =head1 METHODS =head2 init This method can be implemented to initialize your subclass. =head1 INTERFACES =head2 request Returns object. =head2 validate_client( $client_id, $client_secret, $grant_type ) This method is used by Token Endpoint. This method will be called all the time, regardless of the grant_type setting. This is the place to check if the client_id and client credentials are valid, as well as checking if the client is allowed to use this grant_type. If all the checks are successful, return 1. Otherwise return 0. =head2 get_user_id( $username, $password ) This method is used by Token Endpoint, when requested grant_type is 'password'. The username and password are provided. You should check if the credentials are valid or not. If the checks are successful, return the user's identifier. The user's identifier is managed by your service. =head2 create_or_update_auth_info( %params ) Create and save new authorization info. Should return L object. =head2 create_or_update_access_token( %params ) Create and save new access token. Should return L object. =head2 get_auth_info_by_code( $code ) This method is used when the client obtains an access_token using an authorization-code that was issued by server with user's authorization. The Web Server Profile requires this interface. Should return L object. =head2 get_auth_info_by_refresh_token( $refresh_token ) This method is used when the access_token is refreshed. Should return L object. =head2 get_access_token( $token ) This interface is used on a protected resource endpoint. See L. Returns an access token which allows access to the protected attributes. Should return L object. =head2 get_auth_info_by_id( $auth_id ) This method is used on a protected resource endpoint. See L. This method is called after the get_access_token method. Returns authorization-info that is related to the $auth_id and access-token. Should return L object. =head2 validate_client_by_id( $client_id ) This hook is called on protected resource endpoint. See L. After checking if the token is valid, you can check if the client related the token is valid in this method. If the validation of the client_id is successful, return 1. Otherwise return 0. =head2 validate_user_by_id( $user_id ) This hook is called on protected resource endpoint. See L. After checking if token is valid, you can check if the user related the token is valid in this method. If the validation of the user is successful, return 1. Otherwise return 0. =head2 get_group_id_by_client_id ( $client_id ) If client_id has group_id, return it. =head2 validate_grouping_scope ( $client_id, $scope ) If scope value is allowed, return 1. =head2 create_server_state ( $client_id ) Create and save L object. =head2 get_user_id_by_external_assertion ( %params ) This method is used by Token Endpoint, when requested grant_type is 'federation-bearer'. The external service assertion is provided. You should check if the related external service account is valid or not. If the checks are successful, return the user's identifier. The user's identifier is managed by your service. =head1 AUTHOR Ryo Ito, Eritou.06@gmail.comE Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; Token.pm100664001750001750 1676212755342515 22460 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Server/Endpointpackage OAuth::Lite2::Server::Endpoint::Token; use strict; use warnings; use overload q(&{}) => sub { shift->psgi_app }, fallback => 1; use Try::Tiny qw/try catch/; use Plack::Request; use Params::Validate; use OAuth::Lite2::Formatters; use OAuth::Lite2::Server::Error; use OAuth::Lite2::Server::GrantHandlers; use OAuth::Lite2::ParamMethod::AuthHeader; sub new { my $class = shift; my %args = Params::Validate::validate(@_, { data_handler => 1, error_uri => { optional => 1 }, }); my $self = bless { data_handler => $args{data_handler}, error_uri => $args{error_uri}, grant_handlers => {}, }, $class; return $self; } sub support_grant_type { my ($self, $type) = @_; my $handler = OAuth::Lite2::Server::GrantHandlers->get_handler($type) or OAuth::Lite2::Server::Error::UnsupportedGrantType->throw; $self->{grant_handlers}{$type} = $handler; } sub support_grant_types { my $self = shift; $self->support_grant_type($_) for @_; } sub data_handler { my ($self, $handler) = @_; $self->{data_handler} = $handler if $handler; $self->{data_handler}; } sub psgi_app { my $self = shift; return $self->{psgi_app} ||= $self->compile_psgi_app; } sub compile_psgi_app { my $self = shift; my $app = sub { my $env = shift; my $req = Plack::Request->new($env); my $res; try { $res = $self->handle_request($req); } catch { # Internal Server Error warn $_; $res = $req->new_response(500); }; return $res->finalize; }; return $app; } sub handle_request { my ($self, $request) = @_; # from draft-v8, format is specified to JSON only. my $format = "json"; # my $format = $request->param("format") || "json"; my $formatter = OAuth::Lite2::Formatters->get_formatter_by_name($format) || OAuth::Lite2::Formatters->get_formatter_by_name("json"); my $res = try { my $type = $request->param("grant_type") or OAuth::Lite2::Server::Error::InvalidRequest->throw( description => q{'grant_type' not found}, ); my $handler = $self->{grant_handlers}{$type} or OAuth::Lite2::Server::Error::UnsupportedGrantType->throw; my $data_handler = $self->{data_handler}->new(request => $request); # If Authorization Header is set, it is decoded and overwrite form encoded parameters. my $parser = OAuth::Lite2::ParamMethod::AuthHeader->new; my $header_credentials = $parser->basic_credentials($request); my $client_id = ($header_credentials->{client_id}) ? $header_credentials->{client_id} : $request->param("client_id"); OAuth::Lite2::Server::Error::InvalidRequest->throw( description => q{'client_id' not found}, )unless($client_id); my $client_secret = ($header_credentials->{client_secret}) ? $header_credentials->{client_secret} : $request->param("client_secret"); # The grant type which are defined in spec require client authentication, # but additional grant type may not. if ( $handler->is_required_client_authentication ) { OAuth::Lite2::Server::Error::InvalidRequest->throw( description => q{'client_secret' not found}, )unless($client_secret); } $data_handler->validate_client($client_id, $client_secret, $type) or OAuth::Lite2::Server::Error::InvalidClient->throw; $handler->{client_id} = $client_id; $handler->{client_secret} = $client_secret; my $result = $handler->handle_request($data_handler); return $request->new_response(200, [ "Content-Type" => $formatter->type, "Cache-Control" => "no-store" ], [ $formatter->format($result) ]); } catch { if ($_->isa("OAuth::Lite2::Server::Error")) { my $error_params = { error => $_->type }; $error_params->{error_description} = $_->description if $_->description; $error_params->{error_uri} = $self->{error_uri} if $self->{error_uri}; return $request->new_response($_->code, [ "Content-Type" => $formatter->type, "Cache-Control" => "no-store" ], [ $formatter->format($error_params) ]); } else { die $_; } }; } =head1 NAME OAuth::Lite2::Server::Endpoint::Token - token endpoint PSGI application =head1 SYNOPSIS token_endpoint.psgi use strict; use warnings; use Plack::Builder; use OAuth::Lite2::Server::Endpoint::Token; use MyDataHandlerClass; builder { my $app = OAuth::Lite2::Server::Endpoint::Token->new( data_handler => 'MyDataHandlerClass', ); $app->support_grant_types(qw(authorization_code refresh_token)); $app; }; =head1 DESCRIPTION The instance of this class behaves as a PSGI application (subroutine reference). This is for the OAuth 2.0 token-endpoint. The first thing you need to do is make your custom class, which inherits L, and then setup the PSGI file referencing it. =head1 METHODS =head2 new( %params ) =over 4 =item data_handler The name of your custom class that inherits the L package. =item error_uri Optional. This URI indicates the page that should be presented on an error. This will be included in error responses. =back =head2 support_grant_type( $type ) Indicates support for a specific grant type. This does not remove previously supported grant types. The available values are: =over 4 =item authorization_code =item password =item client_credentials =item refresh_token =back =head2 support_grant_types( @types ) Allows specification of multiple grant types at once. This is equivalent to calling support_grant_type once for each type in the list. The available values are: =over 4 =item authorization_code =item password =item client_credentials =item refresh_token =back =head2 data_handler This returns the class that inherits the L package. This is defined by the data_handler parameter of the constructor. =head2 psgi_app This returns a PSGI application. =head2 compile_psgi_app This will compile the PSGI application. =head2 handle_request( $req ) This will parse the access token request and call the data handler's method. =head1 TEST You can test with L and some of the client classes. my $app = OAuth::Lite2::Server::Endpoint::Token->new( data_handler => 'MyDataHandlerClass', ); $app->support_grant_types(qw(authorization_code refresh_token)); my $mock_agent = OAuth::Lite2::Agent::PSGIMock->new(app => $app); my $client = OAuth::Lite2::Client::UsernameAndPassword->new( id => q{my_client_id}, secret => q{my_client_secret}, agent => $mock_agent, ); my $token = $client->get_access_token( username => q{foo}, password => q{bar}, ); ok($token); is($token->access_token, q{access_token_value}); =head1 AUTHOR Ryo Ito, Eritou.06@gmail.comE Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; Error.pm100664001750001750 1411712755342515 20701 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Serverpackage OAuth::Lite2::Server::Error; use strict; use warnings; use overload q{""} => sub { sprintf q{%s: %s}, $_[0]->type, $_[0]->description }, fallback => 1; =head1 NAME OAuth::Lite2::Server::Error - OAuth 2.0 server errors =head1 SYNOPSIS # At End-User Endpoint try { if ($something_wrong) { OAuth::Lite2::Server::Error::InvalidRequest->throw( description => q{Something wrong}, # state => q{foo}, ); } } catch { if ($_->isa("OAuth::Lite2::Server::Error")) { my $uri = URI->new( $client_callback_uri ); my %error_params = ( error => $_->type ); $error_params{error_description} = $_->description if $_->description; $error_params{state} = $_->state if $_->state; $uri->query_form(%error_params); $your_app->redirect( $uri->as_string ); } else { # Internal Server Error } }; # At token-endpoint try { } catch { if ($_->isa("OAuth::Lite2::Server::Error")) { my %error_params = ( error => $_->type ); $error_params{error_description} = $_->description if $_->description; $error_params{scope} = $_->scope if $_->scope; $req->new_response($_->code, [ "Content-Type" => $formatter->type, "Cache-Control" => "no-store" ], [ $formatter->format(\%error_params) ], ); } else { # rethrow die $_; } }; =head1 DESCRIPTION OAuth 2.0 error classes. See L, L, =head1 METHODS There are following errors =head1 ERRORS =over 4 =item OAuth::Lite2::Server::Error::InvalidRequest =item OAuth::Lite2::Server::Error::InvalidClient =item OAuth::Lite2::Server::Error::UnauthorizedClient =item OAuth::Lite2::Server::Error::RedirectURIMismatch =item OAuth::Lite2::Server::Error::AccessDenied =item OAuth::Lite2::Server::Error::UnsupportedResponseType =item OAuth::Lite2::Server::Error::UnsupportedResourceType =item OAuth::Lite2::Server::Error::InvalidGrant =item OAuth::Lite2::Server::Error::UnsupportedGrantType =item OAuth::Lite2::Server::Error::InvalidScope =item OAuth::Lite2::Server::Error::InvalidToken =item OAuth::Lite2::Server::Error::ExpiredTokenLegacy =item OAuth::Lite2::Server::Error::ExpiredToken =item OAuth::Lite2::Server::Error::InsufficientScope =item OAuth::Lite2::Server::Error::InvalidServerState =item OAuth::Lite2::Server::Error::TemporarilyUnavailable =item OAuth::Lite2::Server::Error::ServerError =back =cut sub new { my ($class, %args) = @_; bless { description => $args{description} || '', state => $args{state} || '', code => $args{code} || 400, }, $class; } sub throw { my ($class, %args) = @_; die $class->new(%args); } sub code { $_[0]->{code} } sub type { die "abstract method" } sub description { $_[0]->{description} } sub state { $_[0]->{state} } # OAuth Server Error package OAuth::Lite2::Server::Error::InvalidRequest; our @ISA = qw(OAuth::Lite2::Server::Error); sub type { "invalid_request" } package OAuth::Lite2::Server::Error::InvalidClient; our @ISA = qw(OAuth::Lite2::Server::Error); sub code { 401 } sub type { "invalid_client" } package OAuth::Lite2::Server::Error::UnauthorizedClient; our @ISA = qw(OAuth::Lite2::Server::Error); sub code { 401 } sub type { "unauthorized_client" } package OAuth::Lite2::Server::Error::RedirectURIMismatch; our @ISA = qw(OAuth::Lite2::Server::Error); sub code { 401 } sub type { "redirect_uri_mismatch" } package OAuth::Lite2::Server::Error::AccessDenied; our @ISA = qw(OAuth::Lite2::Server::Error); sub code { 401 } sub type { "access_denied" } package OAuth::Lite2::Server::Error::UnsupportedResponseType; our @ISA = qw(OAuth::Lite2::Server::Error); sub type { "unsupported_response_type" } package OAuth::Lite2::Server::Error::UnsupportedResourceType; our @ISA = qw(OAuth::Lite2::Server::Error); sub type { "unsupported_resource_type" } package OAuth::Lite2::Server::Error::InvalidGrant; our @ISA = qw(OAuth::Lite2::Server::Error); sub code { 401 } sub type { "invalid_grant" } package OAuth::Lite2::Server::Error::UnsupportedGrantType; our @ISA = qw(OAuth::Lite2::Server::Error); sub type { "unsupported_grant_type" } package OAuth::Lite2::Server::Error::InvalidScope; our @ISA = qw(OAuth::Lite2::Server::Error); sub code { 401 } sub type { "invalid_scope" } package OAuth::Lite2::Server::Error::InvalidToken; our @ISA = qw(OAuth::Lite2::Server::Error); sub code { 401 } sub type { "invalid_token" } package OAuth::Lite2::Server::Error::ExpiredTokenLegacy; our @ISA = qw(OAuth::Lite2::Server::Error); sub code { 401 } sub type { "expired_token" } package OAuth::Lite2::Server::Error::ExpiredToken; our @ISA = qw(OAuth::Lite2::Server::Error); sub code { 401 } sub type { "invalid_token" } sub description { "The access token expired" } package OAuth::Lite2::Server::Error::InsufficientScope; our @ISA = qw(OAuth::Lite2::Server::Error); sub code { 401 } sub type { "insufficient_scope" } package OAuth::Lite2::Server::Error::InvalidServerState; our @ISA = qw(OAuth::Lite2::Server::Error); sub code { 401 } sub type { "invalid_server_state" } # Generally, the client knows the state of the server by HTTP Status Code. package OAuth::Lite2::Server::Error::TemporarilyUnavailable; our @ISA = qw(OAuth::Lite2::Server::Error); sub code { 503 } sub type { "temporarily_unavailable" } package OAuth::Lite2::Server::Error::ServerError; our @ISA = qw(OAuth::Lite2::Server::Error); sub code { 500 } sub type { "server_error" } package OAuth::Lite2::Server::Error; =head1 AUTHOR Ryo Ito, Eritou.06@gmail.comE Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; GrantHandler.pm100664001750001750 317412755342515 22142 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Serverpackage OAuth::Lite2::Server::GrantHandler; use strict; use warnings; sub new { my $class = shift; bless {}, $class; } sub is_required_client_authentication { return 1; } sub handle_request { my ($self, $data_handler) = @_; die "abstract method"; } =head1 NAME OAuth::Lite2::Server::GrantHandler - base class of each grant_type handler =head1 SYNOPSIS my $handler = OAuth::Lite2::Server::GrantHandler->new; my $res = $handler->handle_request( $ctx ); =head1 METHODS =head2 new Constructor =head2 is_required_client_authentication Return whether each grant type requires the client authentication The grant type which are defined in spec require client authentication, but additional grant type may not. =head2 handle_request( $data_handler ) processes passed L, and return hash represents that includes response-parameters. my $res = $handler->handle_request( $data_handler ); =head1 SEE ALSO L L L L L L =head1 AUTHOR Ryo Ito, Eritou.06@gmail.comE Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; AuthorizationCode.pm100664001750001750 644212755342515 25576 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Server/GrantHandlerpackage OAuth::Lite2::Server::GrantHandler::AuthorizationCode; use strict; use warnings; use parent 'OAuth::Lite2::Server::GrantHandler'; use OAuth::Lite2::Server::Error; use OAuth::Lite2::ParamMethod::AuthHeader; use Carp (); sub handle_request { my ($self, $dh) = @_; my $req = $dh->request; my $parser = OAuth::Lite2::ParamMethod::AuthHeader->new; my $header_credentials = $parser->basic_credentials($req); my $client_id = ($header_credentials->{client_id}) ? $header_credentials->{client_id} : $req->param("client_id"); my $code = $req->param("code") or OAuth::Lite2::Server::Error::InvalidRequest->throw( description => "'code' not found" ); my $redirect_uri = $req->param("redirect_uri") or OAuth::Lite2::Server::Error::InvalidRequest->throw( description => "'redirect_uri' not found" ); my $server_state = $req->param("server_state"); my $auth_info = $dh->get_auth_info_by_code($code) or OAuth::Lite2::Server::Error::InvalidGrant->throw; Carp::croak "OAuth::Lite2::Server::DataHandler::get_auth_info_by_code doesn't return OAuth::Lite2::Model::AuthInfo" unless ($auth_info && $auth_info->isa("OAuth::Lite2::Model::AuthInfo")); OAuth::Lite2::Server::Error::InvalidClient->throw unless ($auth_info->client_id eq $client_id); OAuth::Lite2::Server::Error::RedirectURIMismatch->throw unless ( $auth_info->redirect_uri && $auth_info->redirect_uri eq $redirect_uri); if ( $auth_info->server_state ) { OAuth::Lite2::Server::Error::InvalidServerState->throw unless ( $server_state and $server_state eq $auth_info->server_state ); } else { OAuth::Lite2::Server::Error::InvalidServerState->throw if ( $server_state ); } my $access_token = $dh->create_or_update_access_token( auth_info => $auth_info, ); Carp::croak "OAuth::Lite2::Server::DataHandler::create_or_update_access_token doesn't return OAuth::Lite2::Model::AccessToken" unless ($access_token && $access_token->isa("OAuth::Lite2::Model::AccessToken")); my $res = { token_type => 'Bearer', access_token => $access_token->token, }; $res->{expires_in} = int($access_token->expires_in) if $access_token->expires_in; $res->{refresh_token} = $auth_info->refresh_token if $auth_info->refresh_token; $res->{scope} = $auth_info->scope if $auth_info->scope; return $res; } =head1 NAME OAuth::Lite2::Server::GrantHandler::AuthorizationCode - handler for 'authorization-code' grant_type request =head1 SYNOPSIS my $handler = OAuth::Lite2::Server::GrantHandler::AuthorizationCode->new; my $res = $handler->handle_request( $data_handler ); =head1 DESCRIPTION handler for 'authorization-code' grant_type request. =head1 METHODS =head2 handle_request( $req ) See L document. =head1 AUTHOR Ryo Ito, Eritou.06@gmail.comE Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; ClientCredentials.pm100664001750001750 526212755342515 25536 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Server/GrantHandlerpackage OAuth::Lite2::Server::GrantHandler::ClientCredentials; use strict; use warnings; use parent 'OAuth::Lite2::Server::GrantHandler'; use OAuth::Lite2::Server::Error; use OAuth::Lite2::ParamMethod::AuthHeader; use Carp (); sub handle_request { my ($self, $dh) = @_; my $req = $dh->request; my $parser = OAuth::Lite2::ParamMethod::AuthHeader->new; my $header_credentials = $parser->basic_credentials($req); my $client_id = ($header_credentials->{client_id}) ? $header_credentials->{client_id} : $req->param("client_id"); my $client_secret = ($header_credentials->{client_secret}) ? $header_credentials->{client_secret} : $req->param("client_secret"); my $user_id = $dh->get_client_user_id($client_id, $client_secret); OAuth::Lite2::Server::Error::InvalidClient->throw unless defined $user_id; my $scope = $req->param("scope"); my $auth_info = $dh->create_or_update_auth_info( client_id => $client_id, user_id => $user_id, scope => $scope, ); Carp::croak "OAuth::Lite2::Server::DataHandler::create_or_update_auth_info doesn't return OAuth::Lite2::Model::AuthInfo" unless ($auth_info && $auth_info->isa("OAuth::Lite2::Model::AuthInfo")); my $access_token = $dh->create_or_update_access_token( auth_info => $auth_info, ); Carp::croak "OAuth::Lite2::Server::DataHandler::create_or_update_access_token doesn't return OAuth::Lite2::Model::AccessToken" unless ($access_token && $access_token->isa("OAuth::Lite2::Model::AccessToken")); my $res = { token_type => 'Bearer', access_token => $access_token->token, }; $res->{expires_in} = int($access_token->expires_in) if $access_token->expires_in; $res->{refresh_token} = $auth_info->refresh_token if $auth_info->refresh_token; $res->{scope} = $auth_info->scope if $auth_info->scope; return $res; } =head1 NAME OAuth::Lite2::Server::GrantHandler::ClientCredentials - handler for 'client_credentials' grant_type request =head1 SYNOPSIS my $handler = OAuth::Lite2::Server::GrantHandler::ClientCredentials->new; my $res = $handler->handle_request( $data_handler ); =head1 DESCRIPTION handler for 'client_credentials' grant_type request. =head1 METHODS =head2 handle_request( $req ) See L document. =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; ExternalService.pm100664001750001750 557512755342515 25254 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Server/GrantHandlerpackage OAuth::Lite2::Server::GrantHandler::ExternalService; use strict; use warnings; use parent 'OAuth::Lite2::Server::GrantHandler'; use OAuth::Lite2::Server::Error; use OAuth::Lite2::ParamMethod::AuthHeader; use Carp (); sub handle_request { my ($self, $dh) = @_; my $req = $dh->request; my $parser = OAuth::Lite2::ParamMethod::AuthHeader->new; my $header_credentials = $parser->basic_credentials($req); my $client_id = ($header_credentials->{client_id}) ? $header_credentials->{client_id} : $req->param("client_id"); my $assertion = $req->param("assertion") or OAuth::Lite2::Server::Error::InvalidRequest->throw( description => "'assertion' not found" ); my $user_id = $dh->get_user_id_by_external_assertion( client_id => $client_id, assertion => $assertion, type => $req->param("type") || '', iss => $req->param("iss") || '', aud => $req->param("aud") || '', ) or OAuth::Lite2::Server::Error::InvalidGrant->throw; my $scope = $req->param("scope"); my $auth_info = $dh->create_or_update_auth_info( client_id => $client_id, user_id => $user_id, scope => $scope, ); Carp::croak "OAuth::Lite2::Server::DataHandler::create_or_update_auth_info doesn't return OAuth::Lite2::Model::AuthInfo" unless ($auth_info && $auth_info->isa("OAuth::Lite2::Model::AuthInfo")); my $access_token = $dh->create_or_update_access_token( auth_info => $auth_info, ); Carp::croak "OAuth::Lite2::Server::DataHandler::create_or_update_access_token doesn't return OAuth::Lite2::Model::AccessToken" unless ($access_token && $access_token->isa("OAuth::Lite2::Model::AccessToken")); my $res = { token_type => 'Bearer', access_token => $access_token->token, }; $res->{expires_in} = int($access_token->expires_in) if $access_token->expires_in; $res->{refresh_token} = $auth_info->refresh_token if $auth_info->refresh_token; $res->{scope} = $auth_info->scope if $auth_info->scope; return $res; } =head1 NAME OAuth::Lite2::Server::GrantHandler::ExternalService - handler for 'federated-assertion' grant_type request =head1 SYNOPSIS my $handler = OAuth::Lite2::Server::GrantHandler::ExternalService->new; my $res = $handler->handle_request( $data_handler ); =head1 DESCRIPTION handler for 'federated-assertion' grant_type request. =head1 METHODS =head2 handle_request( $req ) See L document. =head1 AUTHOR Ryo Ito, Eritou.06@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2014 by Ryo Ito This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; GroupingRefreshToken.pm100664001750001750 773012755342515 26256 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Server/GrantHandlerpackage OAuth::Lite2::Server::GrantHandler::GroupingRefreshToken; use strict; use warnings; use parent 'OAuth::Lite2::Server::GrantHandler'; use Carp (); use OAuth::Lite2::Server::Error; use OAuth::Lite2::ParamMethod::AuthHeader; sub handle_request { my ($self, $dh) = @_; my $req = $dh->request; my $parser = OAuth::Lite2::ParamMethod::AuthHeader->new; my $header_credentials = $parser->basic_credentials($req); my $client_id = ($header_credentials->{client_id}) ? $header_credentials->{client_id} : $req->param("client_id"); # validate grouping refresh_token my $refresh_token = $req->param("refresh_token") or OAuth::Lite2::Server::Error::InvalidRequest->throw( description => "'refresh_token' not found" ); my $grouping_auth_info = $dh->get_auth_info_by_refresh_token($refresh_token) or OAuth::Lite2::Server::Error::InvalidGrant->throw( description => "'refresh_token' is invalid" ); Carp::croak "OAuth::Lite2::Server::DataHandler::get_auth_info_by_refresh_token doesn't return OAuth::Lite2::Model::AuthInfo" unless ($grouping_auth_info && $grouping_auth_info->isa("OAuth::Lite2::Model::AuthInfo")); my $group_id = $dh->get_group_id_by_client_id( $grouping_auth_info->client_id ) or OAuth::Lite2::Server::Error::InvalidGrant->throw( description => "'refresh_token' does not have group id" ); # validate target client my $target_group_id = $dh->get_group_id_by_client_id( $client_id ) or OAuth::Lite2::Server::Error::InvalidClient->throw( description => "'client_id' does not have group id" ); OAuth::Lite2::Server::Error::InvalidRequest->throw( description => "group id does not match" ) unless ( $group_id eq $target_group_id ); my $scope = $req->param("scope"); OAuth::Lite2::Server::Error::InvalidScope->throw unless $dh->validate_grouping_scope( $client_id, $scope ); # create response my $auth_info = $dh->create_or_update_auth_info( client_id => $client_id, user_id => $grouping_auth_info->user_id, scope => $scope, ); Carp::croak "OAuth::Lite2::Server::DataHandler::create_or_update_auth_info doesn't return OAuth::Lite2::Model::AuthInfo" unless ($auth_info && $auth_info->isa("OAuth::Lite2::Model::AuthInfo")); my $access_token = $dh->create_or_update_access_token( auth_info => $auth_info, ); Carp::croak "OAuth::Lite2::Server::DataHandler::create_or_update_access_token doesn't return OAuth::Lite2::Model::AccessToken" unless ($access_token && $access_token->isa("OAuth::Lite2::Model::AccessToken")); my $res = { token_type => 'Bearer', access_token => $access_token->token, }; $res->{expires_in} = int($access_token->expires_in) if $access_token->expires_in; $res->{refresh_token} = $auth_info->refresh_token if $auth_info->refresh_token; $res->{scope} = $auth_info->scope if $auth_info->scope; return $res; } =head1 NAME OAuth::Lite2::Server::GrantHandler::GroupingRefreshToken - handler for 'grouping-refresh-token' grant_type request =head1 SYNOPSIS my $handler = OAuth::Lite2::Server::GrantHandler::GroupingRefreshToken->new; my $res = $handler->handle_request( $data_handler ); =head1 DESCRIPTION handler for 'grouping-refresh-token' grant_type request. =head1 METHODS =head2 handle_request( $req ) See L document. =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; Password.pm100664001750001750 546012755342515 23744 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Server/GrantHandlerpackage OAuth::Lite2::Server::GrantHandler::Password; use strict; use warnings; use parent 'OAuth::Lite2::Server::GrantHandler'; use OAuth::Lite2::Server::Error; use OAuth::Lite2::ParamMethod::AuthHeader; use Carp (); sub handle_request { my ($self, $dh) = @_; my $req = $dh->request; my $parser = OAuth::Lite2::ParamMethod::AuthHeader->new; my $header_credentials = $parser->basic_credentials($req); my $client_id = ($header_credentials->{client_id}) ? $header_credentials->{client_id} : $req->param("client_id"); my $username = $req->param("username"); OAuth::Lite2::Server::Error::InvalidRequest->throw( description => "'username' not found" ) unless $username; my $password = $req->param("password") or OAuth::Lite2::Server::Error::InvalidRequest->throw( description => "'password' not found" ); my $user_id = $dh->get_user_id($username, $password) or OAuth::Lite2::Server::Error::InvalidGrant->throw; my $scope = $req->param("scope"); my $auth_info = $dh->create_or_update_auth_info( client_id => $client_id, user_id => $user_id, scope => $scope, ); Carp::croak "OAuth::Lite2::Server::DataHandler::create_or_update_auth_info doesn't return OAuth::Lite2::Model::AuthInfo" unless ($auth_info && $auth_info->isa("OAuth::Lite2::Model::AuthInfo")); my $access_token = $dh->create_or_update_access_token( auth_info => $auth_info, ); Carp::croak "OAuth::Lite2::Server::DataHandler::create_or_update_access_token doesn't return OAuth::Lite2::Model::AccessToken" unless ($access_token && $access_token->isa("OAuth::Lite2::Model::AccessToken")); my $res = { token_type => 'Bearer', access_token => $access_token->token, }; $res->{expires_in} = int($access_token->expires_in) if $access_token->expires_in; $res->{refresh_token} = $auth_info->refresh_token if $auth_info->refresh_token; $res->{scope} = $auth_info->scope if $auth_info->scope; return $res; } =head1 NAME OAuth::Lite2::Server::GrantHandler::Password - handler for 'password' grant_type request =head1 SYNOPSIS my $handler = OAuth::Lite2::Server::GrantHandler::Password->new; my $res = $handler->handle_request( $data_handler ); =head1 DESCRIPTION handler for 'password' grant_type request. =head1 METHODS =head2 handle_request( $req ) See L document. =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; RefreshToken.pm100664001750001750 514712755342515 24543 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Server/GrantHandlerpackage OAuth::Lite2::Server::GrantHandler::RefreshToken; use strict; use warnings; use parent 'OAuth::Lite2::Server::GrantHandler'; use OAuth::Lite2::Server::Error; use OAuth::Lite2::ParamMethod::AuthHeader; use Carp (); sub handle_request { my ($self, $dh) = @_; my $req = $dh->request; my $parser = OAuth::Lite2::ParamMethod::AuthHeader->new; my $header_credentials = $parser->basic_credentials($req); my $client_id = ($header_credentials->{client_id}) ? $header_credentials->{client_id} : $req->param("client_id"); my $refresh_token = $req->param("refresh_token") or OAuth::Lite2::Server::Error::InvalidRequest->throw( description => "'refresh_token' not found" ); my $auth_info = $dh->get_auth_info_by_refresh_token($refresh_token) or OAuth::Lite2::Server::Error::InvalidGrant->throw; Carp::croak "OAuth::Lite2::Server::DataHandler::get_auth_info_by_refresh_token doesn't return OAuth::Lite2::Model::AuthInfo" unless ($auth_info && $auth_info->isa("OAuth::Lite2::Model::AuthInfo")); OAuth::Lite2::Server::Error::InvalidClient->throw unless $auth_info->client_id eq $client_id; my $access_token = $dh->create_or_update_access_token( auth_info => $auth_info, ); Carp::croak "OAuth::Lite2::Server::DataHandler::create_or_update_access_token doesn't return OAuth::Lite2::Model::AccessToken" unless ($access_token && $access_token->isa("OAuth::Lite2::Model::AccessToken")); my $res = { token_type => 'Bearer', access_token => $access_token->token, }; $res->{expires_in} = int($access_token->expires_in) if $access_token->expires_in; $res->{refresh_token} = $auth_info->refresh_token if $auth_info->refresh_token; $res->{scope} = $auth_info->scope if $auth_info->scope; return $res; } =head1 NAME OAuth::Lite2::Server::GrantHandler::RefreshToken - handler for 'refresh-token' grant_type request =head1 SYNOPSIS my $handler = OAuth::Lite2::Server::GrantHandler::RefreshToken->new; my $res = $handler->handle_request( $data_handler ); =head1 DESCRIPTION handler for 'refresh-token' grant_type request. =head1 METHODS =head2 handle_request( $req ) See L document. =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; ServerState.pm100664001750001750 355012755342515 24407 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Server/GrantHandlerpackage OAuth::Lite2::Server::GrantHandler::ServerState; use strict; use warnings; use parent 'OAuth::Lite2::Server::GrantHandler'; use OAuth::Lite2::Server::Error; use OAuth::Lite2::ParamMethod::AuthHeader; use Carp (); sub is_required_client_authentication { return 0; } sub handle_request { my ($self, $dh) = @_; my $req = $dh->request; my $parser = OAuth::Lite2::ParamMethod::AuthHeader->new; my $header_credentials = $parser->basic_credentials($req); my $client_id = ($header_credentials->{client_id}) ? $header_credentials->{client_id} : $req->param("client_id"); # create server_state my $server_state = $dh->create_server_state( client_id => $client_id, ); Carp::croak "OAuth::Lite2::Server::DataHandler::create_server_state doesn't return OAuth::Lite2::Model::ServerState" unless ($server_state && $server_state->isa("OAuth::Lite2::Model::ServerState")); my $res = { server_state => $server_state->server_state, expires_in => int($server_state->expires_in), }; return $res; } =head1 NAME OAuth::Lite2::Server::GrantHandler::ServerState - handler for 'server_state' grant_type request =head1 SYNOPSIS my $handler = OAuth::Lite2::Server::GrantHandler::ServerState->new; my $res = $handler->handle_request( $data_handler ); =head1 DESCRIPTION handler for 'server_state' grant_type request. =head1 METHODS =head2 handle_request( $req ) See L document. =head1 AUTHOR Ryo Ito, Eritou.06@gmail.comE Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; GrantHandlers.pm100664001750001750 537012755342515 22325 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Serverpackage OAuth::Lite2::Server::GrantHandlers; use strict; use warnings; use OAuth::Lite2::Server::GrantHandler::AuthorizationCode; use OAuth::Lite2::Server::GrantHandler::Password; use OAuth::Lite2::Server::GrantHandler::RefreshToken; use OAuth::Lite2::Server::GrantHandler::ClientCredentials; use OAuth::Lite2::Server::GrantHandler::GroupingRefreshToken; use OAuth::Lite2::Server::GrantHandler::ServerState; use OAuth::Lite2::Server::GrantHandler::ExternalService; my %HANDLERS; sub add_handler { my ($class, $type, $handler) = @_; $HANDLERS{$type} = $handler; } __PACKAGE__->add_handler( 'authorization_code' => OAuth::Lite2::Server::GrantHandler::AuthorizationCode->new ); __PACKAGE__->add_handler( 'password' => OAuth::Lite2::Server::GrantHandler::Password->new ); __PACKAGE__->add_handler( 'refresh_token' => OAuth::Lite2::Server::GrantHandler::RefreshToken->new ); __PACKAGE__->add_handler( 'client_credentials' => OAuth::Lite2::Server::GrantHandler::ClientCredentials->new ); # Grant types which is not defined in RFC __PACKAGE__->add_handler( 'grouping_refresh_token' => OAuth::Lite2::Server::GrantHandler::GroupingRefreshToken->new ); __PACKAGE__->add_handler( 'server_state' => OAuth::Lite2::Server::GrantHandler::ServerState->new ); __PACKAGE__->add_handler( 'external_service' => OAuth::Lite2::Server::GrantHandler::ExternalService->new ); #__PACKAGE__->add_handler( 'assertion' => ); #__PACKAGE__->add_handler( 'none' => ); sub get_handler { my ($class, $type) = @_; return $HANDLERS{$type}; } =head1 NAME OAuth::Lite2::Server::GrantHandlers - store of handlers for each grant_type. =head1 SYNOPSIS my $handler = OAuth::Lite2::Server::GrantHandlers->get_handler( $grant_type ); $handler->handle_request( $ctx ); =head1 DESCRIPTION store of handlers for each grant_type. =head1 METHODS =head2 add_handler( $grant_type, $handler ) add GrantHandler instance =head2 get_handler( $grant_type ) get GrantHandler instance =head1 SEE ALSO L L L L L L L L =head1 AUTHOR Ryo Ito, Eritou.06@gmail.comE Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; Signer.pm100664001750001750 1236212755342515 17571 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2package OAuth::Lite2::Signer; use strict; use warnings; use MIME::Base64 qw(encode_base64); use String::Random; use URI; use Carp (); use Params::Validate; use OAuth::Lite2::Signer::Algorithms; =head1 NAME OAuth::Lite2::Signer - OAuth 2.0 signature (DEPRECATED) =head1 SYNOPSIS my $signed_params = OAuth::Lite2::Signer->sign( secret => q{my_token_secret}, algorithm => q{hmac-sha256}, method => q{GET}, url => q{http://example.org/protected/resource}, ); =head1 DESCRIPTION DEPRECATED. This is for old version of OAuth 2.0 draft specification. This is for client to generate signed request, or for server to verify received request. =head1 METHODS =head2 sign( %params ) Returns the hash reference that includes parameters for OAuth 2.0 signed request. my $signed_params = OAuth::Lite2::Signer->sign( secret => q{my_token_secret}, algorithm => q{hmac-sha256}, method => q{GET}, url => q{http://example.org/protected/resource}, ); =over 4 =item secret Access token secret. =item algorithm The algorithm what you make signature with. =item method HTTP method of the request. =item url URL of the request. =item debug_nonce Optional. If you omit this, nonce string is automatically generate random string. =item debug_timestamp Optional. If you omit this, current timestamp is set. =back =cut sub sign { my $class = shift; my %args = Params::Validate::validate(@_, { secret => 1, algorithm => 1, method => 1, url => 1, debug_nonce => { optional => 1 }, debug_timestamp => { optional => 1 }, }); my $uri = URI->new($args{url}); Carp::croak "invalid uri scheme: " . $args{url} unless ($uri->scheme eq 'http' || $uri->scheme eq 'https'); my $params = { nonce => $args{debug_nonce} || $class->_gen_nonce(), timestamp => $args{debug_timestamp} || $class->_gen_timestamp(), algorithm => $args{algorithm}, }; my $string = $class->normalize_string(%$params, method => $args{method}, host => $uri->host, port => $uri->port || 80, url => $args{url}, ); my $algorithm = OAuth::Lite2::Signer::Algorithms->get_algorithm(lc $args{algorithm}) or Carp::croak "Unsupported algorithm: " . $args{algorithm}; my $signature = encode_base64($algorithm->hash($args{secret}, $string)); chomp $signature; $params->{signature} = $signature; return $params; } =head2 normalize_string( %params ) Returns normalized string according to the specification. =over 4 =item host host part of the url. =item port If you omit this, 80 is set by default. =item nonce Random string. =item timestamp unix timestamp. =item algorithm name of hmac hash algorithm. =item method HTTP method of the request. =item url URL of the request. =back =cut sub normalize_string { my ($class, %args) = @_; $args{port} ||= 80; return join(",", $args{timestamp}, $args{nonce}, $args{algorithm}, uc($args{method}), sprintf(q{%s:%d}, $args{host}, $args{port}), $args{url}, ); } sub _gen_nonce { my ($class, $digit) = @_; $digit ||= 10; my $random = String::Random->new; return $random->randregex( sprintf '[a-zA-Z0-9]{%d}', $digit ); } sub _gen_timestamp { my $class = shift; return time(); } =head2 verify( %params ) Verify a signed request. unless ( OAuth::Lite2::Signer->verify( %params ) ) { $app->error("Invalid request"); } =over 4 =item signature 'signature' parameter of the received request. =item secret The access token secret. =item algorithm 'algorithm' parameter of the received request. =item method HTTP method of the received request. =item url URL of the received request. =item nonce 'nonce' parameter of the received request. =item timestamp 'timestamp' parameter of the received request. =back =cut sub verify { my $class = shift; my %args = Params::Validate::validate(@_, { secret => 1, algorithm => 1, method => 1, url => 1, nonce => 1, timestamp => 1, signature => 1, }); my $uri = URI->new($args{url}); my $params = { nonce => $args{nonce}, timestamp => $args{timestamp}, algorithm => $args{algorithm}, }; my $string = $class->normalize_string(%$params, method => $args{method}, host => $uri->host, port => $uri->port || 80, url => $args{url}, ); my $algorithm = OAuth::Lite2::Signer::Algorithms->get_algorithm($args{algorithm}) or return 0; my $signature = encode_base64($algorithm->hash($args{secret}, $string)); chomp $signature; return ($args{signature} eq $signature); } =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; Algorithm.pm100664001750001750 256112755342515 21477 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Signerpackage OAuth::Lite2::Signer::Algorithm; use strict; use warnings; sub new { bless {}, $_[0] } sub name { die "abstract method"; } sub hash { my ($self, $key, $text) = @_; die "abstract method"; } =head1 NAME OAuth::Lite2::Signer::Algorithm - signature algorithm base class. =head1 SYNOPSIS Imlement child class inheriting this. package OAuth::Lite2::Signer::Algorithm::Foo; use parent 'OAuth::Lite2::Signer::Algorithm'; sub hash { # override } 1; And use with 'hash' method interface. my $algorithm = OAuth::Lite2::Signer::Algorithm::Foo->new; my $signature = $algorithm->hash($key, $text); =head1 DESCRIPTION DEPRECATED. signature algorithm base class. =head1 METHODS =head2 new( ) Constructor. =head2 name Returns a name of the algorithm. =head2 hash( $key, $text ) Generate signature. my $signature = $algorithm->hash($key, $text); =head1 SEE ALSO L L L =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; HMAC_SHA1.pm100664001750001750 233212755342515 22757 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Signer/Algorithmpackage OAuth::Lite2::Signer::Algorithm::HMAC_SHA1; use strict; use warnings; use parent 'OAuth::Lite2::Signer::Algorithm'; use Digest::SHA; sub name { "hmac-sha1" } sub hash { my ($self, $key, $text) = @_; Digest::SHA::hmac_sha1($text, $key); } =head1 NAME OAuth::Lite2::Signer::Algorithm::HMAC_SHA1 - hmac-sha1 signature algorithm class =head1 SYNOPSIS my $algorithm = OAuth::Lite2::Signer::Algorithm::HMAC_SHA1->new; my $signature = $algorithm->hash($key, $text); =head1 DESCRIPTION DEPRECATED. 'hmac-sha1' signature algorithm class. =head1 METHODS =head2 new( ) Constructor. =head2 name Returns a name of the algorithm, 'hmac-sha1'. =head2 hash( $key, $text ) Generate signature. my $signature = $algorithm->hash($key, $text); =head1 SEE ALSO L L L =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; HMAC_SHA256.pm100664001750001750 234712755342515 23141 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Signer/Algorithmpackage OAuth::Lite2::Signer::Algorithm::HMAC_SHA256; use strict; use warnings; use parent 'OAuth::Lite2::Signer::Algorithm'; use Digest::SHA; sub name { "hmac-sha256" } sub hash { my ($self, $key, $text) = @_; Digest::SHA::hmac_sha256($text, $key); } =head1 NAME OAuth::Lite2::Signer::Algorithm::HMAC_SHA256 - hmac-sha256 signature algorithm class =head1 SYNOPSIS my $algorithm = OAuth::Lite2::Signer::Algorithm::HMAC_SHA256->new; my $signature = $algorithm->hash($key, $text); =head1 DESCRIPTION DEPRECATED. 'hmac-sha256' signature algorithm class. =head1 METHODS =head2 new( ) Constructor. =head2 name Returns a name of the algorithm, 'hmac-sha256'. =head2 hash( $key, $text ) Generate signature. my $signature = $algorithm->hash($key, $text); =head1 SEE ALSO L L L =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; Algorithms.pm100664001750001750 325212755342515 21660 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2/Signerpackage OAuth::Lite2::Signer::Algorithms; use strict; use warnings; #use OAuth::Lite2::Signer::Algorithm::HMAC_SHA1; use OAuth::Lite2::Signer::Algorithm::HMAC_SHA256; my %ALGORITHMS; sub add_algorithm { my ($class, $signer) = @_; $ALGORITHMS{$signer->name} = $signer; } #__PACKAGE__->add_algorithm( OAuth::Lite2::Signer::Algorithm::HMAC_SHA1->new ); __PACKAGE__->add_algorithm( OAuth::Lite2::Signer::Algorithm::HMAC_SHA256->new ); sub get_algorithm { my ($class, $name) = @_; return $ALGORITHMS{$name}; } =head1 NAME OAuth::Lite2::Signer::Algorithms - signature algorithms =head1 SYNOPSIS my $algorithm = OAuth::Lite2::Signer::Algorithms->get_algorithm('hmac-sha256'); my $signature = $algorithm->hash($key, $text); =head1 DESCRIPTION DEPRECATED. algorithm object store for OAuth 2.0 signature. =head1 METHODS =head2 add_algorithm( $signer ) Add signer algorithm object. the class should be L or its child. L is automatically added by default. =head2 get_algorithm( $algorithm_name ) Get algorithm object by its name. my $algorithm = OAuth::Lite2::Signer::Algorithms->get_algorithm('hmac-sha256'); =head1 SEE ALSO L L L =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; Util.pm100664001750001750 417012755342515 17235 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/OAuth/Lite2package OAuth::Lite2::Util; use strict; use warnings; use base 'Exporter'; use URI::Escape; use Scalar::Util qw(blessed); use Hash::MultiValue; our %EXPORT_TAGS = ( all => [qw( encode_param decode_param parse_content build_content )] ); our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; =head1 NAME OAuth::Lite2::Util - utility methods for OAuth 2.0 =head1 SYNOPSIS use OAuth::Lite2::Util qw(encode_param, decode_param); my $encoded = encode_param($str); my $origin = decode_param($encoded); =head1 DESCRIPTION This module exports utility methods for OAuth 2.0. =head1 METHODS =head2 encode_param ($str) =cut sub encode_param { my $param = shift; return URI::Escape::uri_escape($param, '^\w.~-'); } =head2 decode_param ($str) =cut sub decode_param { my $param = shift; return URI::Escape::uri_unescape($param); } =head2 parse_content ($content) =cut sub parse_content { my $content = shift; my $params = Hash::MultiValue->new; for my $pair (split /\&/, $content) { my ($key, $value) = split /\=/, $pair; $key = decode_param($key ||''); $value = decode_param($value||''); $params->add($key, $value); } return $params; } =head2 build_content ($params) =cut sub build_content { my $params = shift; $params = $params->as_hashref_mixed if blessed($params) && $params->isa('Hash::MultiValue'); my @pairs; for my $key (keys %$params) { my $k = encode_param($key); my $v = $params->{$key}; if (ref($v) eq 'ARRAY') { for my $av (@$v) { push(@pairs, sprintf(q{%s=%s}, $k, encode_param($av))); } } else { push(@pairs, sprintf(q{%s=%s}, $k, encode_param($v))); } } return join("&", sort @pairs); } 1; =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut ProtectedResource.pm100664001750001750 1230112755342515 25107 0ustar00ritouritou000000000000OAuth-Lite2-0.11/lib/Plack/Middleware/Auth/OAuth2package Plack::Middleware::Auth::OAuth2::ProtectedResource; use strict; use warnings; use parent 'Plack::Middleware'; use Plack::Request; use Plack::Util::Accessor qw(realm data_handler error_uri); use Try::Tiny; use Carp (); use OAuth::Lite2::Server::Error; use OAuth::Lite2::ParamMethods; sub call { my ($self, $env) = @_; my $is_legacy = 0; my $error_res = try { my $req = Plack::Request->new($env); # after draft-v6, signature is not required, so always each connection # should be under TLS. # warn "insecure bearere token request" unless $req->secure; my $parser = OAuth::Lite2::ParamMethods->get_param_parser($req) or OAuth::Lite2::Server::Error::InvalidRequest->throw; $is_legacy = $parser->is_legacy($req); # after draft-v6, $params aren't required. my ($token, $params) = $parser->parse($req); OAuth::Lite2::Server::Error::InvalidRequest->throw unless $token; my $dh = $self->{data_handler}->new(request => $req); my $access_token = $dh->get_access_token($token); OAuth::Lite2::Server::Error::InvalidToken->throw unless $access_token; Carp::croak "OAuth::Lite2::Server::DataHandler::get_access_token doesn't return OAuth::Lite2::Model::AccessToken" unless $access_token->isa("OAuth::Lite2::Model::AccessToken"); unless ($access_token->created_on + $access_token->expires_in > time()) { if($is_legacy){ OAuth::Lite2::Server::Error::ExpiredTokenLegacy->throw; }else{ OAuth::Lite2::Server::Error::ExpiredToken->throw; } } my $auth_info = $dh->get_auth_info_by_id($access_token->auth_id); OAuth::Lite2::Server::Error::InvalidToken->throw unless $auth_info; Carp::croak "OAuth::Lite2::Server::DataHandler::get_auth_info_by_id doesn't return OAuth::Lite2::Model::AuthInfo" unless $auth_info->isa("OAuth::Lite2::Model::AuthInfo"); $dh->validate_client_by_id($auth_info->client_id) or OAuth::Lite2::Server::Error::InvalidToken->throw; $dh->validate_user_by_id($auth_info->user_id) or OAuth::Lite2::Server::Error::InvalidToken->throw; $env->{REMOTE_USER} = $auth_info->user_id; $env->{X_OAUTH_CLIENT} = $auth_info->client_id; $env->{X_OAUTH_SCOPE} = $auth_info->scope if $auth_info->scope; # pass legacy flag $env->{X_OAUTH_IS_LEGACY} = ($is_legacy); return; } catch { if ($_->isa("OAuth::Lite2::Server::Error")) { my @params; push(@params, sprintf(q{realm="%s"}, $self->{realm})) if $self->{realm}; push(@params, sprintf(q{error="%s"}, $_->type)); push(@params, sprintf(q{error_description="%s"}, $_->description)) if $_->description; push(@params, sprintf(q{error_uri="%s"}, $self->{error_uri})) if $self->{error_uri}; # push(@params, sprintf(q{scope='%s'}, $_->scope)) # if $_->scope; if($is_legacy){ return [ $_->code, [ "WWW-Authenticate" => "OAuth " . join(', ', @params) ], [ ] ]; }else{ return [ $_->code, [ "WWW-Authenticate" => "Bearer " . join(', ', @params) ], [ ] ]; } } else { # rethrow die $_; } }; return $error_res || $self->app->($env); } =head1 NAME Plack::Middleware::Auth::OAuth2::ProtectedResource - middleware for OAuth 2.0 Protected Resource endpoint =head1 SYNOPSIS my $app = sub {...}; builder { enable "Plack::Middleware::Auth::OAuth2::ProtectedResource", data_handler => "YourApp::DataHandler", error_uri => q{http://example.org/error/description}; enable "Plack::Middleware::JSONP"; enable "Plack::Middleware::ContentLength"; $app; }; # and on your controller $plack_request->env->{REMOTE_USER}; $plack_request->env->{X_OAUTH_CLIENT_ID}; $plack_request->env->{X_OAUTH_SCOPE}; =head1 DESCRIPTION middleware for OAuth 2.0 Protected Resource endpoint =head1 METHODS =head2 call( $env ) This method parses access token. If access token is valid, authorization information are set to environment variables. =head1 ENV VALUES After successful verifying authorization within middleware layer, Following 3 type of values are set in env. =over 4 =item REMOTE_USER Identifier of user who grant the client to access the user's protected resource that is stored on service provider. =item X_OAUTH_CLIENT Identifier of the client that accesses to user's protected resource on beharf of the user. =item X_OAUTH_SCOPE Scope parameter that represents what kind of resources that the user grant client to access. =back =head1 AUTHOR Lyo Kato, Elyo.kato@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Lyo Kato This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; minil.toml100664001750001750 2512755342515 15155 0ustar00ritouritou000000000000OAuth-Lite2-0.11name = "OAuth-Lite2" token.psgi100664001750001750 24212755342515 16501 0ustar00ritouritou000000000000OAuth-Lite2-0.11/scriptuse strict; use warnings; use Plack::Builder; use OAuth::Lite2::Server::Endpoint::Token; builder { OAuth::Lite2::Server::Endpoint::Token->new( ); }; 00_compile.t100664001750001750 466612755342515 15606 0ustar00ritouritou000000000000OAuth-Lite2-0.11/tuse strict; use Test::More; BEGIN { # core use_ok('OAuth::Lite2'); use_ok('OAuth::Lite2::Formatters'); use_ok('OAuth::Lite2::Formatter'); use_ok('OAuth::Lite2::Formatter::JSON'); use_ok('OAuth::Lite2::Formatter::XML'); use_ok('OAuth::Lite2::Formatter::Text'); use_ok('OAuth::Lite2::Formatter::FormURLEncoded'); use_ok('OAuth::Lite2::ParamMethod'); use_ok('OAuth::Lite2::ParamMethods'); use_ok('OAuth::Lite2::ParamMethod::AuthHeader'); use_ok('OAuth::Lite2::ParamMethod::FormEncodedBody'); use_ok('OAuth::Lite2::ParamMethod::URIQueryParameter'); use_ok('OAuth::Lite2::Signer'); use_ok('OAuth::Lite2::Signer::Algorithms'); use_ok('OAuth::Lite2::Signer::Algorithm'); use_ok('OAuth::Lite2::Signer::Algorithm::HMAC_SHA1'); use_ok('OAuth::Lite2::Signer::Algorithm::HMAC_SHA256'); use_ok('OAuth::Lite2::Util'); use_ok('OAuth::Lite2::Agent'); use_ok('OAuth::Lite2::Agent::Dump'); use_ok('OAuth::Lite2::Agent::Strict'); use_ok('OAuth::Lite2::Agent::PSGIMock'); # client use_ok('OAuth::Lite2::Client::ClientCredentials'); use_ok('OAuth::Lite2::Client::Error'); use_ok('OAuth::Lite2::Client::Token'); use_ok('OAuth::Lite2::Client::TokenResponseParser'); use_ok('OAuth::Lite2::Client::WebServer'); use_ok('OAuth::Lite2::Client::UsernameAndPassword'); use_ok('OAuth::Lite2::Client::ServerState'); use_ok('OAuth::Lite2::Client::StateResponseParser'); use_ok('OAuth::Lite2::Client::ExternalService'); # model use_ok('OAuth::Lite2::Model::AccessToken'); use_ok('OAuth::Lite2::Model::AuthInfo'); use_ok('OAuth::Lite2::Model::ServerState'); # server use_ok('OAuth::Lite2::Server::Error'); use_ok('OAuth::Lite2::Server::Context'); use_ok('OAuth::Lite2::Server::DataHandler'); use_ok('OAuth::Lite2::Server::GrantHandlers'); use_ok('OAuth::Lite2::Server::GrantHandler::AuthorizationCode'); use_ok('OAuth::Lite2::Server::GrantHandler::ClientCredentials'); use_ok('OAuth::Lite2::Server::GrantHandler::GroupingRefreshToken'); use_ok('OAuth::Lite2::Server::GrantHandler::Password'); use_ok('OAuth::Lite2::Server::GrantHandler::RefreshToken'); use_ok('OAuth::Lite2::Server::GrantHandler::ServerState'); use_ok('OAuth::Lite2::Server::GrantHandler::ExternalService'); use_ok('OAuth::Lite2::Server::Endpoint::Token'); use_ok('Plack::Middleware::Auth::OAuth2::ProtectedResource'); }; done_testing; formatter.t100664001750001750 714212755342515 17162 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/010_coreuse strict; use warnings; use Test::More; use OAuth::Lite2::Formatters; use Try::Tiny; my ($json, $xml, $form, $unknown); TEST_FACTORY: { $json = OAuth::Lite2::Formatters->get_formatter_by_name("json"); isa_ok($json, "OAuth::Lite2::Formatter::JSON"); $json = OAuth::Lite2::Formatters->get_formatter_by_type("application/json"); isa_ok($json, "OAuth::Lite2::Formatter::JSON"); $json = OAuth::Lite2::Formatters->get_formatter_by_type("application/json; charset=utf-8"); isa_ok($json, "OAuth::Lite2::Formatter::JSON"); $xml = OAuth::Lite2::Formatters->get_formatter_by_name("xml"); isa_ok($xml, "OAuth::Lite2::Formatter::XML"); $xml = OAuth::Lite2::Formatters->get_formatter_by_type("application/xml"); isa_ok($xml, "OAuth::Lite2::Formatter::XML"); $form = OAuth::Lite2::Formatters->get_formatter_by_name("form"); isa_ok($form, "OAuth::Lite2::Formatter::FormURLEncoded"); $form = OAuth::Lite2::Formatters->get_formatter_by_type("application/x-www-form-urlencoded"); isa_ok($form, "OAuth::Lite2::Formatter::FormURLEncoded"); $unknown = OAuth::Lite2::Formatters->get_formatter_by_name("unknown"); ok(!$unknown); $unknown = OAuth::Lite2::Formatters->get_formatter_by_type("unknown"); ok(!$unknown); }; my $params1 = { access_token => q{foo}, refresh_token => q{bar}, access_token_secret => q{buz}, expires_in => 3600, }; TEST_JSON: { is($json->name, "json"); is($json->type, "application/json"); #is($json->format($params1), '{"expires_in":3600,"refresh_token":"bar","access_token_secret":"buz","access_token":"foo"}'); my $parsed = $json->parse('{"expires_in":3600,"refresh_token":"bar","access_token_secret":"buz","access_token":"foo"}'); is($parsed->{access_token}, q{foo}); is($parsed->{refresh_token}, q{bar}); is($parsed->{access_token_secret}, q{buz}); is($parsed->{expires_in}, 3600); my $message; try { $json->parse("invalid format"); } catch { $message = $_; }; like($message, qr/malformed JSON string/); }; TEST_XML: { is($xml->name, "xml"); is($xml->type, "application/xml"); like($xml->format($params1), qr/\A<\?xml\sversion=\"1\.0\"\sencoding=\"UTF-8\"\?>.+<\/OAuth>\z/); like($xml->format($params1), qr/3600<\/expires_in>/); like($xml->format($params1), qr/bar<\/refresh_token>/); like($xml->format($params1), qr/buz<\/access_token_secret>/); like($xml->format($params1), qr/foo<\/access_token>/); my $parsed = $xml->parse('3600barbuzfoo'); is($parsed->{access_token}, q{foo}); is($parsed->{refresh_token}, q{bar}); is($parsed->{access_token_secret}, q{buz}); is($parsed->{expires_in}, 3600); my $message; try { $xml->parse("invalid format"); } catch { $message = $_; }; like($message, qr/parser error/); }; TEST_FORM: { is($form->name, "form"); is($form->type, "application/x-www-form-urlencoded"); is($form->format($params1), 'access_token=foo&access_token_secret=buz&expires_in=3600&refresh_token=bar'); my $parsed = $form->parse('access_token=foo&access_token_secret=buz&expires_in=3600&refresh_token=bar'); is($parsed->{access_token}, q{foo}); is($parsed->{refresh_token}, q{bar}); is($parsed->{access_token_secret}, q{buz}); is($parsed->{expires_in}, 3600); }; # TODO invalid format test done_testing; param_methods.t100664001750001750 6074212755342515 20027 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/010_coreuse strict; use warnings; use Test::More; use OAuth::Lite2::ParamMethods qw(AUTH_HEADER FORM_BODY URI_QUERY); use Try::Tiny; use Plack::Request; use IO::String; my ($auth, $body, $query, $unknown); TEST_BUILDER_FACTORY: { $auth = OAuth::Lite2::ParamMethods->get_request_builder(AUTH_HEADER); isa_ok($auth, "OAuth::Lite2::ParamMethod::AuthHeader"); $body = OAuth::Lite2::ParamMethods->get_request_builder(FORM_BODY); isa_ok($body, "OAuth::Lite2::ParamMethod::FormEncodedBody"); $query = OAuth::Lite2::ParamMethods->get_request_builder(URI_QUERY); isa_ok($query, "OAuth::Lite2::ParamMethod::URIQueryParameter"); $unknown = OAuth::Lite2::ParamMethods->get_request_builder(10); ok(!$unknown); }; TEST_AUTH_HEADER: { # ============================== # GET/DELETE (no content method) # ============================== # Without OAuth Params my ($req, $p_req, $p, $token, $params); # empty token $req= $auth->build_request( url => q{http://example.org/resource}, method => q{GET}, token => "", oauth_params => {}, ); is($req->uri, q{http://example.org/resource}); is($req->header("Authorization"), q{Bearer }); is(uc $req->method, q{GET}); ok(!$req->content); $p_req = Plack::Request->new({ REQUEST_URI => $req->uri, REQUEST_METHOD => $req->method, HTTP_AUTHORIZATION => $req->header("Authorization"), }); $p = OAuth::Lite2::ParamMethods->get_param_parser($p_req); isa_ok($p, "OAuth::Lite2::ParamMethod::AuthHeader"); ok(!$p->is_legacy($p_req)); ($token, $params) = $p->parse($p_req); ok(!$token); $req= $auth->build_request( url => q{http://example.org/resource}, method => q{GET}, token => q{access_token_value}, oauth_params => {}, ); is($req->uri, q{http://example.org/resource}); is($req->header("Authorization"), q{Bearer access_token_value}); is(uc $req->method, q{GET}); ok(!$req->content); $p_req = Plack::Request->new({ REQUEST_URI => $req->uri, REQUEST_METHOD => $req->method, HTTP_AUTHORIZATION => $req->header("Authorization"), }); $p = OAuth::Lite2::ParamMethods->get_param_parser($p_req); isa_ok($p, "OAuth::Lite2::ParamMethod::AuthHeader"); ok(!$p->is_legacy($p_req)); ($token, $params) = $p->parse($p_req); is($token, "access_token_value"); # legacy request $req= $auth->build_request( url => q{http://example.org/resource}, method => q{GET}, token => "", oauth_params => {}, ); $req->header(Authorization => q{OAuth }); is($req->uri, q{http://example.org/resource}); is($req->header("Authorization"), q{OAuth }); is(uc $req->method, q{GET}); ok(!$req->content); $p_req = Plack::Request->new({ REQUEST_URI => $req->uri, REQUEST_METHOD => $req->method, HTTP_AUTHORIZATION => $req->header("Authorization"), }); $p = OAuth::Lite2::ParamMethods->get_param_parser($p_req); isa_ok($p, "OAuth::Lite2::ParamMethod::AuthHeader"); ok($p->is_legacy($p_req)); ($token, $params) = $p->parse($p_req); ok(!$token); $req->header(Authorization => q{OAuth access_token_value}); $p_req = Plack::Request->new({ REQUEST_URI => $req->uri, REQUEST_METHOD => $req->method, HTTP_AUTHORIZATION => $req->header("Authorization"), }); $p = OAuth::Lite2::ParamMethods->get_param_parser($p_req); isa_ok($p, "OAuth::Lite2::ParamMethod::AuthHeader"); ok($p->is_legacy($p_req)); ($token, $params) = $p->parse($p_req); is($token, "access_token_value"); # With OAuth Params $req = $auth->build_request( url => q{http://example.org/resource}, method => q{GET}, token => q{access_token_value}, oauth_params => { nonce => q{s8djwd}, timestamp => q{137131200}, algorithm => q{hmac-sha256}, signature => q{wOJIO9A2W5mFwDgiDvZbTSMK/PY=}, }, ); is($req->uri, q{http://example.org/resource}); is($req->header("Authorization"), q{Bearer access_token_value, algorithm="hmac-sha256", nonce="s8djwd", signature="wOJIO9A2W5mFwDgiDvZbTSMK%2FPY%3D", timestamp="137131200"}); is(uc $req->method, q{GET}); ok(!$req->content); $p_req = Plack::Request->new({ REQUEST_URI => $req->uri, REQUEST_METHOD => $req->method, HTTP_AUTHORIZATION => $req->header("Authorization"), }); $p = OAuth::Lite2::ParamMethods->get_param_parser($p_req); isa_ok($p, "OAuth::Lite2::ParamMethod::AuthHeader"); ($token, $params) = $p->parse($p_req); is($token, "access_token_value"); is($params->{nonce}, q{s8djwd}); is($params->{timestamp}, q{137131200}); is($params->{algorithm}, q{hmac-sha256}); is($params->{signature}, q{wOJIO9A2W5mFwDgiDvZbTSMK/PY=}); # With Extra Params $req = $auth->build_request( url => q{http://example.org/resource}, method => q{GET}, token => q{access_token_value}, oauth_params => {}, params => { foo => 'bar', buz => 'hoge', }, ); like($req->uri, qr/\Ahttp:\/\/example\.org\/resource\?.+\z/); is($req->header("Authorization"), q{Bearer access_token_value}); is(uc $req->method, q{GET}); ok(!$req->content); $p_req = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => $req->method, HTTP_AUTHORIZATION => $req->header("Authorization"), QUERY_STRING => q{buz=hoge&foo=bar}, }); $p = OAuth::Lite2::ParamMethods->get_param_parser($p_req); isa_ok($p, "OAuth::Lite2::ParamMethod::AuthHeader"); ($token, $params) = $p->parse($p_req); is($token, "access_token_value"); ok(!$params->{nonce}); ok(!$params->{timestamp}); ok(!$params->{algorithm}); ok(!$params->{signature}); # 'content' should be ignored $req = $auth->build_request( url => q{http://example.org/resource}, method => q{GET}, token => q{access_token_value}, oauth_params => {}, content => q{content!}, params => { foo => 'bar', buz => 'hoge', }, ); like($req->uri, qr/\Ahttp:\/\/example\.org\/resource\?.+\z/); is($req->header("Authorization"), q{Bearer access_token_value}); is(uc $req->method, q{GET}); ok(!$req->content); # ============================== # POST/PUT (content method) # ============================== # With Extra Params $req = $auth->build_request( url => q{http://example.org/resource}, method => q{POST}, token => q{access_token_value}, oauth_params => {}, params => { foo => 'bar', buz => 'hoge', }, ); is($req->uri, q{http://example.org/resource}); is($req->header("Authorization"), q{Bearer access_token_value}); is(uc $req->method, q{POST}); is($req->header("Content-Type"), q{application/x-www-form-urlencoded}); is($req->content, q{buz=hoge&foo=bar}); $p_req = Plack::Request->new({ REQUEST_URI => $req->uri, REQUEST_METHOD => $req->method, HTTP_AUTHORIZATION => $req->header("Authorization"), CONTENT_TYPE => $req->header("Content-Type"), CONTENT_LENGTH => $req->header("Content-Length"), 'psgi.input' => IO::String->new($req->content), }); $p = OAuth::Lite2::ParamMethods->get_param_parser($p_req); isa_ok($p, "OAuth::Lite2::ParamMethod::AuthHeader"); ($token, $params) = $p->parse($p_req); is($token, "access_token_value"); ok(!$params->{nonce}); ok(!$params->{timestamp}); ok(!$params->{algorithm}); ok(!$params->{signature}); # With Extra Params And Content $req = $auth->build_request( url => q{http://example.org/resource}, method => q{POST}, token => q{access_token_value}, oauth_params => {}, content => q{value}, params => { foo => 'bar', buz => 'hoge', }, ); is($req->uri, q{http://example.org/resource}); is($req->header("Authorization"), q{Bearer access_token_value}); is(uc $req->method, q{POST}); is($req->header("Content-Type"), q{application/x-www-form-urlencoded}); is($req->content, q{buz=hoge&foo=bar}); # With Extra Params, Content and Content-Type which is not form-urlencoded $req = $auth->build_request( url => q{http://example.org/resource}, method => q{POST}, token => q{access_token_value}, headers => [ 'Content-Type' => 'application/xml' ], oauth_params => {}, content => q{value}, params => { foo => 'bar', buz => 'hoge', }, ); is($req->uri, q{http://example.org/resource}); is($req->header("Authorization"), q{Bearer access_token_value}); is(uc $req->method, q{POST}); is($req->header("Content-Type"), q{application/xml}); is($req->content, q{value}); # Without both of params and content $req = $auth->build_request( url => q{http://example.org/resource}, method => q{POST}, token => q{access_token_value}, headers => [ 'Content-Type' => 'application/xml' ], oauth_params => {}, ); is($req->uri, q{http://example.org/resource}); is($req->header("Authorization"), q{Bearer access_token_value}); is(uc $req->method, q{POST}); is($req->header("Content-Type"), q{application/xml}); is($req->content, q{}); # my $p_req = Plack::Request->new; # my ($token, $params) = $auth->parse($p_req); # parse Basic Authorization Header $p_req = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, HTTP_AUTHORIZATION => q{}, QUERY_STRING => q{buz=hoge&foo=bar}, }); my $basic_clientcredentials = $auth->basic_credentials( $p_req ); is($basic_clientcredentials->{client_id}, q{}); is($basic_clientcredentials->{client_secret}, q{}); $p_req = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, HTTP_AUTHORIZATION => q{ }, QUERY_STRING => q{buz=hoge&foo=bar}, }); $basic_clientcredentials = $auth->basic_credentials( $p_req ); is($basic_clientcredentials->{client_id}, q{}); is($basic_clientcredentials->{client_secret}, q{}); $p_req = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, HTTP_AUTHORIZATION => q{Invalid}, QUERY_STRING => q{buz=hoge&foo=bar}, }); $basic_clientcredentials = $auth->basic_credentials( $p_req ); is($basic_clientcredentials->{client_id}, q{}); is($basic_clientcredentials->{client_secret}, q{}); $p_req = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, HTTP_AUTHORIZATION => q{Basic}, QUERY_STRING => q{buz=hoge&foo=bar}, }); $basic_clientcredentials = $auth->basic_credentials( $p_req ); is($basic_clientcredentials->{client_id}, q{}); is($basic_clientcredentials->{client_secret}, q{}); $p_req = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, HTTP_AUTHORIZATION => q{Basic }, QUERY_STRING => q{buz=hoge&foo=bar}, }); $basic_clientcredentials = $auth->basic_credentials( $p_req ); is($basic_clientcredentials->{client_id}, q{}); is($basic_clientcredentials->{client_secret}, q{}); $p_req = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, HTTP_AUTHORIZATION => q{Basic invalid}, QUERY_STRING => q{buz=hoge&foo=bar}, }); $basic_clientcredentials = $auth->basic_credentials( $p_req ); is($basic_clientcredentials->{client_id}, q{}); is($basic_clientcredentials->{client_secret}, q{}); $p_req = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, HTTP_AUTHORIZATION => q{Basic aG9nZTpmdWdh}, QUERY_STRING => q{buz=hoge&foo=bar}, }); $basic_clientcredentials = $auth->basic_credentials( $p_req ); is($basic_clientcredentials->{client_id}, q{hoge}); is($basic_clientcredentials->{client_secret}, q{fuga}); $p_req = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, HTTP_AUTHORIZATION => q{Basic aG9nZTpmdWdh }, QUERY_STRING => q{buz=hoge&foo=bar}, }); $basic_clientcredentials = $auth->basic_credentials( $p_req ); is($basic_clientcredentials->{client_id}, q{hoge}); is($basic_clientcredentials->{client_secret}, q{fuga}); }; TEST_FORM_BODY: { # ============================== # GET/DELETE (no content method) # ============================== # GET throws error my ($req, $p_req, $p, $token, $params); my $error = try { $body->build_request( url => q{http://example.org/resource}, method => q{GET}, token => q{access_token_value}, oauth_params => {}, ); return undef; } catch { return $_; }; like($error, qr/FormEncodedBody/); # DELETE throws error $error = try { $body->build_request( url => q{http://example.org/resource}, method => q{DELETE}, token => q{access_token_value}, oauth_params => {}, ); return undef; } catch { return $_; }; like($error, qr/FormEncodedBody/); # invalid content-type throws error $error = try { $body->build_request( url => q{http://example.org/resource}, method => q{POST}, token => q{access_token_value}, oauth_params => {}, headers => [ "Content-Type" => "application/xml" ], content => q{value}, ); return undef; } catch { return $_; }; like($error, qr/FormEncodedBody/); # Content should be ignored $req = $body->build_request( url => q{http://example.org/resource}, method => q{POST}, token => q{access_token_value}, oauth_params => {}, content => q{value}, params => { foo => 'bar', buz => 'hoge' }, ); is($req->uri, q{http://example.org/resource}); ok(!$req->header("Authorization")); is(uc $req->method, q{POST}); is($req->header("Content-Type"), q{application/x-www-form-urlencoded}); is($req->content, q{access_token=access_token_value&buz=hoge&foo=bar}); $p_req = Plack::Request->new({ REQUEST_URI => $req->uri, REQUEST_METHOD => $req->method, CONTENT_TYPE => $req->header("Content-Type"), CONTENT_LENGTH => $req->header("Content-Length"), 'psgi.input' => IO::String->new($req->content), }); $p = OAuth::Lite2::ParamMethods->get_param_parser($p_req); isa_ok($p, "OAuth::Lite2::ParamMethod::FormEncodedBody"); ok(!$p->is_legacy($p_req)); ($token, $params) = $p->parse($p_req); is($token, "access_token_value"); ok(!$params->{nonce}); ok(!$params->{timestamp}); ok(!$params->{algorithm}); ok(!$params->{signature}); # legacy request $req->content(q{oauth_token=access_token_value&buz=hoge&foo=bar}); $p_req = Plack::Request->new({ REQUEST_URI => $req->uri, REQUEST_METHOD => $req->method, CONTENT_TYPE => $req->header("Content-Type"), CONTENT_LENGTH => $req->header("Content-Length") - 1, 'psgi.input' => IO::String->new($req->content), }); $p = OAuth::Lite2::ParamMethods->get_param_parser($p_req); isa_ok($p, "OAuth::Lite2::ParamMethod::FormEncodedBody"); ok($p->is_legacy($p_req)); ($token, $params) = $p->parse($p_req); is($token, "access_token_value"); # With OAuth Params $req = $body->build_request( url => q{http://example.org/resource}, method => q{POST}, token => q{access_token_value}, oauth_params => { nonce => q{s8djwd}, timestamp => q{137131200}, algorithm => q{hmac-sha256}, signature => q{wOJIO9A2W5mFwDgiDvZbTSMK/PY=}, }, content => q{value}, params => { foo => 'bar', buz => 'hoge' }, ); is($req->uri, q{http://example.org/resource}); ok(!$req->header("Authorization")); is(uc $req->method, q{POST}); is($req->header("Content-Type"), q{application/x-www-form-urlencoded}); is($req->content, q{access_token=access_token_value&algorithm=hmac-sha256&buz=hoge&foo=bar&nonce=s8djwd&signature=wOJIO9A2W5mFwDgiDvZbTSMK%2FPY%3D×tamp=137131200}); $p_req = Plack::Request->new({ REQUEST_URI => $req->uri, REQUEST_METHOD => $req->method, CONTENT_TYPE => $req->header("Content-Type"), CONTENT_LENGTH => $req->header("Content-Length"), 'psgi.input' => IO::String->new($req->content), }); $p = OAuth::Lite2::ParamMethods->get_param_parser($p_req); isa_ok($p, "OAuth::Lite2::ParamMethod::FormEncodedBody"); ($token, $params) = $p->parse($p_req); is($token, "access_token_value"); is($params->{nonce}, q{s8djwd}); is($params->{timestamp}, q{137131200}); is($params->{algorithm}, q{hmac-sha256}); is($params->{signature}, q{wOJIO9A2W5mFwDgiDvZbTSMK/PY=}); }; TEST_URI_QUERY: { my ($req, $p_req, $p, $token, $params); # ============================== # GET/DELETE (no content method) # ============================== # Without OAuth Params $req = $query->build_request( url => q{http://example.org/resource}, method => q{GET}, token => q{access_token_value}, oauth_params => {}, ); is($req->uri, q{http://example.org/resource?access_token=access_token_value}); ok(!$req->header("Authorization")); is(uc $req->method, q{GET}); ok(!$req->content); $p_req = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => $req->method, QUERY_STRING => q{access_token=access_token_value}, #CONTENT_TYPE => $req->header("Content-Type"), #CONTENT_LENGTH => $req->header("Content-Length"), #'psgi.input' => IO::String->new($req->content), }); $p = OAuth::Lite2::ParamMethods->get_param_parser($p_req); isa_ok($p, "OAuth::Lite2::ParamMethod::URIQueryParameter"); ok(!$p->is_legacy($p_req)); ($token, $params) = $p->parse($p_req); is($token, "access_token_value"); ok(!$params->{nonce}); ok(!$params->{timestamp}); ok(!$params->{algorithm}); ok(!$params->{signature}); # legacy request $p_req = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, QUERY_STRING => q{oauth_token=access_token_value}, #CONTENT_TYPE => $req->header("Content-Type"), #CONTENT_LENGTH => $req->header("Content-Length"), #'psgi.input' => IO::String->new($req->content), }); $p = OAuth::Lite2::ParamMethods->get_param_parser($p_req); isa_ok($p, "OAuth::Lite2::ParamMethod::URIQueryParameter"); ok($p->is_legacy($p_req)); ($token, $params) = $p->parse($p_req); is($token, "access_token_value"); # With OAuth Params $req = $query->build_request( url => q{http://example.org/resource}, method => q{GET}, token => q{access_token_value}, oauth_params => { nonce => q{s8djwd}, timestamp => q{137131200}, algorithm => q{hmac-sha256}, signature => q{wOJIO9A2W5mFwDgiDvZbTSMK/PY=}, }, ); is($req->uri, q{http://example.org/resource?access_token=access_token_value&algorithm=hmac-sha256&nonce=s8djwd&signature=wOJIO9A2W5mFwDgiDvZbTSMK%2FPY%3D×tamp=137131200}); ok(!$req->header("Authorization")); is(uc $req->method, q{GET}); ok(!$req->content); # With Extra Params $req = $query->build_request( url => q{http://example.org/resource}, method => q{GET}, token => q{access_token_value}, oauth_params => {}, params => { foo => 'bar', buz => 'hoge', }, ); is($req->uri, q{http://example.org/resource?access_token=access_token_value&buz=hoge&foo=bar}); ok(!$req->header("Authorization")); is(uc $req->method, q{GET}); ok(!$req->content); # With Both Extra Params And OAuth Params $req = $query->build_request( url => q{http://example.org/resource}, method => q{GET}, token => q{access_token_value}, oauth_params => { nonce => q{s8djwd}, timestamp => q{137131200}, algorithm => q{hmac-sha256}, signature => q{wOJIO9A2W5mFwDgiDvZbTSMK/PY=}, }, params => { foo => 'bar', buz => 'hoge', }, ); is($req->uri, q{http://example.org/resource?access_token=access_token_value&algorithm=hmac-sha256&buz=hoge&foo=bar&nonce=s8djwd&signature=wOJIO9A2W5mFwDgiDvZbTSMK%2FPY%3D×tamp=137131200}); ok(!$req->header("Authorization")); is(uc $req->method, q{GET}); ok(!$req->content); # Post Body Without OAuth Params $req = $query->build_request( url => q{http://example.org/resource}, method => q{POST}, token => q{access_token_value}, oauth_params => {}, params => { foo => 'bar', buz => 'hoge', }, ); is($req->uri, q{http://example.org/resource?access_token=access_token_value}); ok(!$req->header("Authorization")); is(uc $req->method, q{POST}); is($req->header("Content-Type"), q{application/x-www-form-urlencoded}); is($req->content, q{buz=hoge&foo=bar}); # Post Body With OAuth Params $req = $query->build_request( url => q{http://example.org/resource}, method => q{POST}, token => q{access_token_value}, oauth_params => { nonce => q{s8djwd}, timestamp => q{137131200}, algorithm => q{hmac-sha256}, signature => q{wOJIO9A2W5mFwDgiDvZbTSMK/PY=}, }, params => { foo => 'bar', buz => 'hoge', }, ); is($req->uri, q{http://example.org/resource?access_token=access_token_value&algorithm=hmac-sha256&nonce=s8djwd&signature=wOJIO9A2W5mFwDgiDvZbTSMK%2FPY%3D×tamp=137131200}); ok(!$req->header("Authorization")); is(uc $req->method, q{POST}); is($req->header("Content-Type"), q{application/x-www-form-urlencoded}); is($req->content, q{buz=hoge&foo=bar}); # Post Body With OAuth Params $req = $query->build_request( url => q{http://example.org/resource}, method => q{POST}, token => q{access_token_value}, oauth_params => { nonce => q{s8djwd}, timestamp => q{137131200}, algorithm => q{hmac-sha256}, signature => q{wOJIO9A2W5mFwDgiDvZbTSMK/PY=}, }, headers => [ "Content-Type" => "application/xml" ], content => q{value}, params => { foo => 'bar', buz => 'hoge', }, ); is($req->uri, q{http://example.org/resource?access_token=access_token_value&algorithm=hmac-sha256&nonce=s8djwd&signature=wOJIO9A2W5mFwDgiDvZbTSMK%2FPY%3D×tamp=137131200}); ok(!$req->header("Authorization")); is(uc $req->method, q{POST}); is($req->header("Content-Type"), q{application/xml}); is($req->content, q{value}); }; done_testing; signer.t100664001750001750 342112755342515 16442 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/010_coreuse strict; use warnings; use Test::More tests => 9; use OAuth::Lite2::Signer; my $access_token_secret = "hoge"; my $signed_params = OAuth::Lite2::Signer->sign({ secret => $access_token_secret, algorithm => q{hmac-sha256}, method => q{get}, url => q{http://example.com/resource}, debug_nonce => q{s8djwd}, debug_timestamp => q{137131200}, }); #is($signed_params->{signature}, q{wOJIO9A2W5mFwDgiDvZbTSMK/PY=}); is($signed_params->{signature}, q{TJvmJLtkrnh94j1IotnLX4hybtkgu+leKM7H7tetu98=}); is($signed_params->{nonce}, q{s8djwd}); is($signed_params->{timestamp}, q{137131200}); is($signed_params->{algorithm}, q{hmac-sha256}); ok(OAuth::Lite2::Signer->verify({ secret => $access_token_secret, algorithm => q{hmac-sha256}, method => q{get}, url => q{http://example.com/resource}, nonce => q{s8djwd}, timestamp => q{137131200}, signature => q{TJvmJLtkrnh94j1IotnLX4hybtkgu+leKM7H7tetu98=}, }), "correct signature"); ok(!OAuth::Lite2::Signer->verify({ secret => $access_token_secret, algorithm => q{hmac-sha256}, method => q{get}, url => q{http://example.com/resource}, nonce => q{s8djwd}, timestamp => q{137131200}, signature => q{wOJIO9A2W5mFwDgiDvZbTSMK/PY=}, }), "incorrect signature"); $signed_params = OAuth::Lite2::Signer->sign({ secret => $access_token_secret, algorithm => q{hmac-sha256}, method => q{get}, url => q{http://example.com/resource}, }); like($signed_params->{nonce}, qr/^[a-zA-Z0-9]+$/); like($signed_params->{timestamp}, qr/^\d+$/); is($signed_params->{algorithm}, q{hmac-sha256}); util.t100664001750001750 236312755342515 16134 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/010_coreuse strict; use warnings; use Test::More tests => 11; use OAuth::Lite2::Util qw( encode_param decode_param parse_content build_content ); use Hash::MultiValue; TEST_ENCODE: { my $param = q{123 @#$%&hoge hoge+._-~}; my $encoded = encode_param($param); is($encoded, q{123%20%40%23%24%25%26hoge%20hoge%2B._-~}); my $decoded = decode_param($encoded); is($decoded, $param); }; TEST_PARSE_CONTENT: { my $content = q{aaa=bbb&bbb=ccc&ddd=eee&aaa=ddd}; my $params = parse_content($content); is($params->{bbb}, 'ccc'); is($params->get('bbb'), 'ccc'); ok(!$params->get('fff')); is($params->get('aaa'), 'ddd'); my @aaa = $params->get_all('aaa'); is(scalar @aaa, 2); is($aaa[0], 'bbb'); is($aaa[1], 'ddd'); }; TEST_BUILD_CONTENT: { my $params = { aaa => 'bbb', bbb => 'ccc', ccc => 'ddd', ddd => ['eee', 'fff'], }; my $content = build_content($params); is($content, 'aaa=bbb&bbb=ccc&ccc=ddd&ddd=eee&ddd=fff'); $params = Hash::MultiValue->new( aaa => 'bbb', bbb => 'ccc', ccc => 'ddd', ddd => 'eee', ddd => 'fff', ); $content = build_content($params); is($content, 'aaa=bbb&bbb=ccc&ccc=ddd&ddd=eee&ddd=fff'); }; middleware.t100664001750001750 3407212755342515 23576 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/030_server/protected_resourceuse strict; use warnings; use Test::More tests => 96; use lib 't/lib'; use TestPR; use TestDataHandler; use Try::Tiny; use HTTP::Response; use HTTP::Request; use HTTP::Message::PSGI; TestDataHandler->clear; TestDataHandler->add_client(id => q{foo}, secret => q{secret_value}); TestDataHandler->add_client(id => q{bar}, secret => q{secret_value}); TestDataHandler->add_client(id => q{malformed}, secret => q{secret_value}); my $dh = TestDataHandler->new; my $auth_info = $dh->create_or_update_auth_info( client_id => q{foo}, user_id => q{1}, scope => q{email}, code => q{code_bar}, redirect_uri => q{http://example.org/callback}, ); my $access_token = $dh->create_or_update_access_token( auth_info => $auth_info, ); my $auth_info2 = $dh->create_or_update_auth_info( client_id => q{bar}, user_id => q{1}, scope => q{email}, code => q{code_bar}, redirect_uri => q{http://example.org/callback}, ); my $access_token2 = $dh->create_or_update_access_token( auth_info => $auth_info2, expires_in => 1, ); my $auth_info3 = $dh->create_or_update_auth_info( client_id => q{malformed}, user_id => q{1}, scope => q{email}, code => q{code_bar}, redirect_uri => q{http://example.org/callback}, ); my $access_token3 = $dh->create_or_update_access_token( auth_info => $auth_info3, ); my $auth_info4 = $dh->create_or_update_auth_info( client_id => q{foo}, user_id => q{666}, scope => q{email}, code => q{code_bar}, redirect_uri => q{http://example.org/callback}, ); my $access_token4 = $dh->create_or_update_access_token( auth_info => $auth_info4, ); my $app = TestPR->new; sub request { my $req = shift; my $res = try { HTTP::Response->from_psgi($app->($req->to_psgi)); } catch { HTTP::Response->from_psgi([500, ["Content-Type" => "text/plain"], [ $_ ]]); }; return $res; } my ($req, $res); $req = HTTP::Request->new("GET" => q{http://example.org/}); $req->header("Authorization" => q{OAuth}); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 400, 'invalid access token'); is($res->header("WWW-Authenticate"), q{OAuth realm="resource.example.org", error="invalid_request"}, 'invalid request'); $req = HTTP::Request->new("GET" => q{http://example.org/}); $req->header("Authorization" => q{OAuth }); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 400, 'invalid access token'); is($res->header("WWW-Authenticate"), q{OAuth realm="resource.example.org", error="invalid_request"}, 'invalid request'); $req = HTTP::Request->new("GET" => q{http://example.org/}); $req->header("Authorization" => sprintf(q{OAuth %s}, 'invalid_access_token')); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'invalid access token'); is($res->header("WWW-Authenticate"), q{OAuth realm="resource.example.org", error="invalid_token"}, 'invalid access token'); $req = HTTP::Request->new("POST" => q{http://example.org/}); $req->content_type('application/x-www-form-urlencoded'); $req->content(sprintf(q{oauth_token=%s}, 'invalid_access_token')); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'invalid access token'); is($res->header("WWW-Authenticate"), q{OAuth realm="resource.example.org", error="invalid_token"}, 'invalid access token'); $req = HTTP::Request->new("GET" => sprintf(q{http://example.org/?oauth_token=%s}, 'invalid_access_token')); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'invalid access token'); is($res->header("WWW-Authenticate"), q{OAuth realm="resource.example.org", error="invalid_token"}, 'invalid access token'); sleep 2; $req = HTTP::Request->new("GET" => q{http://example.org/}); $req->header("Authorization" => sprintf(q{OAuth %s}, $access_token2->token)); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'expired access token'); is($res->header("WWW-Authenticate"), q{OAuth realm="resource.example.org", error="expired_token"}, 'expired token'); $req = HTTP::Request->new("POST" => q{http://example.org/}); $req->content_type('application/x-www-form-urlencoded'); $req->content(sprintf(q{oauth_token=%s}, $access_token2->token)); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'expired access token'); is($res->header("WWW-Authenticate"), q{OAuth realm="resource.example.org", error="expired_token"}, 'expired token'); $req = HTTP::Request->new("GET" => sprintf(q{http://example.org/?oauth_token=%s}, $access_token2->token)); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'expired access token'); is($res->header("WWW-Authenticate"), q{OAuth realm="resource.example.org", error="expired_token"}, 'expired token'); $req = HTTP::Request->new("GET" => q{http://example.org/}); $req->header("Authorization" => sprintf(q{OAuth %s}, $access_token3->token)); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'invalid client'); is($res->header("WWW-Authenticate"), q{OAuth realm="resource.example.org", error="invalid_token"}, 'invalid client'); $req = HTTP::Request->new("POST" => q{http://example.org/}); $req->content_type('application/x-www-form-urlencoded'); $req->content(sprintf(q{oauth_token=%s}, $access_token3->token)); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'invalid client'); is($res->header("WWW-Authenticate"), q{OAuth realm="resource.example.org", error="invalid_token"}, 'invalid client'); $req = HTTP::Request->new("GET" => sprintf(q{http://example.org/?oauth_token=%s}, $access_token3->token)); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'invalid client'); is($res->header("WWW-Authenticate"), q{OAuth realm="resource.example.org", error="invalid_token"}, 'invalid client'); $req = HTTP::Request->new("GET" => q{http://example.org/}); $req->header("Authorization" => sprintf(q{OAuth %s}, $access_token4->token)); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'invalid client'); is($res->header("WWW-Authenticate"), q{OAuth realm="resource.example.org", error="invalid_token"}, 'invalid client'); $req = HTTP::Request->new("POST" => q{http://example.org/}); $req->content_type('application/x-www-form-urlencoded'); $req->content(sprintf(q{oauth_token=%s}, $access_token4->token)); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'invalid client'); is($res->header("WWW-Authenticate"), q{OAuth realm="resource.example.org", error="invalid_token"}, 'invalid client'); $req = HTTP::Request->new("GET" => sprintf(q{http://example.org/?oauth_token=%s}, $access_token4->token)); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'invalid client'); is($res->header("WWW-Authenticate"), q{OAuth realm="resource.example.org", error="invalid_token"}, 'invalid client'); $req = HTTP::Request->new("GET" => q{http://example.org/}); $req->header("Authorization" => sprintf(q{OAuth %s}, $access_token->token)); $res = &request($req); ok($res->is_success, 'request should not fail'); is($res->content, q{{user: '1', scope: 'email', is_legacy: '1'}}, 'successful response'); $req = HTTP::Request->new("POST" => q{http://example.org/}); $req->content_type('application/x-www-form-urlencoded'); $req->content(sprintf(q{oauth_token=%s}, $access_token->token)); $res = &request($req); ok($res->is_success, 'request should not fail'); is($res->content, q{{user: '1', scope: 'email', is_legacy: '1'}}, 'successful response'); $req = HTTP::Request->new("GET" => sprintf(q{http://example.org/?oauth_token=%s}, $access_token->token)); $res = &request($req); ok($res->is_success, 'request should not fail'); is($res->content, q{{user: '1', scope: 'email', is_legacy: '1'}}, 'successful response'); # RFC 6749 $req = HTTP::Request->new("GET" => q{http://example.org/}); $req->header("Authorization" => q{Bearer}); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 400, 'invalid request'); is($res->header("WWW-Authenticate"), q{Bearer realm="resource.example.org", error="invalid_request"}, 'invalid request'); $req = HTTP::Request->new("GET" => q{http://example.org/}); $req->header("Authorization" => q{Bearer }); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 400, 'invalid request'); is($res->header("WWW-Authenticate"), q{Bearer realm="resource.example.org", error="invalid_request"}, 'invalid request'); $req = HTTP::Request->new("GET" => q{http://example.org/}); $req->header("Authorization" => sprintf(q{Bearer %s}, 'invalid_access_token')); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'invalid access token'); is($res->header("WWW-Authenticate"), q{Bearer realm="resource.example.org", error="invalid_token"}, 'invalid access token'); $req = HTTP::Request->new("POST" => q{http://example.org/}); $req->content_type('application/x-www-form-urlencoded'); $req->content(sprintf(q{access_token=%s}, 'invalid_access_token')); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'invalid access token'); is($res->header("WWW-Authenticate"), q{Bearer realm="resource.example.org", error="invalid_token"}, 'invalid access token'); $req = HTTP::Request->new("GET" => sprintf(q{http://example.org/?access_token=%s}, 'invalid_access_token')); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'invalid access token'); is($res->header("WWW-Authenticate"), q{Bearer realm="resource.example.org", error="invalid_token"}, 'invalid access token'); sleep 2; $req = HTTP::Request->new("GET" => q{http://example.org/}); $req->header("Authorization" => sprintf(q{Bearer %s}, $access_token2->token)); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'expired access token'); is($res->header("WWW-Authenticate"), q{Bearer realm="resource.example.org", error="invalid_token", error_description="The access token expired"}, 'expired token'); $req = HTTP::Request->new("POST" => q{http://example.org/}); $req->content_type('application/x-www-form-urlencoded'); $req->content(sprintf(q{access_token=%s}, $access_token2->token)); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'expired access token'); is($res->header("WWW-Authenticate"), q{Bearer realm="resource.example.org", error="invalid_token", error_description="The access token expired"}, 'expired token'); $req = HTTP::Request->new("GET" => sprintf(q{http://example.org/?access_token=%s}, $access_token2->token)); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'expired access token'); is($res->header("WWW-Authenticate"), q{Bearer realm="resource.example.org", error="invalid_token", error_description="The access token expired"}, 'expired token'); $req = HTTP::Request->new("GET" => q{http://example.org/}); $req->header("Authorization" => sprintf(q{Bearer %s}, $access_token3->token)); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'invalid client'); is($res->header("WWW-Authenticate"), q{Bearer realm="resource.example.org", error="invalid_token"}, 'invalid client'); $req = HTTP::Request->new("POST" => q{http://example.org/}); $req->content_type('application/x-www-form-urlencoded'); $req->content(sprintf(q{access_token=%s}, $access_token3->token)); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'invalid client'); is($res->header("WWW-Authenticate"), q{Bearer realm="resource.example.org", error="invalid_token"}, 'invalid client'); $req = HTTP::Request->new("GET" => sprintf(q{http://example.org/?access_token=%s}, $access_token3->token)); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'invalid client'); is($res->header("WWW-Authenticate"), q{Bearer realm="resource.example.org", error="invalid_token"}, 'invalid client'); $req = HTTP::Request->new("GET" => q{http://example.org/}); $req->header("Authorization" => sprintf(q{Bearer %s}, $access_token4->token)); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'invalid client'); is($res->header("WWW-Authenticate"), q{Bearer realm="resource.example.org", error="invalid_token"}, 'invalid client'); $req = HTTP::Request->new("POST" => q{http://example.org/}); $req->content_type('application/x-www-form-urlencoded'); $req->content(sprintf(q{access_token=%s}, $access_token4->token)); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'invalid client'); is($res->header("WWW-Authenticate"), q{Bearer realm="resource.example.org", error="invalid_token"}, 'invalid client'); $req = HTTP::Request->new("GET" => sprintf(q{http://example.org/?access_token=%s}, $access_token4->token)); $res = &request($req); ok(!$res->is_success, 'request should fail'); is($res->code, 401, 'invalid client'); is($res->header("WWW-Authenticate"), q{Bearer realm="resource.example.org", error="invalid_token"}, 'invalid client'); $req = HTTP::Request->new("GET" => q{http://example.org/}); $req->header("Authorization" => sprintf(q{Bearer %s}, $access_token->token)); $res = &request($req); ok($res->is_success, 'request should not fail'); is($res->content, q{{user: '1', scope: 'email', is_legacy: '0'}}, 'successful response'); $req = HTTP::Request->new("POST" => q{http://example.org/}); $req->content_type('application/x-www-form-urlencoded'); $req->content(sprintf(q{access_token=%s}, $access_token->token)); $res = &request($req); ok($res->is_success, 'request should not fail'); is($res->content, q{{user: '1', scope: 'email', is_legacy: '0'}}, 'successful response'); $req = HTTP::Request->new("GET" => sprintf(q{http://example.org/?access_token=%s}, $access_token->token)); $res = &request($req); ok($res->is_success, 'request should not fail'); is($res->content, q{{user: '1', scope: 'email', is_legacy: '0'}}, 'successful response'); authorization_code.t100664001750001750 1254312755342515 24472 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/030_server/token_endpointuse strict; use warnings; use lib 't/lib'; use Test::More; use Plack::Request; use Try::Tiny; use TestDataHandler; use OAuth::Lite2::Server::GrantHandler::AuthorizationCode; use OAuth::Lite2::Util qw(build_content); TestDataHandler->clear; TestDataHandler->add_client(id => q{foo}, secret => q{secret_value}); my $dh = TestDataHandler->new; my $auth_info = $dh->create_or_update_auth_info( client_id => q{foo}, user_id => q{1}, scope => q{email}, code => q{code_bar}, redirect_uri => q{http://example.org/callback}, ); is($auth_info->refresh_token, "refresh_token_0"); my $action = OAuth::Lite2::Server::GrantHandler::AuthorizationCode->new; sub test_success { my $params = shift; my $expected = shift; my $request = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, QUERY_STRING => build_content($params), }); my $dh = TestDataHandler->new(request => $request); my $res; try { $res = $action->handle_request($dh); } catch { my $error_message = ($_->isa("OAuth::Lite2::Error")) ? $_->type : $_; }; if(exists $expected->{token}) { is($res->{token_type}, $expected->{token_type}); is($res->{access_token}, $expected->{token}); } else { ok(!$res->{access_token}); } if(exists $expected->{secret}) { is($res->{access_token_secret}, $expected->{secret}); } else { ok(!$res->{access_token_secret}); } if(exists $expected->{expires_in}) { is($res->{expires_in}, $expected->{expires_in}); } else { ok(!$res->{expires_in}); } if(exists $expected->{refresh_token}) { is($res->{refresh_token}, $expected->{refresh_token}); } else { ok(!$res->{refresh_token}); } if(exists $expected->{secret_type}) { is($res->{secret_type}, $expected->{secret_type}); } else { ok(!$res->{secret_type}); } } sub test_error { my $params = shift; my $message = shift; my $request = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, QUERY_STRING => build_content($params), }); my $dh = TestDataHandler->new(request => $request); my $error_message; try { my $res = $action->handle_request($dh); } catch { $error_message = ($_->isa("OAuth::Lite2::Error")) ? $_->type : $_; }; like($error_message, qr/$message/); } # no code &test_error({ client_id => q{foo}, redirect_uri => q{http://example.org/callback}, client_secret => q{secret_value}, }, q{invalid_request}); # no redirect_uri &test_error({ client_id => q{foo}, code => q{bar}, client_secret => q{secret_value}, }, q{invalid_request}); # invalid client_id &test_error({ client_id => q{unknown}, code => q{code_bar}, client_secret => q{secret_value}, redirect_uri => q{http://example.org/callback}, }, q{invalid_client}); # invalid code &test_error({ client_id => q{foo}, code => q{code_invalid}, client_secret => q{secret_value}, redirect_uri => q{http://example.org/callback}, }, q{invalid_grant}); # url mismatch &test_error({ client_id => q{foo}, code => q{code_bar}, client_secret => q{secret_value}, redirect_uri => q{http://example.org/unknown}, }, q{redirect_uri_mismatch}); # without secret type &test_success({ client_id => q{foo}, code => q{code_bar}, client_secret => q{secret_value}, redirect_uri => q{http://example.org/callback}, }, { token_type => q{Bearer}, token => q{access_token_0}, expires_in => q{3600}, refresh_token => q{refresh_token_0}, }); # use server_state $auth_info = $dh->create_or_update_auth_info( client_id => q{foo}, user_id => q{1}, scope => q{email}, code => q{code_bar_2}, redirect_uri => q{http://example.org/callback}, server_state => q{server_state_bar}, ); # missing server_state &test_error({ client_id => q{foo}, code => q{code_bar_2}, client_secret => q{secret_value}, redirect_uri => q{http://example.org/callback}, }, q{invalid_server_state}); # invalid server_state &test_error({ client_id => q{foo}, code => q{code_bar_2}, client_secret => q{secret_value}, redirect_uri => q{http://example.org/callback}, server_state => q{server_state_foo}, }, q{invalid_server_state}); &test_success({ client_id => q{foo}, code => q{code_bar_2}, client_secret => q{secret_value}, redirect_uri => q{http://example.org/callback}, server_state => q{server_state_bar}, }, { token_type => q{Bearer}, token => q{access_token_1}, expires_in => q{3600}, refresh_token => q{refresh_token_1}, }); $auth_info = $dh->create_or_update_auth_info( client_id => q{foo}, user_id => q{1}, scope => q{email}, code => q{code_bar_3}, redirect_uri => q{http://example.org/callback}, ); &test_error({ client_id => q{foo}, code => q{code_bar_3}, client_secret => q{secret_value}, redirect_uri => q{http://example.org/callback}, server_state => q{server_state_foo}, }, q{invalid_server_state}); done_testing; client_credentials.t100664001750001750 615212755342515 24412 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/030_server/token_endpointuse strict; use warnings; use lib 't/lib'; use Test::More tests => 13; use Plack::Request; use Try::Tiny; use TestDataHandler; use OAuth::Lite2::Server::GrantHandler::ClientCredentials; use OAuth::Lite2::Util qw(build_content); TestDataHandler->clear; TestDataHandler->add_client(id => q{foo}, secret => q{bar}, user_id => 1); TestDataHandler->add_client(id => q{buz}, secret => q{hoge}, user_id => 0); my $dh = TestDataHandler->new; my $auth_info = $dh->create_or_update_auth_info( client_id => q{foo}, user_id => q{1}, scope => q{email}, ); my $auth_info2 = $dh->create_or_update_auth_info( client_id => q{buz}, user_id => q{0}, scope => q{email}, ); is($auth_info->refresh_token, "refresh_token_0"); is($auth_info2->refresh_token, "refresh_token_1"); my $action = OAuth::Lite2::Server::GrantHandler::ClientCredentials->new; sub test_success { my $params = shift; my $expected = shift; my $request = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, QUERY_STRING => build_content($params), }); my $dh = TestDataHandler->new(request => $request); my $res; try { $res = $action->handle_request($dh); } catch { my $error_message = ($_->isa("OAuth::Lite2::Error")) ? $_->type : $_; }; if(exists $expected->{token}) { is($res->{token_type}, $expected->{token_type}); is($res->{access_token}, $expected->{token}); } else { ok(!$res->{access_token}); } if(exists $expected->{secret}) { is($res->{access_token_secret}, $expected->{secret}); } else { ok(!$res->{access_token_secret}); } if(exists $expected->{expires_in}) { is($res->{expires_in}, $expected->{expires_in}); } else { ok(!$res->{expires_in}); } if(exists $expected->{refresh_token}) { is($res->{refresh_token}, $expected->{refresh_token}); } else { ok(!$res->{refresh_token}); } } sub test_error { my $params = shift; my $message = shift; my $request = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, QUERY_STRING => build_content($params), }); my $dh = TestDataHandler->new(request => $request); my $error_message; try { my $res = $action->handle_request($dh); } catch { $error_message = ($_->isa("OAuth::Lite2::Error")) ? $_->type : $_; }; like($error_message, qr/$message/); } &test_success({ client_id => q{foo}, client_secret => q{bar}, }, { token_type => q{Bearer}, token => q{access_token_0}, expires_in => q{3600}, refresh_token => q{refresh_token_2}, }); # work as expected when user_id is 1 &test_success({ client_id => q{buz}, client_secret => q{hoge}, }, { token_type => q{Bearer}, token => q{access_token_1}, expires_in => q{3600}, refresh_token => q{refresh_token_3}, }); &test_error({ client_id => q{unknown}, client_secret => q{bar}, }, q/invalid_client/); external_service.t100664001750001750 1137212755342515 24141 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/030_server/token_endpointuse strict; use warnings; use lib 't/lib'; use Test::More; use Plack::Request; use Try::Tiny; use TestDataHandler; use OAuth::Lite2::Server::GrantHandler::ExternalService; use OAuth::Lite2::Util qw(build_content); TestDataHandler->clear; TestDataHandler->add_client(id => q{foo}, secret => q{bar}); TestDataHandler->add_ext_account(assertion => q{assertion_1}, id => q{user_1}, client_id => q{foo}); TestDataHandler->add_ext_account(assertion => q{assertion_2}, id => q{user_1}, client_id => q{foo_2}); TestDataHandler->add_ext_account(assertion => q{assertion_3}, id => q{user_1}, client_id => q{foo}, type => q{type_3}); TestDataHandler->add_ext_account(assertion => q{assertion_4}, id => q{user_1}, client_id => q{foo}, iss => q{iss_4}); TestDataHandler->add_ext_account(assertion => q{assertion_5}, id => q{user_1}, client_id => q{foo}, aud => q{aud_5}); my $dh = TestDataHandler->new; my $auth_info = $dh->create_or_update_auth_info( client_id => q{foo}, user_id => q{1}, scope => q{email}, ); is($auth_info->refresh_token, "refresh_token_0"); my $action = OAuth::Lite2::Server::GrantHandler::ExternalService->new; sub test_success { my $params = shift; my $expected = shift; my $request = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, QUERY_STRING => build_content($params), }); my $dh = TestDataHandler->new(request => $request); my $res; try { $res = $action->handle_request($dh); } catch { my $error_message = ($_->isa("OAuth::Lite2::Error")) ? $_->type : $_; }; if(exists $expected->{token}) { is($res->{token_type}, $expected->{token_type}); is($res->{access_token}, $expected->{token}); } else { ok(!$res->{access_token}); } if(exists $expected->{secret}) { is($res->{access_token_secret}, $expected->{secret}); } else { ok(!$res->{access_token_secret}); } if(exists $expected->{expires_in}) { is($res->{expires_in}, $expected->{expires_in}); } else { ok(!$res->{expires_in}); } if(exists $expected->{refresh_token}) { is($res->{refresh_token}, $expected->{refresh_token}); } else { ok(!$res->{refresh_token}); } } sub test_error { my $params = shift; my $message = shift; my $request = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, QUERY_STRING => build_content($params), }); my $dh = TestDataHandler->new(request => $request); my $error_message; try { my $res = $action->handle_request($dh); } catch { $error_message = ($_->isa("OAuth::Lite2::Error")) ? $_->type : $_; }; like($error_message, qr/$message/); } # no assertion &test_error({ client_id => q{foo}, client_secret => q{bar}, }, q{invalid_request}); # invalid assertion &test_error({ client_id => q{foo}, client_secret => q{bar}, assertion => q{assertion_invalid}, }, q{invalid_grant}); # client_id mismatch &test_error({ client_id => q{foo}, client_secret => q{bar}, assertion => q{assertion_2}, }, q{invalid_grant}); # invalid type &test_error({ client_id => q{foo}, client_secret => q{bar}, assertion => q{assertion_3}, }, q{invalid_grant}); # invalid iss &test_error({ client_id => q{foo}, client_secret => q{bar}, assertion => q{assertion_4}, }, q{invalid_grant}); # invalid aud &test_error({ client_id => q{foo}, client_secret => q{bar}, assertion => q{assertion_5}, }, q{invalid_grant}); &test_success({ client_id => q{foo}, client_secret => q{bar}, assertion => q{assertion_1}, }, { token_type => q{Bearer}, token => q{access_token_0}, expires_in => q{3600}, refresh_token => q{refresh_token_1}, }); &test_success({ client_id => q{foo}, client_secret => q{bar}, assertion => q{assertion_3}, type => q{type_3}, }, { token_type => q{Bearer}, token => q{access_token_1}, expires_in => q{3600}, refresh_token => q{refresh_token_2}, }); &test_success({ client_id => q{foo}, client_secret => q{bar}, assertion => q{assertion_4}, iss => q{iss_4}, }, { token_type => q{Bearer}, token => q{access_token_2}, expires_in => q{3600}, refresh_token => q{refresh_token_3}, }); &test_success({ client_id => q{foo}, client_secret => q{bar}, assertion => q{assertion_5}, aud => q{aud_5}, }, { token_type => q{Bearer}, token => q{access_token_3}, expires_in => q{3600}, refresh_token => q{refresh_token_4}, }); done_testing(); grouping_refresh_token.t100664001750001750 1036212755342515 25345 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/030_server/token_endpointuse strict; use warnings; use lib 't/lib'; use Test::More tests => 7; use Plack::Request; use Try::Tiny; use TestDataHandler; use OAuth::Lite2::Server::GrantHandler::GroupingRefreshToken; use OAuth::Lite2::Util qw(build_content); TestDataHandler->clear; # authorized client TestDataHandler->add_client( id => q{authzed_client}, secret => q{authzed_client_secret}, user_id => 1, group_id => 1 , ); TestDataHandler->add_client( id => q{authzed_client_2}, secret => q{authzed_client_secret_2}, user_id => 1, ); # not authorized client TestDataHandler->add_client( id => q{not_authzed_client}, secret => q{not_authzed_client_secret}, user_id => 1, group_id => 1 ); TestDataHandler->add_client( id => q{not_authzed_client_for_no_group}, secret => q{not_authzed_client_secret}, user_id => 1, ); TestDataHandler->add_client( id => q{not_authzed_client_for_another_group}, secret => q{not_authzed_client_secret}, user_id => 1, group_id => 2 ); my $dh = TestDataHandler->new; my $action = OAuth::Lite2::Server::GrantHandler::GroupingRefreshToken->new; sub test_success { my $params = shift; my $expected = shift; my $request = Plack::Request->new({ REQUEST_URI => q{http://example.org/token}, REQUEST_METHOD => q{POST}, QUERY_STRING => build_content($params), }); my $dh = TestDataHandler->new(request => $request); my $res; try { $res = $action->handle_request($dh); } catch { my $error_message = ($_->isa("OAuth::Lite2::Error")) ? $_->type : $_; }; is($res->{refresh_token}, $expected->{refresh_token}); } sub test_error { my $params = shift; my $message = shift; my $request = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, QUERY_STRING => build_content($params), }); my $dh = TestDataHandler->new(request => $request); my $error_message; try { my $res = $action->handle_request($dh); } catch { $error_message = ($_->isa("OAuth::Lite2::Error")) ? $_->type : $_; }; is($error_message, $message->{message}); } my $auth_info = $dh->create_or_update_auth_info( client_id => q{authzed_client}, user_id => q{1}, ); &test_success({ client_id => q{not_authzed_client}, client_secret => q{not_authzed_client_secret}, refresh_token => $auth_info->refresh_token, scope => q{grouping_scope}, }, { refresh_token => q{refresh_token_1}, }); &test_error({ client_id => q{not_authzed_client}, client_secret => q{not_authzed_client_secret}, },{ message => q{invalid_request: 'refresh_token' not found}, }); &test_error({ client_id => q{not_authzed_client}, client_secret => q{not_authzed_client_secret}, refresh_token => q{invalid_refresh_token}, },{ message => q{invalid_grant: 'refresh_token' is invalid}, }); my $auth_info_2 = $dh->create_or_update_auth_info( client_id => q{authzed_client_2}, user_id => q{1}, ); &test_error({ client_id => q{not_authzed_client}, client_secret => q{not_authzed_client_secret}, refresh_token => $auth_info_2->refresh_token, },{ message => q{invalid_grant: 'refresh_token' does not have group id}, }); &test_error({ client_id => q{not_authzed_client_for_no_group}, client_secret => q{not_authzed_client_secret}, refresh_token => $auth_info->refresh_token, },{ message => q{invalid_client: 'client_id' does not have group id}, }); &test_error({ client_id => q{not_authzed_client_for_another_group}, client_secret => q{not_authzed_client_secret}, refresh_token => $auth_info->refresh_token, },{ message => q{invalid_request: group id does not match}, }); &test_error({ client_id => q{not_authzed_client}, client_secret => q{not_authzed_client_secret}, refresh_token => $auth_info->refresh_token, scope => q{invalid_scope}, },{ message => q{invalid_scope: }, }); password.t100664001750001750 710312755342515 22416 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/030_server/token_endpointuse strict; use warnings; use lib 't/lib'; use Test::More tests => 11; use Plack::Request; use Try::Tiny; use TestDataHandler; use OAuth::Lite2::Server::GrantHandler::Password; use OAuth::Lite2::Util qw(build_content); TestDataHandler->clear; TestDataHandler->add_client(id => q{foo}, secret => q{bar}); TestDataHandler->add_user(username => q{user_1}, password => q{pass_1}); my $dh = TestDataHandler->new; my $auth_info = $dh->create_or_update_auth_info( client_id => q{foo}, user_id => q{1}, scope => q{email}, ); is($auth_info->refresh_token, "refresh_token_0"); my $action = OAuth::Lite2::Server::GrantHandler::Password->new; sub test_success { my $params = shift; my $expected = shift; my $request = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, QUERY_STRING => build_content($params), }); my $dh = TestDataHandler->new(request => $request); my $res; try { $res = $action->handle_request($dh); } catch { my $error_message = ($_->isa("OAuth::Lite2::Error")) ? $_->type : $_; }; if(exists $expected->{token}) { is($res->{token_type}, $expected->{token_type}); is($res->{access_token}, $expected->{token}); } else { ok(!$res->{access_token}); } if(exists $expected->{secret}) { is($res->{access_token_secret}, $expected->{secret}); } else { ok(!$res->{access_token_secret}); } if(exists $expected->{expires_in}) { is($res->{expires_in}, $expected->{expires_in}); } else { ok(!$res->{expires_in}); } if(exists $expected->{refresh_token}) { is($res->{refresh_token}, $expected->{refresh_token}); } else { ok(!$res->{refresh_token}); } if(exists $expected->{secret_type}) { is($res->{secret_type}, $expected->{secret_type}); } else { ok(!$res->{secret_type}); } } sub test_error { my $params = shift; my $message = shift; my $request = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, QUERY_STRING => build_content($params), }); my $dh = TestDataHandler->new(request => $request); my $error_message; try { my $res = $action->handle_request($dh); } catch { $error_message = ($_->isa("OAuth::Lite2::Error")) ? $_->type : $_; }; like($error_message, qr/$message/); } # no username &test_error({ client_id => q{foo}, client_secret => q{bar}, password => q{pass_1}, }, q{invalid_request}); # no password &test_error({ client_id => q{foo}, client_secret => q{bar}, username => q{user_1}, }, q{invalid_request}); # invalid client_id #&test_error({ # client_id => q{unknown}, # client_secret => q{bar}, # username => q{user_1}, # password => q{pass_1}, #}, q{invalid-client-id}); # invalid username &test_error({ client_id => q{foo}, client_secret => q{bar}, username => q{unknown}, password => q{pass_1}, }, q{invalid_grant}); # invalid password &test_error({ client_id => q{foo}, client_secret => q{bar}, username => q{user_1}, password => q{unknown}, }, q{invalid_grant}); &test_success({ client_id => q{foo}, client_secret => q{bar}, username => q{user_1}, password => q{pass_1}, }, { token_type => q{Bearer}, token => q{access_token_0}, expires_in => q{3600}, refresh_token => q{refresh_token_1}, }); refresh.t100664001750001750 616612755342515 22222 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/030_server/token_endpointuse strict; use warnings; use lib 't/lib'; use Test::More tests => 10; use Plack::Request; use Try::Tiny; use TestDataHandler; use OAuth::Lite2::Server::GrantHandler::RefreshToken; use OAuth::Lite2::Util qw(build_content); TestDataHandler->clear; TestDataHandler->add_client(id => q{foo}, secret => q{bar}); my $dh = TestDataHandler->new; my $auth_info = $dh->create_or_update_auth_info( client_id => q{foo}, user_id => q{1}, scope => q{email}, ); is($auth_info->refresh_token, "refresh_token_0"); my $action = OAuth::Lite2::Server::GrantHandler::RefreshToken->new; sub test_success { my $params = shift; my $expected = shift; my $request = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, QUERY_STRING => build_content($params), }); my $dh = TestDataHandler->new(request => $request); my $res; try { $res = $action->handle_request($dh); } catch { my $error_message = ($_->isa("OAuth::Lite2::Error")) ? $_->type : $_; }; if(exists $expected->{token}) { is($res->{token_type}, $expected->{token_type}); is($res->{access_token}, $expected->{token}); } else { ok(!$res->{access_token}); } if(exists $expected->{secret}) { is($res->{access_token_secret}, $expected->{secret}); } else { ok(!$res->{access_token_secret}); } if(exists $expected->{expires_in}) { is($res->{expires_in}, $expected->{expires_in}); } else { ok(!$res->{expires_in}); } if(exists $expected->{refresh_token}) { is($res->{refresh_token}, $expected->{refresh_token}); } else { ok(!$res->{refresh_token}); } if(exists $expected->{secret_type}) { is($res->{secret_type}, $expected->{secret_type}); } else { ok(!$res->{secret_type}); } } sub test_error { my $params = shift; my $message = shift; my $request = Plack::Request->new({ REQUEST_URI => q{http://example.org/resource}, REQUEST_METHOD => q{GET}, QUERY_STRING => build_content($params), }); my $dh = TestDataHandler->new(request => $request); my $error_message; try { my $res = $action->handle_request($dh); } catch { $error_message = ($_->isa("OAuth::Lite2::Error")) ? $_->type : $_; }; like($error_message, qr/$message/); } # no refresh_token &test_error({ client_id => q{foo}, client_secret => q{bar}, }, q{invalid_request}); # invalid client_id &test_error({ client_id => q{unknown}, client_secret => q{bar}, refresh_token => $auth_info->refresh_token, }, q{invalid_client}); # invalid refresh token &test_error({ client_id => q{foo}, client_secret => q{bar}, refresh_token => q{invalid}, }, q{invalid_grant}); # without secret type &test_success({ client_id => q{foo}, client_secret => q{bar}, refresh_token => $auth_info->refresh_token, }, { token_type => q{Bearer}, token => q{access_token_0}, expires_in => q{3600}, refresh_token => q{refresh_token_0}, }); server_state.t100664001750001750 203312755342515 23257 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/030_server/token_endpointuse strict; use warnings; use lib 't/lib'; use Test::More; use Plack::Request; use Try::Tiny; use TestDataHandler; use OAuth::Lite2::Server::GrantHandler::ServerState; use OAuth::Lite2::Util qw(build_content); my $dh = TestDataHandler->new; my $action = OAuth::Lite2::Server::GrantHandler::ServerState->new; sub test_success { my $params = shift; my $expected = shift; my $request = Plack::Request->new({ REQUEST_URI => q{http://example.org/token}, REQUEST_METHOD => q{GET}, QUERY_STRING => build_content($params), }); my $dh = TestDataHandler->new(request => $request); my $res; try { $res = $action->handle_request($dh); } catch { my $error_message = ($_->isa("OAuth::Lite2::Error")) ? $_->type : $_; }; is($res->{server_state}, $expected->{server_state}); is($res->{expires_in}, $expected->{expires_in}); } &test_success({ client_id => q{foo}, }, { server_state => q{server_state_0}, expires_in => q{3600}, }); done_testing; client_credentials.t100664001750001750 461512755342515 21046 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/040_unituse strict; use warnings; use lib 't/lib'; use Test::More tests => 28; use TestDataHandler; use OAuth::Lite2::Server::Endpoint::Token; use OAuth::Lite2::Agent::PSGIMock; use OAuth::Lite2::Client::ClientCredentials; TestDataHandler->clear; TestDataHandler->add_client(id => q{foo}, secret => q{bar}, user_id => q{100}); TestDataHandler->add_user(username => q{buz}, password => q{hoge}); my $dh = TestDataHandler->new; my $app = OAuth::Lite2::Server::Endpoint::Token->new( data_handler => "TestDataHandler", ); $app->support_grant_types(qw(client_credentials refresh_token)); my $agent = OAuth::Lite2::Agent::PSGIMock->new(app => $app); my $client = OAuth::Lite2::Client::ClientCredentials->new( id => q{foo}, secret => q{bar}, access_token_uri => q{http://localhost/access_token}, agent => $agent, ); my $res; $res = $client->get_access_token(); ok($res, q{response should be not undef}); is($res->access_token, q{access_token_0}); is($res->refresh_token, q{refresh_token_0}); is($res->expires_in, q{3600}); ok(!$res->access_token_secret); ok(!$res->scope); $res = $client->get_access_token(use_basic_schema => 1); ok($res, q{response should be not undef}); is($res->access_token, q{access_token_1}); is($res->refresh_token, q{refresh_token_1}); is($res->expires_in, q{3600}); ok(!$res->access_token_secret); ok(!$res->scope); $res = $client->refresh_access_token( refresh_token => q{invalid_refresh_token}, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{refresh-token should be invalid}); $res = $client->refresh_access_token( refresh_token => q{invalid_refresh_token}, use_basic_schema => 1, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{refresh-token should be invalid}); $res = $client->refresh_access_token( refresh_token => q{refresh_token_0}, ); ok($res, q{response should be not undef}); is($res->access_token, q{access_token_2}); is($res->refresh_token, q{refresh_token_0}); is($res->expires_in, q{3600}); ok(!$res->access_token_secret); ok(!$res->scope); $res = $client->refresh_access_token( refresh_token => q{refresh_token_0}, use_basic_schema => 1, ); ok($res, q{response should be not undef}); is($res->access_token, q{access_token_3}); is($res->refresh_token, q{refresh_token_0}); is($res->expires_in, q{3600}); ok(!$res->access_token_secret); ok(!$res->scope); common.t100664001750001750 1011112755342515 16507 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/040_unituse strict; use warnings; use lib 't/lib'; use Test::More tests => 16; use TestDataHandler; use OAuth::Lite2::Server::Endpoint::Token; use OAuth::Lite2::Agent::PSGIMock; use OAuth::Lite2::Client::WebServer; use OAuth::Lite2::Client::UsernameAndPassword; TestDataHandler->clear(); TestDataHandler->add_client(id => q{foo}, secret => q{bar}); TestDataHandler->add_client(id => q{aaa}, secret => q{bbb}); TestDataHandler->add_user(username => q{buz}, password => q{hoge}); my $dh = TestDataHandler->new; # set authorization-fixture-data instead of user interaction my $auth_info = $dh->create_or_update_auth_info( client_id => q{foo}, user_id => q{buz}, scope => q{email}, redirect_uri => q{http://example.org/callback}, code => q{valid_code}, ); my $app = OAuth::Lite2::Server::Endpoint::Token->new( data_handler => "TestDataHandler", ); $app->support_grant_types(qw(authorization_code)); my $agent = OAuth::Lite2::Agent::PSGIMock->new(app => $app); my $invalid_client1 = OAuth::Lite2::Client::UsernameAndPassword->new( id => q{foo}, secret => q{bar}, access_token_uri => q{http://localhost/access_token}, agent => $agent, ); my $res; $res = $invalid_client1->get_access_token( username => q{buz}, password => q{hoge}, ); ok(!$res, q{response should be undef}); is($invalid_client1->errstr, q{unsupported_grant_type}, q{tried to use unsupported grant-type}); $res = $invalid_client1->get_access_token( username => q{buz}, password => q{hoge}, use_basic_schema => 1, ); ok(!$res, q{response should be undef}); is($invalid_client1->errstr, q{unsupported_grant_type}, q{tried to use unsupported grant-type}); my $invalid_client2 = OAuth::Lite2::Client::WebServer->new( id => q{invalid}, secret => q{bar}, authorize_uri => q{http://localhost/authorize}, access_token_uri => q{http://localhost/access_token}, agent => $agent, ); $res = $invalid_client2->get_access_token( code => q{buz}, redirect_uri => q{http://example.org/callback}, ); ok(!$res, q{response should be undef}); is($invalid_client2->errstr, q{invalid_client}, q{invalid client_id}); $res = $invalid_client2->get_access_token( code => q{buz}, redirect_uri => q{http://example.org/callback}, use_basic_schema => 1, ); ok(!$res, q{response should be undef}); is($invalid_client2->errstr, q{invalid_client}, q{invalid client_id}); my $invalid_client3 = OAuth::Lite2::Client::WebServer->new( id => q{foo}, secret => q{invalid}, authorize_uri => q{http://localhost/authorize}, access_token_uri => q{http://localhost/access_token}, agent => $agent, ); $res = $invalid_client3->get_access_token( code => q{buz}, redirect_uri => q{http://example.org/callback}, ); ok(!$res, q{response should be undef}); is($invalid_client3->errstr, q{invalid_client}, q{invalid client_secret}); $res = $invalid_client3->get_access_token( code => q{buz}, redirect_uri => q{http://example.org/callback}, use_basic_schema => 1, ); ok(!$res, q{response should be undef}); is($invalid_client3->errstr, q{invalid_client}, q{invalid client_secret}); my $invalid_client4 = OAuth::Lite2::Client::WebServer->new( id => q{aaa}, secret => q{bbb}, authorize_uri => q{http://localhost/authorize}, access_token_uri => q{http://localhost/access_token}, agent => $agent, ); $res = $invalid_client4->get_access_token( code => q{buz}, redirect_uri => q{http://example.org/callback}, ); ok(!$res, q{response should be undef}); is($invalid_client4->errstr, q{invalid_client}, q{This client isn't allowed to use this grant-type}); $res = $invalid_client4->get_access_token( code => q{buz}, redirect_uri => q{http://example.org/callback}, use_basic_schema => 1, ); ok(!$res, q{response should be undef}); is($invalid_client4->errstr, q{invalid_client}, q{This client isn't allowed to use this grant-type}); external_service.t100664001750001750 750612755342515 20557 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/040_unituse strict; use warnings; use lib 't/lib'; use Test::More; use TestDataHandler; use OAuth::Lite2::Server::Endpoint::Token; use OAuth::Lite2::Agent::PSGIMock; use OAuth::Lite2::Client::ExternalService; TestDataHandler->clear; TestDataHandler->add_client(id => q{foo}, secret => q{bar}); TestDataHandler->add_ext_account(assertion => q{assertion_1}, id => q{user_1}, client_id => q{foo}); TestDataHandler->add_ext_account(assertion => q{assertion_2}, id => q{user_1}, client_id => q{foo_2}); TestDataHandler->add_ext_account(assertion => q{assertion_3}, id => q{user_1}, client_id => q{foo}, type => q{type_3}); TestDataHandler->add_ext_account(assertion => q{assertion_4}, id => q{user_1}, client_id => q{foo}, iss => q{iss_4}); TestDataHandler->add_ext_account(assertion => q{assertion_5}, id => q{user_1}, client_id => q{foo}, aud => q{aud_5}); my $dh = TestDataHandler->new; my $app = OAuth::Lite2::Server::Endpoint::Token->new( data_handler => "TestDataHandler", ); $app->support_grant_types(qw( external_service refresh_token)); my $agent = OAuth::Lite2::Agent::PSGIMock->new(app => $app); my $client = OAuth::Lite2::Client::ExternalService->new( id => q{foo}, secret => q{bar}, access_token_uri => q{http://localhost/access_token}, agent => $agent, ); my $res; $res = $client->get_access_token( assertion => q{assertion_0}, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{assertion should be invalid}); $res = $client->get_access_token( assertion => q{assertion_2}, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{assertion should be invalid}); $res = $client->get_access_token( assertion => q{assertion_3}, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{assertion should be invalid}); $res = $client->get_access_token( assertion => q{assertion_3}, type => q{type_0}, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{assertion should be invalid}); $res = $client->get_access_token( assertion => q{assertion_4}, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{assertion should be invalid}); $res = $client->get_access_token( assertion => q{assertion_4}, iss => q{iss_0}, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{assertion should be invalid}); $res = $client->get_access_token( assertion => q{assertion_5}, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{assertion should be invalid}); $res = $client->get_access_token( assertion => q{assertion_5}, iss => q{aud_0}, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{assertion should be invalid}); # success $res = $client->get_access_token( assertion => q{assertion_1}, ); ok($res, q{response should be not undef}); is($res->access_token, q{access_token_0}); is($res->refresh_token, q{refresh_token_0}); is($res->expires_in, q{3600}); $res = $client->get_access_token( assertion => q{assertion_3}, type => q{type_3}, ); ok($res, q{response should be not undef}); is($res->access_token, q{access_token_1}); is($res->refresh_token, q{refresh_token_1}); is($res->expires_in, q{3600}); $res = $client->get_access_token( assertion => q{assertion_4}, iss => q{iss_4}, ); ok($res, q{response should be not undef}); is($res->access_token, q{access_token_2}); is($res->refresh_token, q{refresh_token_2}); is($res->expires_in, q{3600}); $res = $client->get_access_token( assertion => q{assertion_5}, aud => q{aud_5}, ); ok($res, q{response should be not undef}); is($res->access_token, q{access_token_3}); is($res->refresh_token, q{refresh_token_3}); is($res->expires_in, q{3600}); done_testing(); grouping_refresh_token.t100664001750001750 421712755342515 21761 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/040_unituse strict; use warnings; use lib 't/lib'; use Test::More tests => 8; use TestDataHandler; use OAuth::Lite2::Server::Endpoint::Token; use OAuth::Lite2::Agent::PSGIMock; use OAuth::Lite2::Client::ClientCredentials; TestDataHandler->clear; TestDataHandler->add_client(id => q{foo}, secret => q{bar}, user_id => q{100}, group_id => 1); TestDataHandler->add_client(id => q{foo_2}, secret => q{bar_2}, group_id => 1); TestDataHandler->add_user(username => q{buz}, password => q{hoge}); my $dh = TestDataHandler->new; my $app = OAuth::Lite2::Server::Endpoint::Token->new( data_handler => "TestDataHandler", ); $app->support_grant_types(qw(client_credentials grouping_refresh_token)); my $agent = OAuth::Lite2::Agent::PSGIMock->new(app => $app); my $client = OAuth::Lite2::Client::ClientCredentials->new( id => q{foo}, secret => q{bar}, access_token_uri => q{http://localhost/access_token}, agent => $agent, ); # obtain refresh token my $res = $client->get_access_token( scope => q{grouping_scope} ); ok($res, q{response should be not undef}); is($res->refresh_token, q{refresh_token_0}); my $refresh_token = $res->refresh_token; my $client_2 = OAuth::Lite2::Client::ClientCredentials->new( id => q{foo_2}, secret => q{bar_2}, access_token_uri => q{http://localhost/access_token}, agent => $agent, ); # success $res = $client_2->get_grouping_refresh_token( refresh_token => $refresh_token, scope => q{grouping_scope}, ); ok($res, q{response should be not undef}); is($res->refresh_token, q{refresh_token_1}); $res = $client_2->get_grouping_refresh_token( refresh_token => $refresh_token, scope => q{grouping_scope}, use_basic_schema => 1, ); ok($res, q{response should be not undef}); is($res->refresh_token, q{refresh_token_2}); # failed $res = $client->get_grouping_refresh_token( refresh_token => q{invalid}, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}); access_token.t100664001750001750 54112755342515 20726 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/040_unit/modeluse strict; use warnings; use Test::More tests => 3; use lib 't/lib'; use TestAccessToken; # auth_id token # expires_in, created_on, secret secret_type my $token1 = TestAccessToken->new( auth_id => q{foo}, token => q{bar}, extra => q{buz}, ); is($token1->auth_id, q{foo}); is($token1->token, q{bar}); is($token1->extra, q{buz}); auth_info.t100664001750001750 145412755342515 20265 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/040_unit/modeluse strict; use warnings; use Test::More; use lib 't/lib'; use TestAuthInfo; # id user_id client_id # scope refresh_token code redirect_uri server_state # extra my $info1 = TestAuthInfo->new( id => q{foo}, user_id => q{bar}, client_id => q{buz}, scope => q{scope}, refresh_token => q{r_t}, code => q{code}, redirect_uri => q{r_uri}, server_state => q{s_state}, extra => q{hoge}, ); is($info1->id, q{foo}); is($info1->user_id, q{bar}); is($info1->client_id, q{buz}); is($info1->scope, q{scope}); is($info1->refresh_token, q{r_t}); is($info1->code, q{code}); is($info1->redirect_uri, q{r_uri}); is($info1->server_state, q{s_state}); is($info1->extra, q{hoge}); done_testing; server_state.t100664001750001750 60112755342515 20770 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/040_unit/modeluse strict; use warnings; use Test::More; use lib 't/lib'; use TestServerState; my $state1 = TestServerState->new( client_id => q{cid_str}, server_state => q{ss_str}, expires_in => 900, extra => q{ext}, ); is($state1->client_id, q{cid_str}); is($state1->server_state, q{ss_str}); is($state1->expires_in, 900); is($state1->extra, q{ext}); done_testing error.t100664001750001750 463312755342515 17652 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/040_unit/serveruse strict; use warnings; use Test::More; use OAuth::Lite2::Server::Error; sub assert_server_error { my $params = shift; my $CLASS_NAME = "OAuth::Lite2::Server::Error::$params->{name}"; my $error = $CLASS_NAME->new; ok($error); is($error->code, $params->{code}, "code for $CLASS_NAME"); }; my @defined_errors = ( { q{name} => q{InvalidRequest}, q{code} => 400, q{type} => q{invalid_request}, }, { q{name} => q{InvalidClient}, q{code} => 401, q{type} => q{invalid_client}, }, { q{name} => q{UnauthorizedClient}, q{code} => 401, q{type} => q{unauthorized_client}, }, { q{name} => q{RedirectURIMismatch}, q{code} => 401, q{type} => q{redirect_uri_mismatch}, }, { q{name} => q{AccessDenied}, q{code} => 401, q{type} => q{access_denied}, }, { q{name} => q{UnsupportedResponseType}, q{code} => 400, q{type} => q{unsupported_response_type}, }, { q{name} => q{UnsupportedResourceType}, q{code} => 400, q{type} => q{unsupported_resource_type}, }, { q{name} => q{InvalidGrant}, q{code} => 401, q{type} => q{invalid_grant}, }, { q{name} => q{UnsupportedGrantType}, q{code} => 400, q{type} => q{unsupported_grant_type}, }, { q{name} => q{InvalidScope}, q{code} => 401, q{type} => q{invalid_scope}, }, { q{name} => q{InvalidToken}, q{code} => 401, q{type} => q{invalid_token}, }, { q{name} => q{ExpiredTokenLegacy}, q{code} => 401, q{type} => q{expired_token}, }, { q{name} => q{ExpiredToken}, q{code} => 401, q{type} => q{invalid_token}, }, { q{name} => q{InsufficientScope}, q{code} => 401, q{type} => q{insufficient_scope}, }, { q{name} => q{InvalidServerState}, q{code} => 401, q{type} => q{invalid_server_state}, }, { q{name} => q{TemporarilyUnavailable}, q{code} => 503, q{type} => q{temporarily_unavailable}, }, { q{name} => q{ServerError}, q{code} => 500, q{type} => q{server_error}, }, ); foreach my $defined_error (@defined_errors) { assert_server_error($defined_error); } done_testing(); grant_handler.t100664001750001750 67412755342515 21312 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/040_unit/serveruse strict; use warnings; use Test::More; use OAuth::Lite2::Server::GrantHandler; use lib 't/lib'; use TestDataHandler; my $handler = OAuth::Lite2::Server::GrantHandler->new; ok( $handler, q{new}); ok( $handler->is_required_client_authentication, q{client_authentication}); my $dh = TestDataHandler->new; eval { $handler->handle_request( $dh ); }; my $error = $@; like( $error, qr/abstract method/, q{handle_request}); done_testing; username.t100664001750001750 644412755342515 17034 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/040_unituse strict; use warnings; use lib 't/lib'; use Test::More tests => 36; use TestDataHandler; use OAuth::Lite2::Server::Endpoint::Token; use OAuth::Lite2::Agent::PSGIMock; use OAuth::Lite2::Client::UsernameAndPassword; TestDataHandler->clear; TestDataHandler->add_client(id => q{foo}, secret => q{bar}); TestDataHandler->add_user(username => q{buz}, password => q{hoge}); my $dh = TestDataHandler->new; my $app = OAuth::Lite2::Server::Endpoint::Token->new( data_handler => "TestDataHandler", ); $app->support_grant_types(qw(password refresh_token)); my $agent = OAuth::Lite2::Agent::PSGIMock->new(app => $app); my $client = OAuth::Lite2::Client::UsernameAndPassword->new( id => q{foo}, secret => q{bar}, access_token_uri => q{http://localhost/access_token}, agent => $agent, ); my $res; $res = $client->get_access_token( username => q{invalid}, password => q{hoge}, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{user should be invalid}); $res = $client->get_access_token( username => q{invalid}, password => q{hoge}, use_basic_schema => 1, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{user should be invalid}); $res = $client->get_access_token( username => q{buz}, password => q{invalid}, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{user should be invalid}); $res = $client->get_access_token( username => q{buz}, password => q{invalid}, use_basic_schema => 1, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{user should be invalid}); $res = $client->get_access_token( username => q{buz}, password => q{hoge}, ); ok($res, q{response should be not undef}); is($res->access_token, q{access_token_0}); is($res->refresh_token, q{refresh_token_0}); is($res->expires_in, q{3600}); ok(!$res->access_token_secret); ok(!$res->scope); $res = $client->get_access_token( username => q{buz}, password => q{hoge}, use_basic_schema => 1, ); ok($res, q{response should be not undef}); is($res->access_token, q{access_token_1}); is($res->refresh_token, q{refresh_token_1}); is($res->expires_in, q{3600}); ok(!$res->access_token_secret); ok(!$res->scope); $res = $client->refresh_access_token( refresh_token => q{invalid_refresh_token}, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{refresh-token should be invalid}); $res = $client->refresh_access_token( refresh_token => q{invalid_refresh_token}, use_basic_schema => 1, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{refresh-token should be invalid}); $res = $client->refresh_access_token( refresh_token => q{refresh_token_0}, ); ok($res, q{response should be not undef}); is($res->access_token, q{access_token_2}); is($res->refresh_token, q{refresh_token_0}); is($res->expires_in, q{3600}); ok(!$res->access_token_secret); ok(!$res->scope); $res = $client->refresh_access_token( refresh_token => q{refresh_token_0}, use_basic_schema => 1, ); ok($res, q{response should be not undef}); is($res->access_token, q{access_token_3}); is($res->refresh_token, q{refresh_token_0}); is($res->expires_in, q{3600}); ok(!$res->access_token_secret); ok(!$res->scope); web_server.t100664001750001750 1310312755342515 17366 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/040_unituse strict; use warnings; use lib 't/lib'; use Test::More; use TestDataHandler; use OAuth::Lite2::Server::Endpoint::Token; use OAuth::Lite2::Agent::PSGIMock; use OAuth::Lite2::Client::WebServer; TestDataHandler->clear(); TestDataHandler->add_client(id => q{foo}, secret => q{bar}); TestDataHandler->add_user(username => q{buz}, password => q{hoge}); my $dh = TestDataHandler->new; # set authorization-fixture-data instead of user interaction my $auth_info = $dh->create_or_update_auth_info( client_id => q{foo}, user_id => q{buz}, scope => q{email}, redirect_uri => q{http://example.org/callback}, code => q{valid_code}, ); my $app = OAuth::Lite2::Server::Endpoint::Token->new( data_handler => "TestDataHandler", ); $app->support_grant_types(qw(authorization_code refresh_token server_state)); my $agent = OAuth::Lite2::Agent::PSGIMock->new(app => $app); my $client = OAuth::Lite2::Client::WebServer->new( id => q{foo}, secret => q{bar}, authorize_uri => q{http://localhost/authorize}, access_token_uri => q{http://localhost/access_token}, agent => $agent, ); my $res; $res = $client->get_access_token( code => q{invalid_code}, redirect_uri => q{http://example.org/callback}, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{verification code should be invalid}); $res = $client->get_access_token( code => q{invalid_code}, redirect_uri => q{http://example.org/callback}, use_basic_schema => 1, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{verification code should be invalid}); $res = $client->get_access_token( code => q{valid_code}, redirect_uri => q{http://invalid.example.org/callback}, ); ok(!$res, q{response should be undef}); is($client->errstr, q{redirect_uri_mismatch}, q{redirect_uri should be invalid}); $res = $client->get_access_token( code => q{valid_code}, redirect_uri => q{http://invalid.example.org/callback}, use_basic_schema => 1, ); ok(!$res, q{response should be undef}); is($client->errstr, q{redirect_uri_mismatch}, q{redirect_uri should be invalid}); $res = $client->get_access_token( code => q{valid_code}, redirect_uri => q{http://example.org/callback}, ); ok($res, q{response should be not undef}); is($res->access_token, q{access_token_0}); is($res->refresh_token, q{refresh_token_0}); is($res->expires_in, q{3600}); ok(!$res->access_token_secret); is($res->scope, q{email}); $res = $client->get_access_token( code => q{valid_code}, redirect_uri => q{http://example.org/callback}, use_basic_schema => 1, ); ok($res, q{response should be not undef}); is($res->access_token, q{access_token_1}); is($res->refresh_token, q{refresh_token_0}); is($res->expires_in, q{3600}); ok(!$res->access_token_secret); is($res->scope, q{email}); # use Authorization Header flag for Basic Client Authentication #$res = $client->get_access_token( # code => q{valid_code}, # redirect_uri => q{http://example.org/callback}, # use_basic_schema => 1 #); #ok($res, q{response should be not undef}); #is($res->access_token, q{access_token_0}); #is($res->refresh_token, q{refresh_token_0}); #is($res->expires_in, q{3600}); #is($res->scope, q{email}); $res = $client->refresh_access_token( refresh_token => q{invalid_refresh_token}, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{refresh_token should be invalid-grant}); $res = $client->refresh_access_token( refresh_token => q{invalid_refresh_token}, use_basic_schema => 1, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_grant}, q{refresh_token should be invalid-grant}); $res = $client->refresh_access_token( refresh_token => q{refresh_token_0}, ); ok($res, q{response should be not undef}); is($res->access_token, q{access_token_2}); is($res->refresh_token, q{refresh_token_0}); is($res->expires_in, q{3600}); ok(!$res->access_token_secret); is($res->scope, q{email}); $res = $client->refresh_access_token( refresh_token => q{refresh_token_0}, use_basic_schema => 1, ); ok($res, q{response should be not undef}); is($res->access_token, q{access_token_3}); is($res->refresh_token, q{refresh_token_0}); is($res->expires_in, q{3600}); ok(!$res->access_token_secret); is($res->scope, q{email}); # use server_state my $state = $client->get_server_state; $auth_info = $dh->create_or_update_auth_info( client_id => q{foo}, user_id => q{buz}, scope => q{email}, redirect_uri => q{http://example.org/callback}, code => q{valid_code_2}, server_state => $state->server_state, ); ## no server_state $res = $client->get_access_token( code => q{valid_code_2}, redirect_uri => q{http://example.org/callback}, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_server_state}, q{server_state should be invalid}); $res = $client->get_access_token( code => q{valid_code_2}, redirect_uri => q{http://example.org/callback}, server_state => q{invalid}, ); ok(!$res, q{response should be undef}); is($client->errstr, q{invalid_server_state}, q{server_state should be invalid}); $res = $client->get_access_token( code => q{valid_code_2}, redirect_uri => q{http://example.org/callback}, server_state => $state->server_state, ); ok($res, q{response should be not undef}); is($res->access_token, q{access_token_4}); is($res->refresh_token, q{refresh_token_1}); is($res->expires_in, q{3600}); is($res->scope, q{email}); done_testing; TestAccessToken.pm100664001750001750 47712755342515 17614 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/libpackage TestAccessToken; use strict; use warnings; use parent 'OAuth::Lite2::Model::AccessToken'; __PACKAGE__->mk_ro_accessors(qw(extra)); sub new { my ($class, %params) = @_; my $extra = delete $params{extra}; my $self = $class->SUPER::new(%params); $self->{extra} = $extra; return $self; } 1; TestAuthInfo.pm100664001750001750 47212755342515 17122 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/libpackage TestAuthInfo; use strict; use warnings; use parent 'OAuth::Lite2::Model::AuthInfo'; __PACKAGE__->mk_ro_accessors(qw(extra)); sub new { my ($class, %params) = @_; my $extra = delete $params{extra}; my $self = $class->SUPER::new(%params); $self->{extra} = $extra; return $self; } 1; TestDataHandler.pm100664001750001750 1511512755342515 17614 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/libpackage TestDataHandler; use strict; use warnings; use parent 'OAuth::Lite2::Server::DataHandler'; use String::Random; use OAuth::Lite2::Server::Error; use OAuth::Lite2::Model::AuthInfo; use OAuth::Lite2::Model::AccessToken; use OAuth::Lite2::Model::ServerState; my %ID_POD = ( auth_info => 0, access_token => 0, user => 0, server_state => 0, ext_account => 0, ); my %AUTH_INFO; my %ACCESS_TOKEN; my %DEVICE_CODE; my %CLIENTS; my %USERS; my %SERVER_STATE; my %EXT_ACCOUNT; sub clear { my $class = shift; %AUTH_INFO = (); %ACCESS_TOKEN = (); %DEVICE_CODE = (); %CLIENTS = (); %USERS = (); %EXT_ACCOUNT = (); } sub gen_next_auth_info_id { my $class = shift; $ID_POD{auth_info}++; } sub gen_next_user_id { my $class = shift; $ID_POD{user}++; } sub gen_next_access_token_id { my $class = shift; $ID_POD{access_token}++; } sub gen_next_server_state_id { my $class = shift; $ID_POD{server_state}++; } sub add_client { my ($class, %args) = @_; $CLIENTS{ $args{id} } = { secret => $args{secret}, user_id => $args{user_id} || 0, group_id => $args{group_id} || undef, }; } sub add_user { my ($class, %args) = @_; $USERS{ $args{username} } = { password => $args{password}, }; } sub add_ext_account { my ($class, %args) = @_; $EXT_ACCOUNT{ $args{assertion} } = { id => $args{id}, client_id => $args{client_id}, type => $args{type}, iss => $args{iss}, aud => $args{aud}, }; } sub init { my $self = shift; } sub get_user_id { my ($self, $username, $password) = @_; return unless ($username && exists $USERS{$username}); return unless ($password && $USERS{$username}{password} eq $password); return $username; } sub get_client_user_id { my ($self, $client_id) = @_; return unless ($client_id && exists $CLIENTS{$client_id}); return $CLIENTS{$client_id}{user_id}; } # TODO needed? sub get_client_by_id { my ($self, $client_id) = @_; return unless ($client_id && exists $CLIENTS{$client_id}); return $CLIENTS{$client_id}; } # called in following flows: # - refresh sub get_auth_info_by_refresh_token { my ($self, $refresh_token) = @_; for my $id (keys %AUTH_INFO) { my $auth_info = $AUTH_INFO{$id}; return $auth_info if $auth_info->{refresh_token} eq $refresh_token; } return; } sub get_auth_info_by_id { my ($self, $auth_id) = @_; return $AUTH_INFO{$auth_id}; } # called in following flows: # - device_token sub get_auth_info_by_code { my ($self, $device_code) = @_; for my $id (keys %AUTH_INFO) { my $auth_info = $AUTH_INFO{$id}; return $auth_info if ($auth_info->code && $auth_info->code eq $device_code); } return; } sub create_or_update_auth_info { my ($self, %params) = @_; my $client_id = $params{client_id}; my $user_id = $params{user_id}; my $scope = $params{scope}; my $code = $params{code}; my $redirect_uri = $params{redirect_uri}; my $server_state = $params{server_state}; my $id = ref($self)->gen_next_auth_info_id(); my $refresh_token = sprintf q{refresh_token_%d}, $id; my $auth_info = OAuth::Lite2::Model::AuthInfo->new({ id => $id, client_id => $client_id, user_id => $user_id, scope => $scope, refresh_token => $refresh_token, }); $auth_info->code($code) if $code; $auth_info->redirect_uri($redirect_uri) if $redirect_uri; $auth_info->server_state($server_state) if $server_state; $AUTH_INFO{$id} = $auth_info; return $auth_info; } # called in following flows: # - refresh sub create_or_update_access_token { my ($self, %params) = @_; my $auth_info = $params{auth_info}; my $auth_id = $auth_info->id; my $id = ref($self)->gen_next_access_token_id(); my $token = sprintf q{access_token_%d}, $id; my %attrs = ( auth_id => $auth_id, token => $token, expires_in => $params{expires_in} || 3600, created_on => time(), ); my $access_token = OAuth::Lite2::Model::AccessToken->new(\%attrs); $ACCESS_TOKEN{$auth_id} = $access_token; return $access_token; } sub get_access_token { my ($self, $token) = @_; for my $auth_id ( keys %ACCESS_TOKEN ) { my $t = $ACCESS_TOKEN{ $auth_id }; if ($t->token eq $token) { return $t; } } return; } sub validate_client { my ($self, $client_id, $client_secret, $type) = @_; return 0 unless exists $CLIENTS{ $client_id }; my $client = $CLIENTS{ $client_id }; return 1 if ( $type eq q{server_state} && $client ); return 0 unless $client->{secret} eq $client_secret; if ($client_id eq 'aaa') { if ($type eq 'basic-credentials') { return 1; } else { return 0; } } else { return 1; } } sub validate_client_by_id { my ($self, $client_id) = @_; return ($client_id ne 'malformed'); } sub validate_user_by_id { my ($self, $user_id) = @_; return ($user_id ne 666); } sub get_group_id_by_client_id { my ($self, $client_id) = @_; return $CLIENTS{$client_id}{group_id}; } sub validate_grouping_scope { my ($self, $client_id, $scope) = @_; my @scopes; @scopes = split /\s/, $scope if ( $scope ); return (grep {$_ eq q{grouping_scope}} @scopes); } sub create_server_state { my ($self, %params) = @_; my $id = ref($self)->gen_next_server_state_id(); my %attrs = ( client_id => $params{client_id}, server_state => "server_state_".$id, expires_in => $params{expires_in} || 3600, created_on => time(), ); my $state = OAuth::Lite2::Model::ServerState->new(\%attrs); $SERVER_STATE{$state->server_state} = $state; return $state; } sub get_user_id_by_external_assertion{ my ($self, %params) = @_; return unless ($params{assertion} && exists $EXT_ACCOUNT{$params{assertion}}); return unless ($params{client_id} && $EXT_ACCOUNT{$params{assertion}}{client_id} eq $params{client_id}); if ($EXT_ACCOUNT{$params{assertion}}{type}) { return unless ($EXT_ACCOUNT{$params{assertion}}{type} eq $params{type}); } if ($EXT_ACCOUNT{$params{assertion}}{iss}) { return unless ($EXT_ACCOUNT{$params{assertion}}{iss} eq $params{iss}); } if ($EXT_ACCOUNT{$params{assertion}}{aud}) { return unless ($EXT_ACCOUNT{$params{assertion}}{aud} eq $params{aud}); } return $EXT_ACCOUNT{$params{assertion}}{id}; } 1; TestPR.pm100664001750001750 237712755342515 15754 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/libpackage TestPR; use strict; use warnings; use overload q(&{}) => sub { shift->psgi_app }, fallback => 1; use Plack::Request; use Try::Tiny; use Params::Validate; use lib 't/lib'; use TestDataHandler; use Plack::Middleware::Auth::OAuth2::ProtectedResource; sub new { my $class = shift; bless { }, $class; } sub psgi_app { my $self = shift; return $self->{psgi_app} ||= $self->compile_psgi_app; } sub compile_psgi_app { my $self = shift; my $app = sub { my $env = shift; my $req = Plack::Request->new($env); my $res; try { $res = $self->handle_request($req); } catch { $res = $req->new_response(500); }; return $res->finalize; }; return Plack::Middleware::Auth::OAuth2::ProtectedResource->wrap($app, realm => 'resource.example.org', data_handler => 'TestDataHandler', ); } sub handle_request { my ($self, $request) = @_; return $request->new_response(200, ["Content-Type" => "application/json"], [ sprintf("{user: '%s', scope: '%s', is_legacy: '%d'}", $request->env->{REMOTE_USER}, $request->env->{X_OAUTH_SCOPE}, $request->env->{X_OAUTH_IS_LEGACY})] ); } 1; TestServerState.pm100664001750001750 47712755342515 17661 0ustar00ritouritou000000000000OAuth-Lite2-0.11/t/libpackage TestServerState; use strict; use warnings; use parent 'OAuth::Lite2::Model::ServerState'; __PACKAGE__->mk_ro_accessors(qw(extra)); sub new { my ($class, %params) = @_; my $extra = delete $params{extra}; my $self = $class->SUPER::new(%params); $self->{extra} = $extra; return $self; } 1; META.yml100664001750001750 1644612755342515 14517 0ustar00ritouritou000000000000OAuth-Lite2-0.11--- abstract: 'OAuth 2.0 Library' author: - 'Ryo Ito, ' build_requires: ExtUtils::MakeMaker: '6.36' Test::More: '0' configure_requires: Module::Build::Tiny: '0.035' dynamic_config: 0 generated_by: 'Minilla/v3.0.0, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: OAuth-Lite2 no_index: directory: - t - xt - inc - share - eg - examples - author - builder provides: OAuth::Lite2: file: lib/OAuth/Lite2.pm version: '0.11' OAuth::Lite2::Agent: file: lib/OAuth/Lite2/Agent.pm OAuth::Lite2::Agent::Dump: file: lib/OAuth/Lite2/Agent/Dump.pm OAuth::Lite2::Agent::PSGIMock: file: lib/OAuth/Lite2/Agent/PSGIMock.pm OAuth::Lite2::Agent::Strict: file: lib/OAuth/Lite2/Agent/Strict.pm OAuth::Lite2::Client::ClientCredentials: file: lib/OAuth/Lite2/Client/ClientCredentials.pm OAuth::Lite2::Client::Error: file: lib/OAuth/Lite2/Client/Error.pm OAuth::Lite2::Client::Error::InsecureRequest: file: lib/OAuth/Lite2/Client/Error.pm OAuth::Lite2::Client::Error::InsecureResponse: file: lib/OAuth/Lite2/Client/Error.pm OAuth::Lite2::Client::Error::InvalidResponse: file: lib/OAuth/Lite2/Client/Error.pm OAuth::Lite2::Client::ExternalService: file: lib/OAuth/Lite2/Client/ExternalService.pm OAuth::Lite2::Client::ServerState: file: lib/OAuth/Lite2/Client/ServerState.pm OAuth::Lite2::Client::StateResponseParser: file: lib/OAuth/Lite2/Client/StateResponseParser.pm OAuth::Lite2::Client::Token: file: lib/OAuth/Lite2/Client/Token.pm OAuth::Lite2::Client::TokenResponseParser: file: lib/OAuth/Lite2/Client/TokenResponseParser.pm OAuth::Lite2::Client::UsernameAndPassword: file: lib/OAuth/Lite2/Client/UsernameAndPassword.pm OAuth::Lite2::Client::WebServer: file: lib/OAuth/Lite2/Client/WebServer.pm OAuth::Lite2::Formatter: file: lib/OAuth/Lite2/Formatter.pm OAuth::Lite2::Formatter::FormURLEncoded: file: lib/OAuth/Lite2/Formatter/FormURLEncoded.pm OAuth::Lite2::Formatter::JSON: file: lib/OAuth/Lite2/Formatter/JSON.pm OAuth::Lite2::Formatter::Text: file: lib/OAuth/Lite2/Formatter/Text.pm OAuth::Lite2::Formatter::XML: file: lib/OAuth/Lite2/Formatter/XML.pm OAuth::Lite2::Formatters: file: lib/OAuth/Lite2/Formatters.pm OAuth::Lite2::Model::AccessToken: file: lib/OAuth/Lite2/Model/AccessToken.pm OAuth::Lite2::Model::AuthInfo: file: lib/OAuth/Lite2/Model/AuthInfo.pm OAuth::Lite2::Model::ServerState: file: lib/OAuth/Lite2/Model/ServerState.pm OAuth::Lite2::ParamMethod: file: lib/OAuth/Lite2/ParamMethod.pm OAuth::Lite2::ParamMethod::AuthHeader: file: lib/OAuth/Lite2/ParamMethod/AuthHeader.pm OAuth::Lite2::ParamMethod::FormEncodedBody: file: lib/OAuth/Lite2/ParamMethod/FormEncodedBody.pm OAuth::Lite2::ParamMethod::URIQueryParameter: file: lib/OAuth/Lite2/ParamMethod/URIQueryParameter.pm OAuth::Lite2::ParamMethods: file: lib/OAuth/Lite2/ParamMethods.pm OAuth::Lite2::Server::Context: file: lib/OAuth/Lite2/Server/Context.pm OAuth::Lite2::Server::DataHandler: file: lib/OAuth/Lite2/Server/DataHandler.pm OAuth::Lite2::Server::Endpoint::Token: file: lib/OAuth/Lite2/Server/Endpoint/Token.pm OAuth::Lite2::Server::Error: file: lib/OAuth/Lite2/Server/Error.pm OAuth::Lite2::Server::Error::AccessDenied: file: lib/OAuth/Lite2/Server/Error.pm OAuth::Lite2::Server::Error::ExpiredToken: file: lib/OAuth/Lite2/Server/Error.pm OAuth::Lite2::Server::Error::ExpiredTokenLegacy: file: lib/OAuth/Lite2/Server/Error.pm OAuth::Lite2::Server::Error::InsufficientScope: file: lib/OAuth/Lite2/Server/Error.pm OAuth::Lite2::Server::Error::InvalidClient: file: lib/OAuth/Lite2/Server/Error.pm OAuth::Lite2::Server::Error::InvalidGrant: file: lib/OAuth/Lite2/Server/Error.pm OAuth::Lite2::Server::Error::InvalidRequest: file: lib/OAuth/Lite2/Server/Error.pm OAuth::Lite2::Server::Error::InvalidScope: file: lib/OAuth/Lite2/Server/Error.pm OAuth::Lite2::Server::Error::InvalidServerState: file: lib/OAuth/Lite2/Server/Error.pm OAuth::Lite2::Server::Error::InvalidToken: file: lib/OAuth/Lite2/Server/Error.pm OAuth::Lite2::Server::Error::RedirectURIMismatch: file: lib/OAuth/Lite2/Server/Error.pm OAuth::Lite2::Server::Error::ServerError: file: lib/OAuth/Lite2/Server/Error.pm OAuth::Lite2::Server::Error::TemporarilyUnavailable: file: lib/OAuth/Lite2/Server/Error.pm OAuth::Lite2::Server::Error::UnauthorizedClient: file: lib/OAuth/Lite2/Server/Error.pm OAuth::Lite2::Server::Error::UnsupportedGrantType: file: lib/OAuth/Lite2/Server/Error.pm OAuth::Lite2::Server::Error::UnsupportedResourceType: file: lib/OAuth/Lite2/Server/Error.pm OAuth::Lite2::Server::Error::UnsupportedResponseType: file: lib/OAuth/Lite2/Server/Error.pm OAuth::Lite2::Server::GrantHandler: file: lib/OAuth/Lite2/Server/GrantHandler.pm OAuth::Lite2::Server::GrantHandler::AuthorizationCode: file: lib/OAuth/Lite2/Server/GrantHandler/AuthorizationCode.pm OAuth::Lite2::Server::GrantHandler::ClientCredentials: file: lib/OAuth/Lite2/Server/GrantHandler/ClientCredentials.pm OAuth::Lite2::Server::GrantHandler::ExternalService: file: lib/OAuth/Lite2/Server/GrantHandler/ExternalService.pm OAuth::Lite2::Server::GrantHandler::GroupingRefreshToken: file: lib/OAuth/Lite2/Server/GrantHandler/GroupingRefreshToken.pm OAuth::Lite2::Server::GrantHandler::Password: file: lib/OAuth/Lite2/Server/GrantHandler/Password.pm OAuth::Lite2::Server::GrantHandler::RefreshToken: file: lib/OAuth/Lite2/Server/GrantHandler/RefreshToken.pm OAuth::Lite2::Server::GrantHandler::ServerState: file: lib/OAuth/Lite2/Server/GrantHandler/ServerState.pm OAuth::Lite2::Server::GrantHandlers: file: lib/OAuth/Lite2/Server/GrantHandlers.pm OAuth::Lite2::Signer: file: lib/OAuth/Lite2/Signer.pm OAuth::Lite2::Signer::Algorithm: file: lib/OAuth/Lite2/Signer/Algorithm.pm OAuth::Lite2::Signer::Algorithm::HMAC_SHA1: file: lib/OAuth/Lite2/Signer/Algorithm/HMAC_SHA1.pm OAuth::Lite2::Signer::Algorithm::HMAC_SHA256: file: lib/OAuth/Lite2/Signer/Algorithm/HMAC_SHA256.pm OAuth::Lite2::Signer::Algorithms: file: lib/OAuth/Lite2/Signer/Algorithms.pm OAuth::Lite2::Util: file: lib/OAuth/Lite2/Util.pm Plack::Middleware::Auth::OAuth2::ProtectedResource: file: lib/Plack/Middleware/Auth/OAuth2/ProtectedResource.pm requires: Class::Accessor::Fast: '0.34' Class::ErrorHandler: '0.01' Data::Dump: '1.17' Digest::SHA: '5.48' Hash::MultiValue: '0.08' IO::String: '1.08' JSON::XS: '0' LWP::UserAgent: '0' Params::Validate: '0.95' Plack: '0.09942' Scalar::Util: '1.23' String::Random: '0.22' Try::Tiny: '0.06' URI: '1.54' XML::LibXML: '1.7' resources: bugtracker: https://github.com/ritou/p5-oauth-lite2/issues homepage: https://github.com/ritou/p5-oauth-lite2 repository: git://github.com/ritou/p5-oauth-lite2.git version: '0.11' x_contributors: - 'Kato Kazuyoshi ' - 'HIROSE Masaaki ' - 'Dann ' - 'lyokato ' - 'Matthew Franglen ' - 'Géraud CONTINSOUZAS ' x_serialization_backend: 'CPAN::Meta::YAML version 0.012' MANIFEST100664001750001750 550612755342515 14352 0ustar00ritouritou000000000000OAuth-Lite2-0.11Build.PL Changes LICENSE META.json README.md cpanfile lib/OAuth/Lite2.pm lib/OAuth/Lite2/Agent.pm lib/OAuth/Lite2/Agent/Dump.pm lib/OAuth/Lite2/Agent/PSGIMock.pm lib/OAuth/Lite2/Agent/Strict.pm lib/OAuth/Lite2/Client/ClientCredentials.pm lib/OAuth/Lite2/Client/Error.pm lib/OAuth/Lite2/Client/ExternalService.pm lib/OAuth/Lite2/Client/ServerState.pm lib/OAuth/Lite2/Client/StateResponseParser.pm lib/OAuth/Lite2/Client/Token.pm lib/OAuth/Lite2/Client/TokenResponseParser.pm lib/OAuth/Lite2/Client/UsernameAndPassword.pm lib/OAuth/Lite2/Client/WebServer.pm lib/OAuth/Lite2/Formatter.pm lib/OAuth/Lite2/Formatter/FormURLEncoded.pm lib/OAuth/Lite2/Formatter/JSON.pm lib/OAuth/Lite2/Formatter/Text.pm lib/OAuth/Lite2/Formatter/XML.pm lib/OAuth/Lite2/Formatters.pm lib/OAuth/Lite2/Model/AccessToken.pm lib/OAuth/Lite2/Model/AuthInfo.pm lib/OAuth/Lite2/Model/ServerState.pm lib/OAuth/Lite2/ParamMethod.pm lib/OAuth/Lite2/ParamMethod/AuthHeader.pm lib/OAuth/Lite2/ParamMethod/FormEncodedBody.pm lib/OAuth/Lite2/ParamMethod/URIQueryParameter.pm lib/OAuth/Lite2/ParamMethods.pm lib/OAuth/Lite2/Server/Context.pm lib/OAuth/Lite2/Server/DataHandler.pm lib/OAuth/Lite2/Server/Endpoint/Token.pm lib/OAuth/Lite2/Server/Error.pm lib/OAuth/Lite2/Server/GrantHandler.pm lib/OAuth/Lite2/Server/GrantHandler/AuthorizationCode.pm lib/OAuth/Lite2/Server/GrantHandler/ClientCredentials.pm lib/OAuth/Lite2/Server/GrantHandler/ExternalService.pm lib/OAuth/Lite2/Server/GrantHandler/GroupingRefreshToken.pm lib/OAuth/Lite2/Server/GrantHandler/Password.pm lib/OAuth/Lite2/Server/GrantHandler/RefreshToken.pm lib/OAuth/Lite2/Server/GrantHandler/ServerState.pm lib/OAuth/Lite2/Server/GrantHandlers.pm lib/OAuth/Lite2/Signer.pm lib/OAuth/Lite2/Signer/Algorithm.pm lib/OAuth/Lite2/Signer/Algorithm/HMAC_SHA1.pm lib/OAuth/Lite2/Signer/Algorithm/HMAC_SHA256.pm lib/OAuth/Lite2/Signer/Algorithms.pm lib/OAuth/Lite2/Util.pm lib/Plack/Middleware/Auth/OAuth2/ProtectedResource.pm minil.toml script/token.psgi t/00_compile.t t/010_core/formatter.t t/010_core/param_methods.t t/010_core/signer.t t/010_core/util.t t/030_server/protected_resource/middleware.t t/030_server/token_endpoint/authorization_code.t t/030_server/token_endpoint/client_credentials.t t/030_server/token_endpoint/external_service.t t/030_server/token_endpoint/grouping_refresh_token.t t/030_server/token_endpoint/password.t t/030_server/token_endpoint/refresh.t t/030_server/token_endpoint/server_state.t t/040_unit/client_credentials.t t/040_unit/common.t t/040_unit/external_service.t t/040_unit/grouping_refresh_token.t t/040_unit/model/access_token.t t/040_unit/model/auth_info.t t/040_unit/model/server_state.t t/040_unit/server/error.t t/040_unit/server/grant_handler.t t/040_unit/username.t t/040_unit/web_server.t t/lib/TestAccessToken.pm t/lib/TestAuthInfo.pm t/lib/TestDataHandler.pm t/lib/TestPR.pm t/lib/TestServerState.pm META.yml MANIFEST