Net-OpenID-Consumer-1.18/0000775000175000017500000000000012655770672013227 5ustar rfcrfcNet-OpenID-Consumer-1.18/README0000644000175000017500000000117112655770672014105 0ustar rfcrfcNet-OpenID-Consumer =================== This is a set of Perl modules for implementing a Relying Party for OpenID (versions 1.1 or 2.0) There are two companion distributions: Net-OpenID-Server -- implements an OpenID Provider Net-OpenID-Common -- prerequisites for -Server and -Consumer INSTALL has the usual installation instructions. Changes has the change log (surprise). - - - If you are upgrading from Consumer 1.03 or earlier, please be aware of API changes with respect to $consumer->args(CODEREF) $consumer->handle_server_response / user_setup_url see 'Changes' and the Consumer.pm podfile for details. Net-OpenID-Consumer-1.18/INSTALL0000644000175000017500000000064312655770672014261 0ustar rfcrfcYou will want to obtain and install the most recent version of Net-OpenID-Common if you have not done so already. If you downloaded this package off of CPAN, it should build and install in the standard way: perl Makefile.PL make make test make install If you are building this package directly from a git repository, you will most likely need to install Dist::Zilla first. See http://dzil.org/ Net-OpenID-Consumer-1.18/Changes0000644000175000017500000003125712655770672014530 0ustar rfcrfc1.18 Feb 07 2016 * Make naive_verify_failed_network message less mysterious in cases where provider actually responds but with a non-success status. * whitespace changes 1.17 Jan 15 2016 * Include CGI in test prerequisites since it's not part of perlcore anymore 1.16 Sep 15 2014 * Require Net-OpenID-Common 1.19 1.15 Sep 06 2013 * Require Net-OpenID-Common 1.18 in order to pick up patched Crypt::DH::GMP 0.00011 (closes #88460) 1.14 Apr 01 2013 * Fix uri_escape'ing of UTF-8 attributes (closes #80329) * documentation fixes and updated consumer.cgi example (closes #74101) 1.13 Nov 14 2011 1.12 Nov 06 2011 * Require Net-OpenID-Common 1.13 * Use/cache Last-modified: as a number, not a raw header string (closes #47349) * Pay attention to charset on application/xrds+xml content-type (closes #41310) 1.11 Nov 04 2011 * Added POD section on Error Codes * Fixed bug that could cause VerifiedIdentity->signed_fields to be spuriously set to an empty hash * Fixed bug where _discover_acceptable_endpoints force_version => 1 could return version 2 endpoints. 1.100099_002 Nov 02 2011 * We now do actual checking of responce_nonce (closes #44767). Behavior is customizable using Consumer->nonce_options. You may want to set 'start' to your (cache/HTTP) server start time. The defaults will otherwise do the Right Thing if your cache implementation pays attention to the 3rd (expiration) argument to set() and can reliably hold onto entries for a half hour; otherwise this may need some attention. Likewise if you already have better protection against replays, in which case you'll want to turn this off. * Lots of POD fixes 1.100099_001 Oct 25 2011 --------------- ==> API CHANGE: Consumer->args(CODEREF) CODEREF now needs to be able to also take zero arguments and return a list of all URL parameters in the request. No change is needed for the other argument types (i.e., unblessed hash or CGI/Apache/etc request object) (Enumeration is required for check_authentication in OpenID 2.0 to work properly -- if the list isn't available then we can revert to OpenID 1.1 behavior of only sending the signed parameters and hope for the best, but be warned that some providers may reject this.) --------------- * HTML parsing routines now reside in Net::OpenID::Common (1.12 required) which has itself been upgraded to using HTML::Parser. 1.030099_006 Oct 22 2011 --------------- ==> API CHANGE: Consumer->handle_server_response() The 'setup_required' callback is now DEPRECATED but still recognized for now for the sake of legacy code. It may be removed in a future release. Use 'setup_needed' instead. This callback (1) is invoked in ALL cases where a checkid_immediate mode request fails, including those where user_setup_url is not supplied, and (2) is NOT supplied a user_setup_url parameter (you can still use Consumer->user_setup_url as needed) Note that in OpenID 2.0, the correct way to handle failure of a checkid_immediate mode request is to retry the same request again in checkid_setup mode. user_setup_url is generally not meaningful in OpenID 2.0 and therefore CANNOT be relied upon. --------------- ==> API CHANGE: Consumer->setup_needed() [new function] Should be used to test for the failed checkid_immediate case when not using handle_server_response(). Testing for user_setup_url() having been set is DEPRECATED and will NOT work under OpenID 2.0 since user_setup_url is generally not meaningful in 2.0 (even if some 2.0 providers do in fact supply it). --------------- * Handle 2.0 provider-specific 'error' mode responses. These currently show up in the 'error' callback (errcode == 'provider_error'); * Remove dependency in ordering of minimum_version() and args() setters. This was a bug that prevented minimum_version from being recognized at all. * Fix handle_server_response unknown callback error message -- close #58368 * Handle version 2.0 associations and all session/association types. This is customizable using Consumer->assoc_options. Most likely you will want to just set 'max_encrypt' and 'session_no_encrypt_https' true and forget about it. * Fix bug in handling of sreg extension under 2.0 that prevented certain other extensions from being recognized. * New co-maintainer (Roger Crew) 1.030099_005 Jan 01 2011 * Remove calls to util::ejs and util::eurl; use JSON and URI::Escape directly (Robert Norris) 1.030099_004 Dec 18 2010 * Added example CGI program (Robert Norris) * Added missing error messages (Mario Domgoergen) 1.030099_003 Nov 09 2010 * Add namespace to check_authentication signature verification calls to fix stateless mode against strict OPs (Robert Norris) * Documentation tweaks (Robert Norris) 1.030099_002 Nov 07 2010 * Fixed a call to OpenID::util::hmac_sha1_hex which no longer exists (Robert Norris) 1.030099_001 Nov 06 2010 * Use Crypt::DH::GMP over Crypt::DH for speed (Robert Norris) * Fix potential timing attack when checking signatures (Adam Sjøgren) (see http://lists.openid.net/pipermail/openid-security/2010-July/001156.html) * Set sreg namespace based on what the server is expecting (Adam Sjøgren) * Moved some utility bits out to a separate Net::OpenID::Common package so that Net::OpenID::Server can use it in future versions. 1.03: * Enforce the rules from the Auth 2.0 spec about which fields MUST be signed in positive assertion messages. * Return a more sensible error (no_head_tag) if the identifier URL returns an empty (0-byte) HTML document. * Verify delegate on the non-fragment version of the resulting identifier, so that you can delegate to providers that add fragments to their identifiers. Found and fixed by avarix . 1.02: * Declare dependency on XML::Simple 1.01: * Make the verified_identity bit accept assertions from any declared endpoint, rather than only the primary one. This implementation kinda sucks because it hits the identity URL over and over doing discovery. * Refactor the discovery code a little so that the whole list of valid endpoints can optionally be returned. This is in preparation for fixing the assertion verification code so that providers other than the primary one are able to make assertions. * Support indirect messages encapsualated in POST requests when args are given as a CGI, Apache, or Apache::Request object. * Support the 1.1 and 1.0 namespace values required by Auth 2.0 section 4.1.2. * Deal with cases where Net::OpenID::Yadis returns arrayref or hashref for Service->URI, including a basic support for the priority attribute. Based on a patch from Fumiaki Yoshimatsu . * when dealing with a 2.0 server, send 2.0-shaped association requests. * add the set_extension_args method to ClaimedIdentity and the extension_fields and signed_extension_fields methods to VerifiedIdentity, which together form a higher-level API for using protocol extensions such as SREG and PAPE. * add support for OpenID 2.0-style messages from providers * use our own simplified fork of Net::Yadis::Discovery to avoid dependency on Module::Pluggable::Fast. Or on Net::Yadis::Discovery, for that matter. * add hooks for openid-test project. (bradfitz) * add OpenID 2.0-compliant discovery and authentication request. * add method on claimed identity object to get delgated URL 0.14: (2007-08-03) * allow CGI subclasses (like CGI::Fast) for args. bug fix from Chris Kastorff . 0.13: * work-around bug in some openid servers that don't escape "+". so treat a space as a +. (from Thomas Sibley ) * go into dumb mode earlier if it's detected that our cache object isn't working * give callers access to the signed_fields from the verified identity object 0.12: * required_root in constructor/method/validated_identity * allow https identities * version 1.1 of the protocol * expand entities in link rel * reject cached association validation if expiry is in past 0.11: * document common error codes from claimed_identity, and cleanup some error handling/codes * support openid.mode=cancel * respect replace_after and expiry. do clock compensation between local clock and server. * invalidate_handle support 0.10: * handle openid.delegate properly (was losing state because I'd put a URL parameter onto the wrong URL) * copy all signed parameters into POST args in dumb mode, not a static set (to be future-proof) 0.09: * switch to DH/HMAC protocol, not DSA protocol 0.08: * more openssl-binary temp file changes. on second failure (which was previously missing a new method), it also propogates up the error message now, instead of dying, to be more consistent with the other DSA checkers, which never die 0.07: * bugfix: use URI::Fetch 0.02, not "0.02" in quotes * bugfix: don't set cache if no cache 0.06: * wrap Crypt::OpenSSL::DSA verify in eval {} as it can croak * use URI::Fetch, which does caching and proper HTTP behavior * let user get/set cache, which is then propogated down to URI::Fetch * optionally use new pure-perl version of Crypt::DSA which now does ASN.1 serialization/deserialization in both signatures and public keys. brings total options of DSA verify techniques up to 3. * tmpdir option (and smart auto-configuration) for people using OpenSSL binaries to verify signatures. * security fix when doing DSA checks with system openssl binary (was previously parsing the wrong status) * misc reported bugfixes 0.05: * stupid push_url_arg bugfix * doc fix in example code (no post_grant in check_url) 0.04: * tons more docs: in both ClaimedIdentity and VerifiedIdentity * Consumer now observes atom/rss/foaf/foafmaker at the same time as openid.server, and passes it along to VerifiedIdentity, where it's accessible, and VerifiedIdentity knows whether or not those urls are under the trusted one or not, and makes them differently available to callers * bug fixes, doc fixes * post_grant moved to user_setup_url, not check_url * delayed_return added to check_url 0.03: * setting args in constructor was broken * renamed get_claimed_identity to just claimed_identity to be consistent * all methods now croak if called with too many arguments * added ClaimedIdentity->identity_server to get just one, as selected by plugin, instead of array of them all 0.02: * POD docs for Net/OpenID/Consumer.pm * accepts CGI, Apache, Apache::Request, and CODE arguments now for GET argument retrievers, in addition to just HASH references * openid.server auto-discovery only happens within first tag * if using Crypt::OpenSSL::DSA, now requires 0.12 due to bugs found in 0.11. * DSA verification using OpenSSL binary no longer spews "Verification OK" to stdout 0.01: * fetching of page (with configurable user agent object; I recommend you use LWPx::ParanoidAgent, now available on CPAN) and returning a "ClaimedIdentity" object of what the user claims they are, but is not verified yet * auto-discovery of openid servers * hook to let you provide your subref to do openid server selection, given multiple options * generation of "check" URL to send user to to get redirect * reading of response parameters, returning either a user_setup_url or a VerifiedIdentity object (doing DSA validation with either Crypt::OpenSSL::DSA or your openssl binary) * start of JSON responses for javascript UI Net-OpenID-Consumer-1.18/LICENSE0000644000175000017500000004367112655770672014245 0ustar rfcrfcThis software is copyright (c) 2005 by Brad Fitzpatrick. 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) 2005 by Brad Fitzpatrick. 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, Fifth Floor, Boston, MA 02110-1301 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) 2005 by Brad Fitzpatrick. 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 Net-OpenID-Consumer-1.18/META.yml0000644000175000017500000000154612655770672014504 0ustar rfcrfc--- abstract: 'Library for consumers of OpenID identities' author: - 'Robert Norris ' - 'Roger Crew ' build_requires: CGI: '0' Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 5.020, CPAN::Meta::Converter version 2.142690' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Net-OpenID-Consumer requires: Digest::SHA: '0' HTTP::Request: '0' JSON: '0' LWP::UserAgent: '0' MIME::Base64: '0' Net::OpenID::Common: '1.19' Storable: '0' Time::Local: '0' URI: '0' resources: bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-OpenID-Consumer homepage: http://groups.google.com/group/openid-perl repository: git://github.com/wrog/Net-OpenID-Consumer.git version: '1.18' Net-OpenID-Consumer-1.18/MANIFEST0000644000175000017500000000071512655770672014361 0ustar rfcrfc# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.020. Changes INSTALL LICENSE MANIFEST META.json META.yml Makefile.PL README examples/consumer.cgi lib/Net/OpenID/Association.pm lib/Net/OpenID/ClaimedIdentity.pm lib/Net/OpenID/Consumer.pm lib/Net/OpenID/VerifiedIdentity.pm t/00-use.t t/01-misc.t t/02-canonical.t t/03-seminfo.t t/04-handler.t t/99-rt80329.t t/lib/FakeFetch.pm t/release-pod-syntax.t xt/03-providers.t xt/04-handler.t Net-OpenID-Consumer-1.18/META.json0000644000175000017500000000321412655770672014646 0ustar rfcrfc{ "abstract" : "Library for consumers of OpenID identities", "author" : [ "Robert Norris ", "Roger Crew " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 5.020, CPAN::Meta::Converter version 2.142690", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Net-OpenID-Consumer", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Test::Pod" : "1.41" } }, "runtime" : { "requires" : { "Digest::SHA" : "0", "HTTP::Request" : "0", "JSON" : "0", "LWP::UserAgent" : "0", "MIME::Base64" : "0", "Net::OpenID::Common" : "1.19", "Storable" : "0", "Time::Local" : "0", "URI" : "0" } }, "test" : { "requires" : { "CGI" : "0", "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-net-openid-consumer@rt.cpan.org", "web" : "http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-OpenID-Consumer" }, "homepage" : "http://groups.google.com/group/openid-perl", "repository" : { "type" : "git", "url" : "git://github.com/wrog/Net-OpenID-Consumer.git", "web" : "http://github.com/wrog/Net-OpenID-Consumer" } }, "version" : "1.18" } Net-OpenID-Consumer-1.18/t/0000775000175000017500000000000012655770672013472 5ustar rfcrfcNet-OpenID-Consumer-1.18/t/00-use.t0000644000175000017500000000013712655770672014667 0ustar rfcrfc#!/usr/bin/perl use strict; use Test::More tests => 1; use Net::OpenID::Consumer; ok(1); 1; Net-OpenID-Consumer-1.18/t/01-misc.t0000644000175000017500000000055212655770672015030 0ustar rfcrfc#!/usr/bin/perl use strict; use Test::More tests => 2; use Net::OpenID::Consumer; my $csr = Net::OpenID::Consumer->new; ok($csr, "instantiated"); ok($csr->args(CGI::Subclass->new), "can set CGI subclass as args"); package CGI::Subclass; use base 'CGI'; package CGI; no warnings 'redefine'; sub new { my ($class) = @_; return bless {}, $class; } 1; Net-OpenID-Consumer-1.18/t/99-rt80329.t0000644000175000017500000000271612655770672015155 0ustar rfcrfc#!/usr/bin/perl use warnings; use strict; use utf8; use Test::More tests => 1; use Digest::SHA qw(hmac_sha1_hex); use Net::OpenID::Consumer; sub fake_discover_acceptable_endpoints { return [{ uri => 'http://example.com/openid', version => 2, final_url => 'http://example.com/openid?j.doe', sem_info => {}, mechanism => "HTML", }]; } { no warnings 'redefine'; *Net::OpenID::Consumer::_discover_acceptable_endpoints = \&fake_discover_acceptable_endpoints } my $c = Net::OpenID::Consumer->new( ua => Fake::UA->new, consumer_secret => 'abc', args => { 'oic.time' => time . '-' . substr(hmac_sha1_hex(time, 'abc'), 0, 20), 'openid.mode' => 'id_res', 'openid.identity' => 'http://example.com/openid?j.doe', 'openid.sig' => 'fake', 'openid.return_to' => 'http://example.com/openid', 'openid.claimed_id' => 'http://example.com/openid?j.doe', 'openid.something' => "\x{442}\x{435}\x{441}\x{442}", # this breaks @ uri_escape 'openid.signed' => 'mode,identity,return_to,signed,claimed_id,something', 'openid.assoc_handle' => 'a_handle', } ); ok(eval { $c->verified_identity() }); package Fake::UA; sub new { return bless {}, "Fake::UA"; } sub request { HTTP::Response->new(200, 'OK', [], "is_valid:true\nlifetime:123"); } Net-OpenID-Consumer-1.18/t/04-handler.t0000644000175000017500000006531612655770672015526 0ustar rfcrfc#!/usr/bin/perl use warnings; use strict; use Test::More tests => 180; # use lib '/home/rfc/src/git/Net-OpenID-Consumer/lib'; # use lib '/home/rfc/src/git/Net-OpenID-Common/lib'; use lib 't/lib'; use Net::OpenID::Consumer; print $INC{'Net/OpenID/Consumer.pm'},"\n"; sub fake_verified_identity { # extremely simplified version that only looks at .mode and .identity # and does not do any discovery/check_authentication callouts my $csr = shift; return $csr->_fail("bad_mode") unless $csr->_message_mode_is("id_res"); return $csr->_fail("no_identity") unless my $id = $csr->message('identity'); # pretend everything worked my $v = Net::OpenID::VerifiedIdentity->new(consumer => $csr, signed_fields => {}); $v->{'identity'} = $csr->message('identity'); return $v; } { no warnings 'redefine'; *Net::OpenID::Consumer::verified_identity = \&fake_verified_identity; } my $the_log = ''; my @common_callbacks = ( not_openid => sub { $the_log .= '!NOT'; }, cancelled => sub { $the_log .= '!CAN'; }, verified => sub { my $url = $_[0]->url; $the_log .= "!VER($url)"; }, error => sub { $the_log .= "!ERR($_[0]: $_[1])"; }, ); my $the_csr; my @handlers = ( broken_hsr1 => sub { $the_csr->handle_server_response( @common_callbacks, setup_needed => sub { 'dontcare'; }, setup_required => sub { 'dontcare'; }, ); }, broken_hsr2 => sub { $the_csr->handle_server_response( @common_callbacks, ); }, broken_hsr3 => sub { $the_csr->handle_server_response( @common_callbacks, setup_needed => sub { 'dontcare'; }, biteme => sub { 'dontcare'; }, ); }, broken_hsr4 => sub { $the_csr->handle_server_response( @common_callbacks, setup_required => sub { 'dontcare'; }, biteme => sub { 'dontcare'; }, ); }, hsr => sub { $the_csr->handle_server_response( @common_callbacks, setup_needed => sub { my $u = $the_csr->user_setup_url || ''; $the_log .= "!IMM($u)"; }, ); }, hsr_old => sub { $the_csr->handle_server_response( @common_callbacks, setup_required => sub { my $u = shift || ''; $the_log .= "!IMM($u)"; }, ); }, diy => sub { # current DIY code unless ($the_csr->is_server_response) { $the_log .= "!NOT"; } elsif ($the_csr->setup_needed) { my $u = $the_csr->user_setup_url || ''; $the_log .= "!IMM($u)"; } elsif ($the_csr->user_cancel) { # restore web app state to prior to check_url $the_log .= "!CAN"; } elsif (my $vident = $the_csr->verified_identity) { my $url = $vident->url; $the_log .= "!VER($url)"; } else { my $e = $the_csr->err; $the_log .= "!ERR($e)"; } }, diy_old => sub { # DIY code from 1.03 synopsis if (my $url = $the_csr->user_setup_url) { $the_log .= "!IMM($url)"; } elsif ($the_csr->user_cancel) { # restore web app state to prior to check_url $the_log .= "!CAN"; } elsif (my $vident = $the_csr->verified_identity) { my $url = $vident->url; $the_log .= "!VER($url)"; } else { my $e = $the_csr->err; $the_log .= "!ERR($e)"; } }, ); my @messages = qw( immed_fail_1 openid.mode=id_res&openid.user_setup_url=http://setup.com immed_fail_2 openid.mode=setup_needed immed_fail_2s openid.mode=setup_needed&openid.user_setup_url=http://setup.com cancel openid.mode=cancel&openid.user_setup_url=http://setup.com badverify openid.mode=id_res verify openid.mode=id_res&openid.identity=http://io.com/rufus real_bad_mode openid.mode=only_slightly_biffle_dinked provider_error openid.mode=error&openid.error=We%20are%20out%20of%20spoons. ); my $i; my %messages = @messages; @messages = do { $i=0; grep {++$i % 2} @messages }; my %handlers = @handlers; @handlers = do { $i=0; grep {++$i % 2} @handlers }; # Nonsense combinations my %nonsense = map {($_,1)} qw(1immed_fail_2 1immed_fail_2s 1provider_error 2immed_fail_1); sub try { my ($hkey,$msg,$vm,$v2c) = @_; $the_csr = Net::OpenID::Consumer->new ( $v2c ? (minimum_version => 2) : (), args => { (!$vm ? () : ("openid.ns", ($vm >= 2 ? "http://specs.openid.net/auth/$vm" : "http://openid.net/signon/$vm"))), map {s/%20/ /g; split '='} split '&',$messages{$msg} }, ); $the_log = ''; $handlers{$hkey}->(); return $the_log; } sub trydie { return eval { try(@_) or 'hmm'; } || $@; } # for my $m (@messages) { # for my $vm (undef,'1.0','1.1','2.0') { # for my $v2c (undef, 2) { # for my $h (@handlers) { # # next unless $h eq 'diy' || $h eq 'hsr'; # print # ($nonsense{($vm ? substr($vm,0,1) : '1') . $m} ? '# ' : ''), # "is(try(", # sprintf('%9s,%16s,%5s,%5s',map {defined($_) ? "'$_'" : 'undef'} $h,$m,$vm,$v2c), # "),'", # try($h,$m,$vm,$v2c),"');\n"; # } # } # } # } like(trydie('broken_hsr1','immed_fail_1',undef,undef),qr/^Cannot have both setup_needed and setup_required/); like(trydie('broken_hsr2','immed_fail_1',undef,undef),qr/^No setup_needed callback/); like(trydie('broken_hsr3','immed_fail_1',undef,undef),qr/^Unknown callbacks: *biteme/,'with setup_needed'); like(trydie('broken_hsr4','immed_fail_1',undef,undef),qr/^Unknown callbacks: *biteme/,'with setup_required'); is(try( 'hsr', 'immed_fail_1',undef,undef),'!IMM(http://setup.com)'); is(try('hsr_old', 'immed_fail_1',undef,undef),'!IMM(http://setup.com)'); is(try( 'diy', 'immed_fail_1',undef,undef),'!IMM(http://setup.com)'); is(try('diy_old', 'immed_fail_1',undef,undef),'!IMM(http://setup.com)'); is(try( 'hsr', 'immed_fail_1',undef, '2'),'!NOT'); is(try('hsr_old', 'immed_fail_1',undef, '2'),'!NOT'); is(try( 'diy', 'immed_fail_1',undef, '2'),'!NOT'); is(try('diy_old', 'immed_fail_1',undef, '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'immed_fail_1','1.0',undef),'!IMM(http://setup.com)'); is(try('hsr_old', 'immed_fail_1','1.0',undef),'!IMM(http://setup.com)'); is(try( 'diy', 'immed_fail_1','1.0',undef),'!IMM(http://setup.com)'); is(try('diy_old', 'immed_fail_1','1.0',undef),'!IMM(http://setup.com)'); is(try( 'hsr', 'immed_fail_1','1.0', '2'),'!NOT'); is(try('hsr_old', 'immed_fail_1','1.0', '2'),'!NOT'); is(try( 'diy', 'immed_fail_1','1.0', '2'),'!NOT'); is(try('diy_old', 'immed_fail_1','1.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'immed_fail_1','1.1',undef),'!IMM(http://setup.com)'); is(try('hsr_old', 'immed_fail_1','1.1',undef),'!IMM(http://setup.com)'); is(try( 'diy', 'immed_fail_1','1.1',undef),'!IMM(http://setup.com)'); is(try('diy_old', 'immed_fail_1','1.1',undef),'!IMM(http://setup.com)'); is(try( 'hsr', 'immed_fail_1','1.1', '2'),'!NOT'); is(try('hsr_old', 'immed_fail_1','1.1', '2'),'!NOT'); is(try( 'diy', 'immed_fail_1','1.1', '2'),'!NOT'); is(try('diy_old', 'immed_fail_1','1.1', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_1','2.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); # is(try('hsr_old', 'immed_fail_1','2.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); # is(try( 'diy', 'immed_fail_1','2.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); # is(try('diy_old', 'immed_fail_1','2.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); # is(try( 'hsr', 'immed_fail_1','2.0', '2'),'!ERR(no_identity: Identity is missing from ID provider response.)'); # is(try('hsr_old', 'immed_fail_1','2.0', '2'),'!ERR(no_identity: Identity is missing from ID provider response.)'); # is(try( 'diy', 'immed_fail_1','2.0', '2'),'!ERR(no_identity: Identity is missing from ID provider response.)'); # is(try('diy_old', 'immed_fail_1','2.0', '2'),'!ERR(no_identity: Identity is missing from ID provider response.)'); # is(try( 'hsr', 'immed_fail_2',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('hsr_old', 'immed_fail_2',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'diy', 'immed_fail_2',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('diy_old', 'immed_fail_2',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2',undef, '2'),'!NOT'); # is(try('hsr_old', 'immed_fail_2',undef, '2'),'!NOT'); # is(try( 'diy', 'immed_fail_2',undef, '2'),'!NOT'); # is(try('diy_old', 'immed_fail_2',undef, '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('hsr_old', 'immed_fail_2','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'diy', 'immed_fail_2','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('diy_old', 'immed_fail_2','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2','1.0', '2'),'!NOT'); # is(try('hsr_old', 'immed_fail_2','1.0', '2'),'!NOT'); # is(try( 'diy', 'immed_fail_2','1.0', '2'),'!NOT'); # is(try('diy_old', 'immed_fail_2','1.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('hsr_old', 'immed_fail_2','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'diy', 'immed_fail_2','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('diy_old', 'immed_fail_2','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2','1.1', '2'),'!NOT'); # is(try('hsr_old', 'immed_fail_2','1.1', '2'),'!NOT'); # is(try( 'diy', 'immed_fail_2','1.1', '2'),'!NOT'); # is(try('diy_old', 'immed_fail_2','1.1', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'immed_fail_2','2.0',undef),'!IMM()'); is(try('hsr_old', 'immed_fail_2','2.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'diy', 'immed_fail_2','2.0',undef),'!IMM()'); is(try('diy_old', 'immed_fail_2','2.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'immed_fail_2','2.0', '2'),'!IMM()'); is(try('hsr_old', 'immed_fail_2','2.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'diy', 'immed_fail_2','2.0', '2'),'!IMM()'); is(try('diy_old', 'immed_fail_2','2.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2s',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('hsr_old', 'immed_fail_2s',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'diy', 'immed_fail_2s',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('diy_old', 'immed_fail_2s',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2s',undef, '2'),'!NOT'); # is(try('hsr_old', 'immed_fail_2s',undef, '2'),'!NOT'); # is(try( 'diy', 'immed_fail_2s',undef, '2'),'!NOT'); # is(try('diy_old', 'immed_fail_2s',undef, '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2s','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('hsr_old', 'immed_fail_2s','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'diy', 'immed_fail_2s','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('diy_old', 'immed_fail_2s','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2s','1.0', '2'),'!NOT'); # is(try('hsr_old', 'immed_fail_2s','1.0', '2'),'!NOT'); # is(try( 'diy', 'immed_fail_2s','1.0', '2'),'!NOT'); # is(try('diy_old', 'immed_fail_2s','1.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2s','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('hsr_old', 'immed_fail_2s','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'diy', 'immed_fail_2s','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('diy_old', 'immed_fail_2s','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2s','1.1', '2'),'!NOT'); # is(try('hsr_old', 'immed_fail_2s','1.1', '2'),'!NOT'); # is(try( 'diy', 'immed_fail_2s','1.1', '2'),'!NOT'); # is(try('diy_old', 'immed_fail_2s','1.1', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'immed_fail_2s','2.0',undef),'!IMM(http://setup.com)'); is(try('hsr_old', 'immed_fail_2s','2.0',undef),'!IMM(http://setup.com)'); is(try( 'diy', 'immed_fail_2s','2.0',undef),'!IMM(http://setup.com)'); is(try('diy_old', 'immed_fail_2s','2.0',undef),'!IMM(http://setup.com)'); is(try( 'hsr', 'immed_fail_2s','2.0', '2'),'!IMM(http://setup.com)'); is(try('hsr_old', 'immed_fail_2s','2.0', '2'),'!IMM(http://setup.com)'); is(try( 'diy', 'immed_fail_2s','2.0', '2'),'!IMM(http://setup.com)'); is(try('diy_old', 'immed_fail_2s','2.0', '2'),'!IMM(http://setup.com)'); is(try( 'hsr', 'cancel',undef,undef),'!CAN'); is(try('hsr_old', 'cancel',undef,undef),'!CAN'); is(try( 'diy', 'cancel',undef,undef),'!CAN'); is(try('diy_old', 'cancel',undef,undef),'!CAN'); is(try( 'hsr', 'cancel',undef, '2'),'!NOT'); is(try('hsr_old', 'cancel',undef, '2'),'!NOT'); is(try( 'diy', 'cancel',undef, '2'),'!NOT'); is(try('diy_old', 'cancel',undef, '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'cancel','1.0',undef),'!CAN'); is(try('hsr_old', 'cancel','1.0',undef),'!CAN'); is(try( 'diy', 'cancel','1.0',undef),'!CAN'); is(try('diy_old', 'cancel','1.0',undef),'!CAN'); is(try( 'hsr', 'cancel','1.0', '2'),'!NOT'); is(try('hsr_old', 'cancel','1.0', '2'),'!NOT'); is(try( 'diy', 'cancel','1.0', '2'),'!NOT'); is(try('diy_old', 'cancel','1.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'cancel','1.1',undef),'!CAN'); is(try('hsr_old', 'cancel','1.1',undef),'!CAN'); is(try( 'diy', 'cancel','1.1',undef),'!CAN'); is(try('diy_old', 'cancel','1.1',undef),'!CAN'); is(try( 'hsr', 'cancel','1.1', '2'),'!NOT'); is(try('hsr_old', 'cancel','1.1', '2'),'!NOT'); is(try( 'diy', 'cancel','1.1', '2'),'!NOT'); is(try('diy_old', 'cancel','1.1', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'cancel','2.0',undef),'!CAN'); is(try('hsr_old', 'cancel','2.0',undef),'!CAN'); is(try( 'diy', 'cancel','2.0',undef),'!CAN'); is(try('diy_old', 'cancel','2.0',undef),'!CAN'); is(try( 'hsr', 'cancel','2.0', '2'),'!CAN'); is(try('hsr_old', 'cancel','2.0', '2'),'!CAN'); is(try( 'diy', 'cancel','2.0', '2'),'!CAN'); is(try('diy_old', 'cancel','2.0', '2'),'!CAN'); is(try( 'hsr', 'badverify',undef,undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('hsr_old', 'badverify',undef,undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'diy', 'badverify',undef,undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('diy_old', 'badverify',undef,undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'hsr', 'badverify',undef, '2'),'!NOT'); is(try('hsr_old', 'badverify',undef, '2'),'!NOT'); is(try( 'diy', 'badverify',undef, '2'),'!NOT'); is(try('diy_old', 'badverify',undef, '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'badverify','1.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('hsr_old', 'badverify','1.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'diy', 'badverify','1.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('diy_old', 'badverify','1.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'hsr', 'badverify','1.0', '2'),'!NOT'); is(try('hsr_old', 'badverify','1.0', '2'),'!NOT'); is(try( 'diy', 'badverify','1.0', '2'),'!NOT'); is(try('diy_old', 'badverify','1.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'badverify','1.1',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('hsr_old', 'badverify','1.1',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'diy', 'badverify','1.1',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('diy_old', 'badverify','1.1',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'hsr', 'badverify','1.1', '2'),'!NOT'); is(try('hsr_old', 'badverify','1.1', '2'),'!NOT'); is(try( 'diy', 'badverify','1.1', '2'),'!NOT'); is(try('diy_old', 'badverify','1.1', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'badverify','2.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('hsr_old', 'badverify','2.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'diy', 'badverify','2.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('diy_old', 'badverify','2.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'hsr', 'badverify','2.0', '2'),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('hsr_old', 'badverify','2.0', '2'),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'diy', 'badverify','2.0', '2'),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('diy_old', 'badverify','2.0', '2'),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'hsr', 'verify',undef,undef),'!VER(http://io.com/rufus)'); is(try('hsr_old', 'verify',undef,undef),'!VER(http://io.com/rufus)'); is(try( 'diy', 'verify',undef,undef),'!VER(http://io.com/rufus)'); is(try('diy_old', 'verify',undef,undef),'!VER(http://io.com/rufus)'); is(try( 'hsr', 'verify',undef, '2'),'!NOT'); is(try('hsr_old', 'verify',undef, '2'),'!NOT'); is(try( 'diy', 'verify',undef, '2'),'!NOT'); is(try('diy_old', 'verify',undef, '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'verify','1.0',undef),'!VER(http://io.com/rufus)'); is(try('hsr_old', 'verify','1.0',undef),'!VER(http://io.com/rufus)'); is(try( 'diy', 'verify','1.0',undef),'!VER(http://io.com/rufus)'); is(try('diy_old', 'verify','1.0',undef),'!VER(http://io.com/rufus)'); is(try( 'hsr', 'verify','1.0', '2'),'!NOT'); is(try('hsr_old', 'verify','1.0', '2'),'!NOT'); is(try( 'diy', 'verify','1.0', '2'),'!NOT'); is(try('diy_old', 'verify','1.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'verify','1.1',undef),'!VER(http://io.com/rufus)'); is(try('hsr_old', 'verify','1.1',undef),'!VER(http://io.com/rufus)'); is(try( 'diy', 'verify','1.1',undef),'!VER(http://io.com/rufus)'); is(try('diy_old', 'verify','1.1',undef),'!VER(http://io.com/rufus)'); is(try( 'hsr', 'verify','1.1', '2'),'!NOT'); is(try('hsr_old', 'verify','1.1', '2'),'!NOT'); is(try( 'diy', 'verify','1.1', '2'),'!NOT'); is(try('diy_old', 'verify','1.1', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'verify','2.0',undef),'!VER(http://io.com/rufus)'); is(try('hsr_old', 'verify','2.0',undef),'!VER(http://io.com/rufus)'); is(try( 'diy', 'verify','2.0',undef),'!VER(http://io.com/rufus)'); is(try('diy_old', 'verify','2.0',undef),'!VER(http://io.com/rufus)'); is(try( 'hsr', 'verify','2.0', '2'),'!VER(http://io.com/rufus)'); is(try('hsr_old', 'verify','2.0', '2'),'!VER(http://io.com/rufus)'); is(try( 'diy', 'verify','2.0', '2'),'!VER(http://io.com/rufus)'); is(try('diy_old', 'verify','2.0', '2'),'!VER(http://io.com/rufus)'); is(try( 'hsr', 'real_bad_mode',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('hsr_old', 'real_bad_mode',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'diy', 'real_bad_mode',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('diy_old', 'real_bad_mode',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'real_bad_mode',undef, '2'),'!NOT'); is(try('hsr_old', 'real_bad_mode',undef, '2'),'!NOT'); is(try( 'diy', 'real_bad_mode',undef, '2'),'!NOT'); is(try('diy_old', 'real_bad_mode',undef, '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'real_bad_mode','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('hsr_old', 'real_bad_mode','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'diy', 'real_bad_mode','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('diy_old', 'real_bad_mode','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'real_bad_mode','1.0', '2'),'!NOT'); is(try('hsr_old', 'real_bad_mode','1.0', '2'),'!NOT'); is(try( 'diy', 'real_bad_mode','1.0', '2'),'!NOT'); is(try('diy_old', 'real_bad_mode','1.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'real_bad_mode','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('hsr_old', 'real_bad_mode','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'diy', 'real_bad_mode','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('diy_old', 'real_bad_mode','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'real_bad_mode','1.1', '2'),'!NOT'); is(try('hsr_old', 'real_bad_mode','1.1', '2'),'!NOT'); is(try( 'diy', 'real_bad_mode','1.1', '2'),'!NOT'); is(try('diy_old', 'real_bad_mode','1.1', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'real_bad_mode','2.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('hsr_old', 'real_bad_mode','2.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'diy', 'real_bad_mode','2.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('diy_old', 'real_bad_mode','2.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'real_bad_mode','2.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('hsr_old', 'real_bad_mode','2.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'diy', 'real_bad_mode','2.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('diy_old', 'real_bad_mode','2.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr','provider_error',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('hsr_old','provider_error',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'diy','provider_error',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('diy_old','provider_error',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr','provider_error',undef, '2'),'!NOT'); # is(try('hsr_old','provider_error',undef, '2'),'!NOT'); # is(try( 'diy','provider_error',undef, '2'),'!NOT'); # is(try('diy_old','provider_error',undef, '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr','provider_error','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('hsr_old','provider_error','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'diy','provider_error','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('diy_old','provider_error','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr','provider_error','1.0', '2'),'!NOT'); # is(try('hsr_old','provider_error','1.0', '2'),'!NOT'); # is(try( 'diy','provider_error','1.0', '2'),'!NOT'); # is(try('diy_old','provider_error','1.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr','provider_error','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('hsr_old','provider_error','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'diy','provider_error','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('diy_old','provider_error','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr','provider_error','1.1', '2'),'!NOT'); # is(try('hsr_old','provider_error','1.1', '2'),'!NOT'); # is(try( 'diy','provider_error','1.1', '2'),'!NOT'); # is(try('diy_old','provider_error','1.1', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr','provider_error','2.0',undef),'!ERR(provider_error: We are out of spoons.)'); is(try('hsr_old','provider_error','2.0',undef),'!ERR(provider_error: We are out of spoons.)'); is(try( 'diy','provider_error','2.0',undef),'!ERR(provider_error: We are out of spoons.)'); is(try('diy_old','provider_error','2.0',undef),'!ERR(provider_error: We are out of spoons.)'); is(try( 'hsr','provider_error','2.0', '2'),'!ERR(provider_error: We are out of spoons.)'); is(try('hsr_old','provider_error','2.0', '2'),'!ERR(provider_error: We are out of spoons.)'); is(try( 'diy','provider_error','2.0', '2'),'!ERR(provider_error: We are out of spoons.)'); is(try('diy_old','provider_error','2.0', '2'),'!ERR(provider_error: We are out of spoons.)'); Net-OpenID-Consumer-1.18/t/03-seminfo.t0000644000175000017500000001503712655770672015543 0ustar rfcrfc#!/usr/bin/perl use warnings; use strict; use Test::More tests => 10; use Net::OpenID::Consumer; use lib 't/lib'; use FakeFetch; my $csr = Net::OpenID::Consumer->new ( consumer_secret => '42' ); my $uri1 = 'http://openid.aol.com/username'; my $p1 = 'https://api.screenname.aol.com/auth/openidServer'; addf_uri($uri1,content => <AOL OpenIdIf not redirected automatically, please click here to continue END is_deeply($csr->_find_semantic_info($uri1), {'openid2.provider'=> $p1, 'openid.server'=>$p1 }, 'aol test'); my $uri2 = 'http://openid.example.com/everything_in_comments'; addf_uri($uri2,content => < Bite me END is_deeply($csr->_find_semantic_info($uri2), {'openid.server'=>'http://www.livejournal.com/misc/openid.bml', 'openid.delegate'=>'http://openid1.net/delegate', 'openid2.provider'=>'http://www.livejournal.com/misc/openid.bml', 'openid2.local_id'=>'http://openid2.net/delegate', 'foaf.maker'=> "foaf:mbox_sha1sum '4caa1d6f6203d21705a00a7aca86203e82a9cf7a'", 'foaf'=>"http://brad.livejournal.com/data/foaf", 'rss'=>"http://www.livejournal.com/~brad/data/rss", 'atom'=>"http://www.livejournal.com/~brad/data/atom", },'everything from consumer.pm comments' ); my $uri3 = 'http://openid.example.com/cdata_crap'; addf_uri($uri3,content => < bitez moi END is_deeply($csr->_find_semantic_info($uri3), {'openid.server'=>'http://www.livejournal.com/misc/openid.bml', 'openid.delegate'=>'http://openid1.net/delegate', 'rss'=>"http://www.livejournal.com/~brad/data/rss", 'atom'=>"http://www.livejournal.com/~brad/data/atom", },'CDATA/comment silliness' ); my $uri4 = 'http://openid.aol.com/oldstyle'; addf_uri($uri4,content => < END is_deeply($csr->_find_semantic_info($uri4), {'openid.delegate'=>'http://openid1.net/delegate'},'HTML 4.0- test'); my $uri4a = 'http://openid.aol.com/oldstyle2'; addf_uri($uri4a,content => < END is_deeply($csr->_find_semantic_info($uri4a), {'openid.delegate'=>'http://openid1.net/delegate?x=1&y=2&z=3'},'HTML 4.0- test'); my $uri5 = 'http://google.com/somewhere'; addf_uri($uri5,content => < OpenID for Google Accounts bye END my $answer5 = {'openid2.provider'=>'http://openid-provider.appspot.com/joey%40kitenet.net', 'openid.server'=>'http://openid-provider.appspot.com/joey%40kitenet.net' }; is_deeply($csr->_find_semantic_info($uri5), $answer5,'link with two refs in it'); is_deeply($csr->_find_semantic_info($uri5), $answer5,'link with two refs in it(again)'); addf_uri($uri5,content => 'randomness'); is_deeply($csr->_find_semantic_info($uri5), $answer5,'link with two refs in it(yet again)'); my $uri4b = 'http://openid.aol.com/oldstyle4b'; addf_uri($uri4b,content => < END is_deeply($csr->_find_semantic_info($uri4b), {'openid.delegate'=>'http://openid1.net/delegate?x=1&y=2&z=3'},'numerical entities'); my $uri6 = 'http://google.com/somewhere6'; addf_uri($uri6,content => < Nice test

Send me your comment:

END is_deeply($csr->_find_semantic_info($uri6), { 'openid2.provider' => 'http://openid.example.com/~user', },'headless injection example'); 1; Net-OpenID-Consumer-1.18/t/02-canonical.t0000644000175000017500000000173112655770672016025 0ustar rfcrfcuse strict; use warnings; no warnings 'redefine'; use Net::OpenID::Consumer; use Test::More; my @tests = qw( example.com http://example.com/ http://example.com http://example.com/ https://example.com https://example.com/ https://example.com/ https://example.com/ http://example.com/user http://example.com/user http://example.com/user/ http://example.com/user/ http://example.com/ http://example.com/ ); { use integer; plan tests => (@tests / 2); } # stop Consumer to fetch HTML content from the URL local *Net::OpenID::Consumer::_find_semantic_info = sub { my($self, $url, $final_url_ref) = @_; $$final_url_ref = $url; return { "openid.server" => "http://example.com/op" }; }; local *Net::OpenID::Yadis::discover = sub {}; while (my($url, $normalized) = splice(@tests, 0, 2)) { my $csr = Net::OpenID::Consumer->new; my $identity = $csr->claimed_identity($url); is $identity->claimed_url, $normalized, "$url -> $normalized"; } Net-OpenID-Consumer-1.18/t/lib/0000775000175000017500000000000012655770672014240 5ustar rfcrfcNet-OpenID-Consumer-1.18/t/lib/FakeFetch.pm0000644000175000017500000000760012655770672016417 0ustar rfcrfcpackage FakeFetch; # networkless URIFetch::fetch() # SYNOPSIS # use strict; use warnings; use vars qw/@EXPORT @ISA/; @ISA = qw/Exporter/; @EXPORT = qw( uri_scenario resetf addf_dead_h addf_404_h addf_500_h addf_dead_uri addf_404_uri addf_500_uri addf_dead_ure addf_404_ure addf_500_ure addf_h addf_uri addf_ure ); # copied from URIFetch::fetch my @useful_headers = qw(last-modified etag content-type x-yadis-location x-xrds-location); # list of { ure => regexp, final_uri => ..., code => 200, content => , [ => ,...]} our @fetchables = (); sub resetf { @fetchables = (); } sub uri_scenario { my ($code) = @_; local @fetchables = (); $code->(); } my @respond_dead = (code => '000'); my @respond_404 = (code => '404', content =>'Not Found -- random text'); my @respond_500 = (code => '500', content =>'Internal Error -- random text'); sub addf_dead_h { addf_h(@respond_dead, @_); } sub addf_404_h { addf_h(@respond_404, @_); } sub addf_500_h { addf_h(@respond_500, @_); } sub addf_dead_uri { addf_uri(@respond_dead, @_); } sub addf_404_uri { addf_uri(@respond_404, @_); } sub addf_500_uri { addf_uri(@respond_500, @_); } sub addf_dead_ure { addf_ure(@respond_dead, @_); } sub addf_404_ure { addf_ure(@respond_404, @_); } sub addf_500_ure { addf_ure(@respond_500, @_); } sub addf_h { my (%bad) = @_; my %h = map {exists $bad{$_} ? ($_,delete $bad{$_}) : ()} @useful_headers, qw(uri ure final_uri code content); die 'unexpected params: '.join(',',keys %bad) if keys %bad; if ($h{uri}) { die 'uri and ure' if $h{ure}; $h{ure} = qr/^$h{uri}$/; $h{final_uri} = $h{uri} unless $h{final_uri}; } elsif (!$h{ure}) { die 'need uri or ure'; } $h{code} = 200 unless $h{code}; die 'weird code' unless $h{code} =~ m/^[02-5]\d\d$/; unless ($h{content}) { $h{content} = ''; } unshift @fetchables, \%h; } sub addf_uri { my $uri = shift; addf_h(uri => $uri, @_); } sub addf_ure { my $ure = shift; addf_h(ure => $ure, @_); } our %fake_cache = (); sub _my_fetch { my ($class, $uri, $consumer, $content_hook, $prefix) = @_; $prefix ||= ''; # keep behavior of actual URI::Fetch->fetch() if ($uri eq 'x-xrds-location') { Carp::confess("Buh?"); } my $cache_key = "URIFetch:${prefix}:${uri}"; if (my $blob = $fake_cache{$cache_key}) { my $ref = Storable::thaw($blob); return Net::OpenID::URIFetch::Response->new( status => 200, content => $ref->{Content}, headers => $ref->{Headers}, final_uri => $ref->{FinalURI}, ); } # pretend to get $uri # $req = HTTP::Request->new(GET => $uri); # $res = $ua->request($req); # $content = $res->content; # $final_uri = $res->request->uri->as_string(); foreach my $f (@fetchables) { next if $uri !~ $f->{ure}; return if $f->{code} eq '000'; my $content = $f->{content}; if ($content_hook) { $content_hook->(\$content); } my $headers = {}; foreach my $k (@useful_headers) { $headers->{$k} = $f->{$k}; } my $final_uri = $f->{final_uri} || $uri; if ($f->{code} == 200) { my $cache_data = { Headers => $headers, Content => $content, FinalURI => $final_uri, CacheTime => time(), }; my $cache_blob = Storable::freeze($cache_data); my $final_cache_key = "URIFetch:${prefix}:${final_uri}"; $fake_cache{$final_cache_key} = $cache_blob; $fake_cache{$cache_key} = $cache_blob; } return Net::OpenID::URIFetch::Response->new ( status => $f->{code}, final_uri => $final_uri, content => $content, headers => $headers, ); } diag("unexpected URI: $uri") } no warnings; *Net::OpenID::URIFetch::fetch = \&_my_fetch; 1; Net-OpenID-Consumer-1.18/t/release-pod-syntax.t0000644000175000017500000000045612655770672017406 0ustar rfcrfc#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use Test::More; use Test::Pod 1.41; all_pod_files_ok(); Net-OpenID-Consumer-1.18/Makefile.PL0000644000175000017500000000271512655770672015204 0ustar rfcrfc # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.020. use strict; use warnings; use ExtUtils::MakeMaker ; my %WriteMakefileArgs = ( "ABSTRACT" => "Library for consumers of OpenID identities", "AUTHOR" => "Robert Norris , Roger Crew ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Net-OpenID-Consumer", "EXE_FILES" => [], "LICENSE" => "perl", "NAME" => "Net::OpenID::Consumer", "PREREQ_PM" => { "Digest::SHA" => 0, "HTTP::Request" => 0, "JSON" => 0, "LWP::UserAgent" => 0, "MIME::Base64" => 0, "Net::OpenID::Common" => "1.19", "Storable" => 0, "Time::Local" => 0, "URI" => 0 }, "TEST_REQUIRES" => { "CGI" => 0, "Test::More" => 0 }, "VERSION" => "1.18", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "CGI" => 0, "Digest::SHA" => 0, "HTTP::Request" => 0, "JSON" => 0, "LWP::UserAgent" => 0, "MIME::Base64" => 0, "Net::OpenID::Common" => "1.19", "Storable" => 0, "Test::More" => 0, "Time::Local" => 0, "URI" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); Net-OpenID-Consumer-1.18/xt/0000775000175000017500000000000012655770672013662 5ustar rfcrfcNet-OpenID-Consumer-1.18/xt/04-handler.t0000644000175000017500000006307412655770672015715 0ustar rfcrfc#!/usr/bin/perl use warnings; use strict; use Test::More tests => 176; # use lib '/home/rfc/src/git/Net-OpenID-Consumer/lib'; # use lib '/home/rfc/src/git/Net-OpenID-Common/lib'; use lib 't/lib'; use Net::OpenID::Consumer; print $INC{'Net/OpenID/Consumer.pm'},"\n"; sub fake_verified_identity { # extremely simplified version that only looks at .mode and .identity # and does not do any discovery/check_authentication callouts my $csr = shift; return $csr->_fail("bad_mode") unless $csr->_message_mode_is("id_res"); return $csr->_fail("no_identity") unless my $id = $csr->message('identity'); # pretend everything worked my $v = Net::OpenID::VerifiedIdentity->new(consumer => $csr, signed_fields => {}); $v->{'identity'} = $csr->message('identity'); return $v; } { no warnings 'redefine'; *Net::OpenID::Consumer::verified_identity = \&fake_verified_identity; } my $the_log = ''; my @common_callbacks = ( not_openid => sub { $the_log .= '!NOT'; }, cancelled => sub { $the_log .= '!CAN'; }, verified => sub { my $url = $_[0]->url; $the_log .= "!VER($url)"; }, error => sub { $the_log .= "!ERR($_[0]: $_[1])"; }, ); my $the_csr; my @handlers = ( hsr => sub { $the_csr->handle_server_response( @common_callbacks, setup_needed => sub { my $u = $the_csr->user_setup_url || ''; $the_log .= "!IMM($u)"; }, ); }, hsr_old => sub { $the_csr->handle_server_response( @common_callbacks, setup_required => sub { my $u = shift || ''; $the_log .= "!IMM($u)"; }, ); }, diy => sub { # current DIY code unless ($the_csr->is_server_response) { $the_log .= "!NOT"; } elsif ($the_csr->setup_needed) { my $u = $the_csr->user_setup_url || ''; $the_log .= "!IMM($u)"; } elsif ($the_csr->user_cancel) { # restore web app state to prior to check_url $the_log .= "!CAN"; } elsif (my $vident = $the_csr->verified_identity) { my $url = $vident->url; $the_log .= "!VER($url)"; } else { my $e = $the_csr->err; $the_log .= "!ERR($e)"; } }, diy_old => sub { # DIY code from 1.03 synopsis if (my $url = $the_csr->user_setup_url) { $the_log .= "!IMM($url)"; } elsif ($the_csr->user_cancel) { # restore web app state to prior to check_url $the_log .= "!CAN"; } elsif (my $vident = $the_csr->verified_identity) { my $url = $vident->url; $the_log .= "!VER($url)"; } else { my $e = $the_csr->err; $the_log .= "!ERR($e)"; } }, ); my @messages = qw( immed_fail_1 openid.mode=id_res&openid.user_setup_url=http://setup.com immed_fail_2 openid.mode=setup_needed immed_fail_2s openid.mode=setup_needed&openid.user_setup_url=http://setup.com cancel openid.mode=cancel&openid.user_setup_url=http://setup.com badverify openid.mode=id_res verify openid.mode=id_res&openid.identity=http://io.com/rufus real_bad_mode openid.mode=only_slightly_biffle_dinked provider_error openid.mode=error&openid.error=We%20are%20out%20of%20spoons. ); my $i; my %messages = @messages; @messages = do { $i=0; grep {++$i % 2} @messages }; my %handlers = @handlers; @handlers = do { $i=0; grep {++$i % 2} @handlers }; # Nonsense combinations my %nonsense = map {($_,1)} qw(1immed_fail_2 1immed_fail_2s 1provider_error 2immed_fail_1); sub try { my ($hkey,$msg,$vm,$v2c) = @_; $the_csr = Net::OpenID::Consumer->new ( $v2c ? (minimum_version => 2) : (), args => { (!$vm ? () : ("openid.ns", ($vm >= 2 ? "http://specs.openid.net/auth/$vm" : "http://openid.net/signon/$vm"))), map {s/%20/ /g; split '='} split '&',$messages{$msg} }, ); $the_log = ''; $handlers{$hkey}->(); return $the_log; } # for my $m (@messages) { # for my $vm (undef,'1.0','1.1','2.0') { # for my $v2c (undef, 2) { # for my $h (@handlers) { # # next unless $h eq 'diy' || $h eq 'hsr'; # print # ($nonsense{($vm ? substr($vm,0,1) : '1') . $m} ? '# ' : ''), # "is(try(", # sprintf('%9s,%16s,%5s,%5s',map {defined($_) ? "'$_'" : 'undef'} $h,$m,$vm,$v2c), # "),'", # try($h,$m,$vm,$v2c),"');\n"; # } # } # } # } is(try( 'hsr', 'immed_fail_1',undef,undef),'!IMM(http://setup.com)'); is(try('hsr_old', 'immed_fail_1',undef,undef),'!IMM(http://setup.com)'); is(try( 'diy', 'immed_fail_1',undef,undef),'!IMM(http://setup.com)'); is(try('diy_old', 'immed_fail_1',undef,undef),'!IMM(http://setup.com)'); is(try( 'hsr', 'immed_fail_1',undef, '2'),'!NOT'); is(try('hsr_old', 'immed_fail_1',undef, '2'),'!NOT'); is(try( 'diy', 'immed_fail_1',undef, '2'),'!NOT'); is(try('diy_old', 'immed_fail_1',undef, '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'immed_fail_1','1.0',undef),'!IMM(http://setup.com)'); is(try('hsr_old', 'immed_fail_1','1.0',undef),'!IMM(http://setup.com)'); is(try( 'diy', 'immed_fail_1','1.0',undef),'!IMM(http://setup.com)'); is(try('diy_old', 'immed_fail_1','1.0',undef),'!IMM(http://setup.com)'); is(try( 'hsr', 'immed_fail_1','1.0', '2'),'!NOT'); is(try('hsr_old', 'immed_fail_1','1.0', '2'),'!NOT'); is(try( 'diy', 'immed_fail_1','1.0', '2'),'!NOT'); is(try('diy_old', 'immed_fail_1','1.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'immed_fail_1','1.1',undef),'!IMM(http://setup.com)'); is(try('hsr_old', 'immed_fail_1','1.1',undef),'!IMM(http://setup.com)'); is(try( 'diy', 'immed_fail_1','1.1',undef),'!IMM(http://setup.com)'); is(try('diy_old', 'immed_fail_1','1.1',undef),'!IMM(http://setup.com)'); is(try( 'hsr', 'immed_fail_1','1.1', '2'),'!NOT'); is(try('hsr_old', 'immed_fail_1','1.1', '2'),'!NOT'); is(try( 'diy', 'immed_fail_1','1.1', '2'),'!NOT'); is(try('diy_old', 'immed_fail_1','1.1', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_1','2.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); # is(try('hsr_old', 'immed_fail_1','2.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); # is(try( 'diy', 'immed_fail_1','2.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); # is(try('diy_old', 'immed_fail_1','2.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); # is(try( 'hsr', 'immed_fail_1','2.0', '2'),'!ERR(no_identity: Identity is missing from ID provider response.)'); # is(try('hsr_old', 'immed_fail_1','2.0', '2'),'!ERR(no_identity: Identity is missing from ID provider response.)'); # is(try( 'diy', 'immed_fail_1','2.0', '2'),'!ERR(no_identity: Identity is missing from ID provider response.)'); # is(try('diy_old', 'immed_fail_1','2.0', '2'),'!ERR(no_identity: Identity is missing from ID provider response.)'); # is(try( 'hsr', 'immed_fail_2',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('hsr_old', 'immed_fail_2',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'diy', 'immed_fail_2',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('diy_old', 'immed_fail_2',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2',undef, '2'),'!NOT'); # is(try('hsr_old', 'immed_fail_2',undef, '2'),'!NOT'); # is(try( 'diy', 'immed_fail_2',undef, '2'),'!NOT'); # is(try('diy_old', 'immed_fail_2',undef, '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('hsr_old', 'immed_fail_2','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'diy', 'immed_fail_2','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('diy_old', 'immed_fail_2','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2','1.0', '2'),'!NOT'); # is(try('hsr_old', 'immed_fail_2','1.0', '2'),'!NOT'); # is(try( 'diy', 'immed_fail_2','1.0', '2'),'!NOT'); # is(try('diy_old', 'immed_fail_2','1.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('hsr_old', 'immed_fail_2','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'diy', 'immed_fail_2','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('diy_old', 'immed_fail_2','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2','1.1', '2'),'!NOT'); # is(try('hsr_old', 'immed_fail_2','1.1', '2'),'!NOT'); # is(try( 'diy', 'immed_fail_2','1.1', '2'),'!NOT'); # is(try('diy_old', 'immed_fail_2','1.1', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'immed_fail_2','2.0',undef),'!IMM()'); is(try('hsr_old', 'immed_fail_2','2.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'diy', 'immed_fail_2','2.0',undef),'!IMM()'); is(try('diy_old', 'immed_fail_2','2.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'immed_fail_2','2.0', '2'),'!IMM()'); is(try('hsr_old', 'immed_fail_2','2.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'diy', 'immed_fail_2','2.0', '2'),'!IMM()'); is(try('diy_old', 'immed_fail_2','2.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2s',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('hsr_old', 'immed_fail_2s',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'diy', 'immed_fail_2s',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('diy_old', 'immed_fail_2s',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2s',undef, '2'),'!NOT'); # is(try('hsr_old', 'immed_fail_2s',undef, '2'),'!NOT'); # is(try( 'diy', 'immed_fail_2s',undef, '2'),'!NOT'); # is(try('diy_old', 'immed_fail_2s',undef, '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2s','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('hsr_old', 'immed_fail_2s','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'diy', 'immed_fail_2s','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('diy_old', 'immed_fail_2s','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2s','1.0', '2'),'!NOT'); # is(try('hsr_old', 'immed_fail_2s','1.0', '2'),'!NOT'); # is(try( 'diy', 'immed_fail_2s','1.0', '2'),'!NOT'); # is(try('diy_old', 'immed_fail_2s','1.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2s','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('hsr_old', 'immed_fail_2s','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'diy', 'immed_fail_2s','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('diy_old', 'immed_fail_2s','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr', 'immed_fail_2s','1.1', '2'),'!NOT'); # is(try('hsr_old', 'immed_fail_2s','1.1', '2'),'!NOT'); # is(try( 'diy', 'immed_fail_2s','1.1', '2'),'!NOT'); # is(try('diy_old', 'immed_fail_2s','1.1', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'immed_fail_2s','2.0',undef),'!IMM(http://setup.com)'); is(try('hsr_old', 'immed_fail_2s','2.0',undef),'!IMM(http://setup.com)'); is(try( 'diy', 'immed_fail_2s','2.0',undef),'!IMM(http://setup.com)'); is(try('diy_old', 'immed_fail_2s','2.0',undef),'!IMM(http://setup.com)'); is(try( 'hsr', 'immed_fail_2s','2.0', '2'),'!IMM(http://setup.com)'); is(try('hsr_old', 'immed_fail_2s','2.0', '2'),'!IMM(http://setup.com)'); is(try( 'diy', 'immed_fail_2s','2.0', '2'),'!IMM(http://setup.com)'); is(try('diy_old', 'immed_fail_2s','2.0', '2'),'!IMM(http://setup.com)'); is(try( 'hsr', 'cancel',undef,undef),'!CAN'); is(try('hsr_old', 'cancel',undef,undef),'!CAN'); is(try( 'diy', 'cancel',undef,undef),'!CAN'); is(try('diy_old', 'cancel',undef,undef),'!CAN'); is(try( 'hsr', 'cancel',undef, '2'),'!NOT'); is(try('hsr_old', 'cancel',undef, '2'),'!NOT'); is(try( 'diy', 'cancel',undef, '2'),'!NOT'); is(try('diy_old', 'cancel',undef, '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'cancel','1.0',undef),'!CAN'); is(try('hsr_old', 'cancel','1.0',undef),'!CAN'); is(try( 'diy', 'cancel','1.0',undef),'!CAN'); is(try('diy_old', 'cancel','1.0',undef),'!CAN'); is(try( 'hsr', 'cancel','1.0', '2'),'!NOT'); is(try('hsr_old', 'cancel','1.0', '2'),'!NOT'); is(try( 'diy', 'cancel','1.0', '2'),'!NOT'); is(try('diy_old', 'cancel','1.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'cancel','1.1',undef),'!CAN'); is(try('hsr_old', 'cancel','1.1',undef),'!CAN'); is(try( 'diy', 'cancel','1.1',undef),'!CAN'); is(try('diy_old', 'cancel','1.1',undef),'!CAN'); is(try( 'hsr', 'cancel','1.1', '2'),'!NOT'); is(try('hsr_old', 'cancel','1.1', '2'),'!NOT'); is(try( 'diy', 'cancel','1.1', '2'),'!NOT'); is(try('diy_old', 'cancel','1.1', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'cancel','2.0',undef),'!CAN'); is(try('hsr_old', 'cancel','2.0',undef),'!CAN'); is(try( 'diy', 'cancel','2.0',undef),'!CAN'); is(try('diy_old', 'cancel','2.0',undef),'!CAN'); is(try( 'hsr', 'cancel','2.0', '2'),'!CAN'); is(try('hsr_old', 'cancel','2.0', '2'),'!CAN'); is(try( 'diy', 'cancel','2.0', '2'),'!CAN'); is(try('diy_old', 'cancel','2.0', '2'),'!CAN'); is(try( 'hsr', 'badverify',undef,undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('hsr_old', 'badverify',undef,undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'diy', 'badverify',undef,undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('diy_old', 'badverify',undef,undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'hsr', 'badverify',undef, '2'),'!NOT'); is(try('hsr_old', 'badverify',undef, '2'),'!NOT'); is(try( 'diy', 'badverify',undef, '2'),'!NOT'); is(try('diy_old', 'badverify',undef, '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'badverify','1.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('hsr_old', 'badverify','1.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'diy', 'badverify','1.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('diy_old', 'badverify','1.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'hsr', 'badverify','1.0', '2'),'!NOT'); is(try('hsr_old', 'badverify','1.0', '2'),'!NOT'); is(try( 'diy', 'badverify','1.0', '2'),'!NOT'); is(try('diy_old', 'badverify','1.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'badverify','1.1',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('hsr_old', 'badverify','1.1',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'diy', 'badverify','1.1',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('diy_old', 'badverify','1.1',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'hsr', 'badverify','1.1', '2'),'!NOT'); is(try('hsr_old', 'badverify','1.1', '2'),'!NOT'); is(try( 'diy', 'badverify','1.1', '2'),'!NOT'); is(try('diy_old', 'badverify','1.1', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'badverify','2.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('hsr_old', 'badverify','2.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'diy', 'badverify','2.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('diy_old', 'badverify','2.0',undef),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'hsr', 'badverify','2.0', '2'),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('hsr_old', 'badverify','2.0', '2'),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'diy', 'badverify','2.0', '2'),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try('diy_old', 'badverify','2.0', '2'),'!ERR(no_identity: Identity is missing from ID provider response.)'); is(try( 'hsr', 'verify',undef,undef),'!VER(http://io.com/rufus)'); is(try('hsr_old', 'verify',undef,undef),'!VER(http://io.com/rufus)'); is(try( 'diy', 'verify',undef,undef),'!VER(http://io.com/rufus)'); is(try('diy_old', 'verify',undef,undef),'!VER(http://io.com/rufus)'); is(try( 'hsr', 'verify',undef, '2'),'!NOT'); is(try('hsr_old', 'verify',undef, '2'),'!NOT'); is(try( 'diy', 'verify',undef, '2'),'!NOT'); is(try('diy_old', 'verify',undef, '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'verify','1.0',undef),'!VER(http://io.com/rufus)'); is(try('hsr_old', 'verify','1.0',undef),'!VER(http://io.com/rufus)'); is(try( 'diy', 'verify','1.0',undef),'!VER(http://io.com/rufus)'); is(try('diy_old', 'verify','1.0',undef),'!VER(http://io.com/rufus)'); is(try( 'hsr', 'verify','1.0', '2'),'!NOT'); is(try('hsr_old', 'verify','1.0', '2'),'!NOT'); is(try( 'diy', 'verify','1.0', '2'),'!NOT'); is(try('diy_old', 'verify','1.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'verify','1.1',undef),'!VER(http://io.com/rufus)'); is(try('hsr_old', 'verify','1.1',undef),'!VER(http://io.com/rufus)'); is(try( 'diy', 'verify','1.1',undef),'!VER(http://io.com/rufus)'); is(try('diy_old', 'verify','1.1',undef),'!VER(http://io.com/rufus)'); is(try( 'hsr', 'verify','1.1', '2'),'!NOT'); is(try('hsr_old', 'verify','1.1', '2'),'!NOT'); is(try( 'diy', 'verify','1.1', '2'),'!NOT'); is(try('diy_old', 'verify','1.1', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'verify','2.0',undef),'!VER(http://io.com/rufus)'); is(try('hsr_old', 'verify','2.0',undef),'!VER(http://io.com/rufus)'); is(try( 'diy', 'verify','2.0',undef),'!VER(http://io.com/rufus)'); is(try('diy_old', 'verify','2.0',undef),'!VER(http://io.com/rufus)'); is(try( 'hsr', 'verify','2.0', '2'),'!VER(http://io.com/rufus)'); is(try('hsr_old', 'verify','2.0', '2'),'!VER(http://io.com/rufus)'); is(try( 'diy', 'verify','2.0', '2'),'!VER(http://io.com/rufus)'); is(try('diy_old', 'verify','2.0', '2'),'!VER(http://io.com/rufus)'); is(try( 'hsr', 'real_bad_mode',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('hsr_old', 'real_bad_mode',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'diy', 'real_bad_mode',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('diy_old', 'real_bad_mode',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'real_bad_mode',undef, '2'),'!NOT'); is(try('hsr_old', 'real_bad_mode',undef, '2'),'!NOT'); is(try( 'diy', 'real_bad_mode',undef, '2'),'!NOT'); is(try('diy_old', 'real_bad_mode',undef, '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'real_bad_mode','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('hsr_old', 'real_bad_mode','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'diy', 'real_bad_mode','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('diy_old', 'real_bad_mode','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'real_bad_mode','1.0', '2'),'!NOT'); is(try('hsr_old', 'real_bad_mode','1.0', '2'),'!NOT'); is(try( 'diy', 'real_bad_mode','1.0', '2'),'!NOT'); is(try('diy_old', 'real_bad_mode','1.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'real_bad_mode','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('hsr_old', 'real_bad_mode','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'diy', 'real_bad_mode','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('diy_old', 'real_bad_mode','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'real_bad_mode','1.1', '2'),'!NOT'); is(try('hsr_old', 'real_bad_mode','1.1', '2'),'!NOT'); is(try( 'diy', 'real_bad_mode','1.1', '2'),'!NOT'); is(try('diy_old', 'real_bad_mode','1.1', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'real_bad_mode','2.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('hsr_old', 'real_bad_mode','2.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'diy', 'real_bad_mode','2.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('diy_old', 'real_bad_mode','2.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr', 'real_bad_mode','2.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('hsr_old', 'real_bad_mode','2.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'diy', 'real_bad_mode','2.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try('diy_old', 'real_bad_mode','2.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr','provider_error',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('hsr_old','provider_error',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'diy','provider_error',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('diy_old','provider_error',undef,undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr','provider_error',undef, '2'),'!NOT'); # is(try('hsr_old','provider_error',undef, '2'),'!NOT'); # is(try( 'diy','provider_error',undef, '2'),'!NOT'); # is(try('diy_old','provider_error',undef, '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr','provider_error','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('hsr_old','provider_error','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'diy','provider_error','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('diy_old','provider_error','1.0',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr','provider_error','1.0', '2'),'!NOT'); # is(try('hsr_old','provider_error','1.0', '2'),'!NOT'); # is(try( 'diy','provider_error','1.0', '2'),'!NOT'); # is(try('diy_old','provider_error','1.0', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr','provider_error','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('hsr_old','provider_error','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'diy','provider_error','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try('diy_old','provider_error','1.1',undef),'!ERR(bad_mode: The openid.mode argument is not correct)'); # is(try( 'hsr','provider_error','1.1', '2'),'!NOT'); # is(try('hsr_old','provider_error','1.1', '2'),'!NOT'); # is(try( 'diy','provider_error','1.1', '2'),'!NOT'); # is(try('diy_old','provider_error','1.1', '2'),'!ERR(bad_mode: The openid.mode argument is not correct)'); is(try( 'hsr','provider_error','2.0',undef),'!ERR(provider_error: We are out of spoons.)'); is(try('hsr_old','provider_error','2.0',undef),'!ERR(provider_error: We are out of spoons.)'); is(try( 'diy','provider_error','2.0',undef),'!ERR(provider_error: We are out of spoons.)'); is(try('diy_old','provider_error','2.0',undef),'!ERR(provider_error: We are out of spoons.)'); is(try( 'hsr','provider_error','2.0', '2'),'!ERR(provider_error: We are out of spoons.)'); is(try('hsr_old','provider_error','2.0', '2'),'!ERR(provider_error: We are out of spoons.)'); is(try( 'diy','provider_error','2.0', '2'),'!ERR(provider_error: We are out of spoons.)'); is(try('diy_old','provider_error','2.0', '2'),'!ERR(provider_error: We are out of spoons.)'); Net-OpenID-Consumer-1.18/xt/03-providers.t0000644000175000017500000000126112655770672016302 0ustar rfcrfc#!/usr/bin/perl use strict; use warnings; use Net::OpenID::Consumer; use Test::More; my @tests = qw( https://www.google.com/accounts/o8/id http://openid.aol.com/joe http://test.myopenid.com/ http://flickr.com/test/ http://test.wordpress.com/ http://test.blogspot.com/ http://test.myvidoop.com/ http://claimid.com/test/ http://lj.livejournal.com/ http://me.yahoo.com ); # http://technorati.com/people/technorati/test { use integer; plan tests => scalar @tests; } for my $url ( @tests ) { my $csr = Net::OpenID::Consumer->new; my $identity = $csr->claimed_identity($url); ok $identity, "Got a claimed identity for $url"; } Net-OpenID-Consumer-1.18/examples/0000775000175000017500000000000012655770672015045 5ustar rfcrfcNet-OpenID-Consumer-1.18/examples/consumer.cgi0000644000175000017500000002476312655770672017376 0ustar rfcrfc#!/usr/bin/env perl # Simple OpenID consumer/relying party # Robert Norris, November 2010 # Public domain # This program demonstrates the use of Net::OpenID::Consumer to build an # OpenID consumer/relying party (RP). It is not intended to be production # quality, but just show the basics needed to get an RP up and running. It # uses CGI.pm since everyone understands that :) use warnings; use strict; use CGI (); use CGI::Carp qw(fatalsToBrowser); use Net::OpenID::Consumer 1.030099; use LWP::UserAgent; my $cgi = CGI->new; # determine our location and the auth realm based on the enviroment my $realm = 'http://'.$ENV{HTTP_HOST}; my $base = $realm.$ENV{SCRIPT_NAME}; # get the parameters from the browser into something useable my $params = {$cgi->Vars}; # figure out what the caller is trying to do. there are three options: # root: present a form where the user can enter their openid. this function # would be part of your normal login page # login: the target for the login form. this too is probably already a part of # your application/framework # callback: the place the OpenID Provider (OP) redirects the browser to once # it has completed the authentication process (pass or failure) my $action = delete $params->{action} || 'root'; if ($action !~ m{\A root | login | callback \z}x) { print $cgi->header(-status => 404); exit; } # arrange for the handler method to be called my $method = "handle_$action"; my $ret = do { no strict 'refs'; $method->($realm, $base, $params) }; # handle the return. these handlers return PSGI three-part arrays, so you # could easily port them to your PSGI-based application. here we convert that # into something to send back through CGI.pm my ($status, $headers, $content) = @$ret; push @$headers, ( Pragma => 'no-cache' ); my %headers; while (my ($k, $v) = splice @$headers, 0, 2) { $headers{"-$k"} = $v; } print $cgi->header(-status => $status, %headers); print join '', @$content; exit; # root action handler. all this does is serve a simple login page. you would # probably want to add openid as an option to your login page instead sub handle_root { my ($realm, $base, $params) = @_; my $html = < OpenID: HTML ; return [ 200, [ 'Content-Type' => 'text/html' ], [ $html ] ]; } # login action handler. takes an openid received from the login page and # begins the auth process sub handle_login { my ($realm, $base, $params) = @_; # get an Net::OpenID::Consumer object configured the way we want it my $consumer = _get_openid_context($params); # create a Net::OpenID::ClaimedIdentity object based on the entered # openid. this method will lookup the openid url (HTML or XRDS) to get the # openid server endpoint my $claimed_identity = $consumer->claimed_identity($params->{openid}); # if we fail to get the claimed identity it means either the identity is # invalid (eg malformed) or the endpoint could not be determined. the # Consumer object provides more detail about what happened via its error # methods if (! $claimed_identity) { return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Invalid identity: '.$consumer->err ] ]; } # the claimed identity is valid, so now we need to build a url on the OP # to redirect the browser to my $check_url = $claimed_identity->check_url( # this is the url the OP should redirect the browser to when its # authentication process is completed return_to => $base.'?action=callback', # this tells the OP what uri this login will be applied to. the OP is # being asked to verify if the identifier is valid for every uri # "under" this one. this is typically presented to the user by the OP # in a "do you trust this?" type of dialog trust_root => $realm, # enabling delayed_return tells the OP that it now has full control of # the browser and can do whatever it likes (eg several screens worth # of authentication flow) before returning the browser back to us (ie # openid.mode = checkid_setup) # # if you want to do the login in the background via javascript, you'd set # this to 0 (ie checkid_immediate) so that the javascript code can # fail directly and cause the display to either prompt the user to # login manually with their provider or launch another openID login # from a visible window (where you *can* set delayed_return to 1) delayed_return => 1, ); # redirect the browser to the OP return [ 301, [ Location => $check_url ], [] ]; } # callback action handler. the OP redirects the browser here in response to # the process begun in handle_login. usually thats after the auth process has # completed successfully, but failures (eg user denying access) will also come # here and need to be handled sub handle_callback { my ($realm, $base, $params) = @_; # get the Net::OpenID::Consumer object my $consumer = _get_openid_context($params); # call the response handler. it takes a few coderefs to handle the various # things that might be received from the OP. the data returned by the # coderef is what will be returned by the handler return $consumer->handle_server_response( # not_openid is called when the parameters passed to the callback url # don't represent a valid openid message. this means either the OP is # broken or (more likely) a user is trying to access the callback url # directly. there's not much you can do here other than fail # gracefully. not_openid => sub { return [ 200, [ 'Content-Type' => 'text/plain', ], [ 'Not an OpenID message.' ] ]; }, # since we have delayed_return == 1 above # covering the setup_needed case is not actually necessary setup_needed => sub { # this might be version 1.1 and setup_url may have been # been provided, in which case we could redirect if ($consumer->message->protocol_version < 2) { my $setup_url = $consumer->user_setup_url; return [ 301, [ Location => $setup_url ], [] ] if ($setup_url); } return [ 200, [ 'Content-Type' => 'text/plain', ], [ 'You must login with your provider first.' ] ]; }, # cancelled is called when the OP informs us that the user cancelled # the login process in some way. this is typically a result of the # user answering "no" or "deny" to a "do you trust this site" type of # message cancelled => sub { return [ 200, [ 'Content-Type' => 'text/plain', ], [ 'User cancelled login process.' ] ]; }, # verified is called when the OP informs us that it believes that the # user owns the claimed identity. that usually means the user # successfully authenticated with the OP and agreed to trust your # application. the user's identity uri is passed to the sub. this is # not necessarily the same as the claimed identifier used to begin the # login process, but it will be unique and specific to this user. # typically at this point you will use the identity as the primary key # to load or create a user account in your application verified => sub { my ($verified_identity) = @_; return [ 200, [ 'Content-Type' => 'text/plain', ], [ 'Verified identity: '.$verified_identity->url ] ]; }, # any other error will be reported here. the Consumer object will make # more information about the error available via its error methods error => sub { my ($error) = @_; return [ 200, [ 'Content-Type' => 'text/plain', ], [ 'Error: '.$consumer->err ] ]; }, ); } # helper function to prepare a Consumer object sub _get_openid_context { my ($params) = @_; my $consumer = Net::OpenID::Consumer->new( # ua takes a LWP::UserAgent object that will be used fetch the # identity url provided by the user. Since this can be an # arbitrary URL it's possible for a user to make your # application to a fetch on some other url on its behalf, # possibly something inside your firewall. # If that's a problem for you, consider vetting the identifer # provided by the user or subclassing LWP::UserAgent to # protect against such things (see LWPx::ParanoidAgent for an # example of this) ua => LWP::UserAgent->new, # args can take a number of different objects that may contain # the request parameters from the browser, eg a CGI, # Apache::Request, Apache2::Request or similar (see the # documentation for more). if a coderef is provided (as is the # case here), it will either be passed a single argument # containing the wanted parameter, in which case it should # return the value of that parameter (or undef if not # available), or it will be passed no arguments and the full # list of parameter names should be returned args => sub { @_ ? $params->{+shift} : keys %$params }, # consumer_secret takes a coderef that is called to generate the # "nonce" value for the return_to uri. it is passed a single argument # containing a unix timestamp and should produce a unique, # reproducable and non-guessable value based on that time. if this # value does not meet those criteria your RP is vulnerable to replay # attacks # # for the sake of this demo we return a static string here. you MUST # NOT do this in a production environment consumer_secret => sub { return 'xyz789' }, ); return $consumer; } __END__ =pod =head1 NAME consumer.cgi - demo OpenID consumer/relying party using Net::OpenID::Consumer =head1 DESCRIPTION This program demonstrates the use of Net::OpenID::Consumer to build an OpenID consumer/relying party (RP). It is not intended to be production quality, but just show the basics needed to get an RP up and running. It should work under pretty much any web server that can run CGI programs. Its been tested under lighttpd on Linux. Read the code to find out how it all works! =head1 AUTHOR Robert Norris Erob@eatenbyagrue.orgE =head1 LICENSE This program is in the public domain. =cut Net-OpenID-Consumer-1.18/lib/0000775000175000017500000000000012655770672013775 5ustar rfcrfcNet-OpenID-Consumer-1.18/lib/Net/0000775000175000017500000000000012655770672014523 5ustar rfcrfcNet-OpenID-Consumer-1.18/lib/Net/OpenID/0000775000175000017500000000000012655770672015641 5ustar rfcrfcNet-OpenID-Consumer-1.18/lib/Net/OpenID/Consumer.pm0000644000175000017500000020437712655770672020005 0ustar rfcrfc# LICENSE: You're free to distribute this under the same terms as Perl itself. use strict; use Carp (); ############################################################################ package Net::OpenID::Consumer; $Net::OpenID::Consumer::VERSION = '1.18'; use fields ( 'cache', # Cache object to store HTTP responses, # associations, and nonces 'ua', # LWP::UserAgent instance to use 'args', # how to get at your args 'message', # args interpreted as an IndirectMessage, if possible 'consumer_secret', # scalar/subref 'required_root', # the default required_root value, or undef 'last_errcode', # last error code we got 'last_errtext', # last error code we got 'debug', # debug flag or codeblock 'minimum_version', # The minimum protocol version to support 'assoc_options', # options for establishing ID provider associations 'nonce_options', # options for dealing with nonces ); use Net::OpenID::ClaimedIdentity; use Net::OpenID::VerifiedIdentity; use Net::OpenID::Association; use Net::OpenID::Yadis; use Net::OpenID::IndirectMessage; use Net::OpenID::URIFetch; use Net::OpenID::Common; # To get the OpenID::util package use MIME::Base64 (); use Digest::SHA qw(hmac_sha1_hex); use Time::Local; use HTTP::Request; use LWP::UserAgent; use Storable; use JSON qw(encode_json); use URI::Escape qw(uri_escape_utf8); use HTML::Parser; sub new { my Net::OpenID::Consumer $self = shift; $self = fields::new( $self ) unless ref $self; my %opts = @_; $self->{ua} = delete $opts{ua}; $self->args ( delete $opts{args} ); $self->cache ( delete $opts{cache} ); $self->consumer_secret ( delete $opts{consumer_secret} ); $self->required_root ( delete $opts{required_root} ); $self->minimum_version ( delete $opts{minimum_version} ); $self->assoc_options ( delete $opts{assoc_options} ); $self->nonce_options ( delete $opts{nonce_options} ); $self->{debug} = delete $opts{debug}; Carp::croak("Unknown options: " . join(", ", keys %opts)) if %opts; return $self; } # NOTE: This method is here only to support the openid-test library. # Don't call it from anywhere else, or you'll break when it gets # removed. Instead, call minimum_version(2). # FIXME: Can we just make openid-test do that and get rid of this? sub disable_version_1 { $_[0]->minimum_version(2); } sub cache { &_getset; } sub consumer_secret { &_getset; } sub required_root { &_getset; } sub assoc_options { &_hashgetset } sub nonce_options { &_hashgetset } sub _getset { my Net::OpenID::Consumer $self = shift; my $param = (caller(1))[3]; $param =~ s/.+:://; if (@_) { my $val = shift; Carp::croak("Too many parameters") if @_; $self->{$param} = $val; } return $self->{$param}; } sub _hashgetset { my Net::OpenID::Consumer $self = shift; my $param = (caller(1))[3]; $param =~ s/.+:://; my $check_param = "_canonicalize_$param"; my $v; if (scalar(@_) == 1) { $v = shift; unless ($v) { $v = {}; } elsif (ref $v eq 'ARRAY') { $v = {@$v}; } elsif (ref $v) { # assume it's a hash and hope for the best $v = {%$v}; } else { Carp::croak("single argument must be HASH or ARRAY reference"); } $self->{$param} = $self->$check_param($v); } elsif (@_) { Carp::croak("odd number of parameters?") if scalar(@_)%2; $self->{$param} = $self->$check_param({@_}); } return $self->{$param}; } sub minimum_version { my Net::OpenID::Consumer $self = shift; if (@_) { my $minv = shift; Carp::croak("Too many parameters") if @_; $minv = 1 unless $minv && $minv > 1; $self->{minimum_version} = $minv; } return $self->{minimum_version}; } sub _canonicalize_assoc_options { return $_[1]; } sub _debug { my Net::OpenID::Consumer $self = shift; return unless $self->{debug}; if (ref $self->{debug} eq "CODE") { $self->{debug}->($_[0]); } else { print STDERR "[DEBUG Net::OpenID::Consumer] $_[0]\n"; } } # given something that can have GET arguments, returns a subref to get them: # Apache # Apache::Request # CGI # HASH of get args # CODE returning get arg, given key # ... sub args { my Net::OpenID::Consumer $self = shift; if (my $what = shift) { unless (ref $what) { return $self->{args} ? $self->{args}->($what) : Carp::croak("No args defined"); } Carp::croak("Too many parameters") if @_; # since we do not require field setters to be called in any particular order, # we cannot pass minimum_version here as it might change later. my $message = Net::OpenID::IndirectMessage->new($what); $self->{message} = $message; if ($message) { $self->{args} = $message->getter; # handle OpenID 2.0 'error' mode # (may as well do this here; we may not get another chance # since handle_server_response is not a required part of the API) if ($message->protocol_version >= 2 && $message->mode eq 'error') { $self->_fail('provider_error',$message->get('error')); } } else { $self->{args} = sub { undef }; } } $self->{args}; } sub message { my Net::OpenID::Consumer $self = shift; my $message = $self->{message}; return undef unless $message && ($self->{minimum_version} <= $message->protocol_version); if (@_) { return $message->get($_[0]); } else { return $message; } } sub _message_mode_is { return (($_[0]->message('mode')||' ') eq $_[1]); } sub _message_version { my $message = $_[0]->message; return $message ? $message->protocol_version : 0; } sub ua { my Net::OpenID::Consumer $self = shift; $self->{ua} = shift if @_; Carp::croak("Too many parameters") if @_; # make default one on first access unless ($self->{ua}) { my $ua = $self->{ua} = LWP::UserAgent->new; $ua->timeout(10); } $self->{ua}; } our %Error_text = ( 'bad_mode' => "The openid.mode argument is not correct", 'bogus_delegation' => "Asserted identity does not match claimed_id or local_id.", 'bogus_return_to' => "Return URL does not match required_root.", 'bogus_url' => "URL scheme must be http: or https:", 'empty_url' => "No URL entered.", 'expired_association' => "Association between ID provider and relying party has expired.", 'naive_verify_failed_network' => sub { @_ ? "Unexpected verification response from ID provider: $_[0]" : "Could not contact ID provider to verify response." }, 'naive_verify_failed_return' => "Direct contact invalidated ID provider response.", 'no_identity' => "Identity is missing from ID provider response.", 'no_identity_server' => "Could not determine ID provider from URL.", 'no_return_to' => "Return URL is missing from ID provider response.", 'no_sig' => "Signature is missing from ID provider response.", 'protocol_version_incorrect' => "ID provider does not support minimum protocol version", 'provider_error' => "ID provider-specific error", 'server_not_allowed' => "None of the discovered endpoints matches op_endpoint.", 'signature_mismatch' => "Prior association invalidated ID provider response.", 'time_bad_sig' => "Return_to signature is not valid.", 'time_expired' => "Return_to signature is stale.", 'time_in_future' => "Return_to signature is from the future.", 'unexpected_url_redirect' => "Discovery for the given ID ended up at the wrong place", 'unsigned_field' => sub { "Field(s) must be signed: " . join(", ", @_) }, 'nonce_missing' => "Response_nonce is missing from ID provider response.", 'nonce_reused' => 'Re-used response_nonce; possible replay attempt.', 'nonce_stale' => 'Stale response_nonce; could have been used before.', 'nonce_format' => 'Bad timestamp format in response_nonce.', 'nonce_future' => 'Provider clock is too far forward.', # no longer used as of 1.11 # 'no_head_tag' => "Could not determine ID provider; URL document has no .", # 'url_fetch_err' => "Error fetching the provided URL.", ); sub _fail { my Net::OpenID::Consumer $self = shift; my ($code, $text, @params) = @_; # 'bad_mode' is only an error if we survive to the end of # .mode dispatch without having figured out what to do; # it should not overwrite other errors. unless ($self->{last_errcode} && $code eq 'bad_mode') { $text ||= $Error_text{$code}; $text = $text->(@params) if ref($text) && ref($text) eq 'CODE'; $self->{last_errcode} = $code; $self->{last_errtext} = $text; $self->_debug("fail($code) $text"); } wantarray ? () : undef; } sub json_err { my Net::OpenID::Consumer $self = shift; return encode_json({ err_code => $self->{last_errcode}, err_text => $self->{last_errtext}, }); } sub err { my Net::OpenID::Consumer $self = shift; $self->{last_errcode} . ": " . $self->{last_errtext}; } sub errcode { my Net::OpenID::Consumer $self = shift; $self->{last_errcode}; } sub errtext { my Net::OpenID::Consumer $self = shift; $self->{last_errtext}; } # make sure you change the $prefix every time you change the $hook format # so that when user installs a new version and the old cache server is # still running the old cache entries won't confuse things. sub _get_url_contents { my Net::OpenID::Consumer $self = shift; my ($url, $final_url_ref, $hook, $prefix) = @_; $final_url_ref ||= do { my $dummy; \$dummy; }; my $res = Net::OpenID::URIFetch->fetch($url, $self, $hook, $prefix); $$final_url_ref = $res->final_uri; return $res ? $res->content : undef; } # List of head elements that matter for HTTP discovery. # Each entry defines a key+value that will appear in the # _find_semantic_info hash if the specified element exists # [ # FSI_KEY -- key name # TAG_NAME -- must be 'link' or 'meta' # # ELT_VALUES -- string (default = FSI_KEY) # what join(';',values of ELT_KEYS) has to match # in order for a given html element to provide # the value for FSI_KEY # # ELT_KEYS -- list-ref of html attribute names # default = ['rel'] for # default = ['name'] for # # FSI_VALUE -- name of html attribute where value lives # default = 'href' for # default = 'content' for # ] # our @HTTP_discovery_link_meta_tags = map { my ($fsi_key, $tag, $elt_value, $elt_keys, $fsi_value) = @{$_}; [$fsi_key, $tag, $elt_value || $fsi_key, $elt_keys || [$tag eq 'link' ? 'rel' : 'name'], $fsi_value || ($tag eq 'link' ? 'href' : 'content'), ] } # OpenID providers / delegated identities # # # [qw(openid.server link)], # 'openid.server' => ['rel'], 'href' [qw(openid.delegate link)], # OpenID2 providers / local identifiers # # # [qw(openid2.provider link)], [qw(openid2.local_id link)], # FOAF maker info # # [qw(foaf.maker meta foaf:maker)], # == .name # FOAF documents # # [qw(foaf link), 'meta;foaf;application/rdf+xml' => [qw(rel title type)]], # RSS # # [qw(rss link), 'alternate;application/rss+xml' => [qw(rel type)]], # Atom # # [qw(atom link), 'alternate;application/atom+xml' => [qw(rel type)]], ; sub _document_to_semantic_info { my $doc = shift; my $info = {}; my $elts = OpenID::util::html_extract_linkmetas($doc); for (@HTTP_discovery_link_meta_tags) { my ($key, $tag, $elt_value, $elt_keys, $vattrib) = @$_; for my $lm (@{$elts->{$tag}}) { $info->{$key} = $lm->{$vattrib} if $elt_value eq join ';', map {lc($lm->{$_}||'')} @$elt_keys; } } return $info; } sub _find_semantic_info { my Net::OpenID::Consumer $self = shift; my $url = shift; my $final_url_ref = shift; my $doc = $self->_get_url_contents($url, $final_url_ref); my $info = _document_to_semantic_info($doc); $self->_debug("semantic info ($url) = " . join(", ", map { $_.' => '.$info->{$_} } keys %$info)) if $self->{debug}; return $info; } sub _find_openid_server { my Net::OpenID::Consumer $self = shift; my $url = shift; my $final_url_ref = shift; my $sem_info = $self->_find_semantic_info($url, $final_url_ref) or return; return $self->_fail("no_identity_server") unless $sem_info->{"openid.server"}; $sem_info->{"openid.server"}; } sub is_server_response { my Net::OpenID::Consumer $self = shift; return $self->message ? 1 : 0; } my $_warned_about_setup_required = 0; sub handle_server_response { my Net::OpenID::Consumer $self = shift; my %callbacks_in = @_; my %callbacks = (); foreach my $cb (qw(not_openid cancelled verified error)) { $callbacks{$cb} = delete($callbacks_in{$cb}) || sub { Carp::croak("No ".$cb." callback") }; } # backwards compatibility: # 'setup_needed' is expected as of 1.04 # 'setup_required' is deprecated but allowed in its place, my $found_setup_callback = 0; foreach my $cb (qw(setup_needed setup_required)) { $callbacks{$cb} = delete($callbacks_in{$cb}) and $found_setup_callback++; } Carp::croak($found_setup_callback > 1 ? "Cannot have both setup_needed and setup_required" : "No setup_needed callback") unless $found_setup_callback == 1; if (warnings::enabled('deprecated') && $callbacks{setup_required} && !$_warned_about_setup_required++ ) { warnings::warn ("deprecated", "'setup_required' callback is deprecated, use 'setup_needed'"); } Carp::croak("Unknown callbacks: ".join(',', keys %callbacks_in)) if %callbacks_in; unless ($self->is_server_response) { return $callbacks{not_openid}->(); } if ($self->setup_needed) { return $callbacks{setup_needed}->() unless ($callbacks{setup_required}); my $setup_url = $self->user_setup_url; return $callbacks{setup_required}->($setup_url) if $setup_url; # otherwise FALL THROUGH to preserve prior behavior, # Even though this is broken, old clients could have # put a workaround into the 'error' callback to handle # the setup_needed+(setup_url=undef) case } if ($self->user_cancel) { return $callbacks{cancelled}->(); } elsif (my $vident = $self->verified_identity) { return $callbacks{verified}->($vident); } else { return $callbacks{error}->($self->errcode, $self->errtext); } } sub _canonicalize_id_url { my Net::OpenID::Consumer $self = shift; my $url = shift; # trim whitespace $url =~ s/^\s+//; $url =~ s/\s+$//; return $self->_fail("empty_url") unless $url; # add scheme $url = "http://$url" if $url && $url !~ m!^\w+://!; return $self->_fail("bogus_url") unless $url =~ m!^https?://!i; # make sure there is a slash after the hostname $url .= "/" unless $url =~ m!^https?://.+/!i; return $url; } # always returns a listref; might be empty, though sub _discover_acceptable_endpoints { my Net::OpenID::Consumer $self = shift; my $url = shift; #already canonicalized ID url my %opts = @_; # if return_early is set, we'll return as soon as we have enough # information to determine the "primary" endpoint, and return # that as the first (and possibly only) item in our response. my $primary_only = delete $opts{primary_only} ? 1 : 0; # if force_version is set, we only return endpoints that have # that have {version} == $force_version my $force_version = delete $opts{force_version}; Carp::croak("Unknown option(s) ".join(', ', keys(%opts))) if %opts; my @discovered_endpoints = (); my $result = sub { # We always prefer 2.0 endpoints to 1.1 ones, regardless of # the priority chosen by the identifier. return [ (grep { $_->{version} == 2 } @discovered_endpoints), (grep { $_->{version} == 1 } @discovered_endpoints), ]; }; # TODO: Support XRI too? # First we Yadis service discovery my $yadis = Net::OpenID::Yadis->new(consumer => $self); if ($yadis->discover($url)) { # FIXME: Currently we don't ever do _find_semantic_info in the Yadis # code path, so an extra redundant HTTP request is done later # when the semantic info is accessed. my $final_url = $yadis->identity_url; my @services = $yadis->services( OpenID::util::version_2_xrds_service_url(), OpenID::util::version_2_xrds_directed_service_url(), OpenID::util::version_1_xrds_service_url(), ); my $version2 = OpenID::util::version_2_xrds_service_url(); my $version1 = OpenID::util::version_1_xrds_service_url(); my $version2_directed = OpenID::util::version_2_xrds_directed_service_url(); foreach my $service (@services) { my $service_uris = $service->URI; # Service->URI seems to return all sorts of bizarre things, so let's # normalize it to always be an arrayref. if (ref($service_uris) eq 'ARRAY') { my @sorted_id_servers = sort { my $pa = $a->{priority}; my $pb = $b->{priority}; defined($pb) <=> defined($pa) || (defined($pa) ? ($pa <=> $pb) : 0) } @$service_uris; $service_uris = \@sorted_id_servers; } if (ref($service_uris) eq 'HASH') { $service_uris = [ $service_uris->{content} ]; } unless (ref($service_uris)) { $service_uris = [ $service_uris ]; } my $delegate = undef; my @versions = (); if (grep(/^${version2}$/, $service->Type)) { # We have an OpenID 2.0 end-user identifier $delegate = $service->extra_field("LocalID"); push @versions, 2; } if (grep(/^${version1}$/, $service->Type)) { # We have an OpenID 1.1 end-user identifier $delegate = $service->extra_field("Delegate", "http://openid.net/xmlns/1.0"); push @versions, 1; } if (@versions) { foreach my $version (@versions) { next if defined($force_version) && $force_version != $version; foreach my $uri (@$service_uris) { push @discovered_endpoints, { uri => $uri, version => $version, final_url => $final_url, delegate => $delegate, sem_info => undef, mechanism => "Yadis", }; } } } if (((!defined($force_version)) || $force_version == 2) && grep(/^${version2_directed}$/, $service->Type)) { # We have an OpenID 2.0 OP identifier (i.e. we're doing directed identity) my $version = 2; # In this case, the user's claimed identifier is a magic value # and the actual identifier will be determined by the provider. my $final_url = OpenID::util::version_2_identifier_select_url(); my $delegate = OpenID::util::version_2_identifier_select_url(); foreach my $uri (@$service_uris) { push @discovered_endpoints, { uri => $uri, version => $version, final_url => $final_url, delegate => $delegate, sem_info => undef, mechanism => "Yadis", }; } } if ($primary_only && scalar(@discovered_endpoints)) { # We've got at least one endpoint now, so return early return $result->(); } } } # Now HTML-based discovery, both 2.0- and 1.1-style. { my $final_url = undef; my $sem_info = $self->_find_semantic_info($url, \$final_url); if ($sem_info) { if ($sem_info->{"openid2.provider"}) { unless (defined($force_version) && $force_version != 2) { push @discovered_endpoints, { uri => $sem_info->{"openid2.provider"}, version => 2, final_url => $final_url, delegate => $sem_info->{"openid2.local_id"}, sem_info => $sem_info, mechanism => "HTML", }; } } if ($sem_info->{"openid.server"}) { unless (defined($force_version) && $force_version != 1) { push @discovered_endpoints, { uri => $sem_info->{"openid.server"}, version => 1, final_url => $final_url, delegate => $sem_info->{"openid.delegate"}, sem_info => $sem_info, mechanism => "HTML", }; } } } } return $result->(); } # returns Net::OpenID::ClaimedIdentity sub claimed_identity { my Net::OpenID::Consumer $self = shift; my $url = shift; Carp::croak("Too many parameters") if @_; return unless $url = $self->_canonicalize_id_url($url); my $endpoints = $self->_discover_acceptable_endpoints($url, primary_only => 1); if (@$endpoints) { foreach my $endpoint (@$endpoints) { next unless $endpoint->{version} >= $self->minimum_version; $self->_debug("Discovered version $endpoint->{version} endpoint at $endpoint->{uri} via $endpoint->{mechanism}"); $self->_debug("Delegate is $endpoint->{delegate}") if $endpoint->{delegate}; return Net::OpenID::ClaimedIdentity->new( identity => $endpoint->{final_url}, server => $endpoint->{uri}, consumer => $self, delegate => $endpoint->{delegate}, protocol_version => $endpoint->{version}, semantic_info => $endpoint->{sem_info}, ); } # If we've fallen out here, then none of the available services are of the required version. return $self->_fail("protocol_version_incorrect"); } else { return $self->_fail("no_identity_server"); } } sub user_cancel { my Net::OpenID::Consumer $self = shift; return $self->_message_mode_is("cancel"); } sub setup_needed { my Net::OpenID::Consumer $self = shift; if ($self->_message_version == 1) { return $self->_message_mode_is("id_res") && $self->message("user_setup_url"); } else { return $self->_message_mode_is('setup_needed'); } } sub user_setup_url { my Net::OpenID::Consumer $self = shift; my %opts = @_; my $post_grant = delete $opts{'post_grant'}; Carp::croak("Unknown options: " . join(", ", keys %opts)) if %opts; if ($self->_message_version == 1) { return $self->_fail("bad_mode") unless $self->_message_mode_is("id_res"); } else { return undef unless $self->_message_mode_is('setup_needed'); } my $setup_url = $self->message("user_setup_url"); OpenID::util::push_url_arg(\$setup_url, "openid.post_grant", $post_grant) if $setup_url && $post_grant; return $setup_url; } sub verified_identity { my Net::OpenID::Consumer $self = shift; my %opts = @_; my $rr = delete $opts{'required_root'} || $self->{required_root}; Carp::croak("Unknown options: " . join(", ", keys %opts)) if %opts; return $self->_fail("bad_mode") unless $self->_message_mode_is("id_res"); # the asserted identity (the delegated one, if there is one, since the protocol # knows nothing of the original URL) my $a_ident = $self->message("identity") or return $self->_fail("no_identity"); my $sig64 = $self->message("sig") or return $self->_fail("no_sig"); # fix sig if the OpenID provider failed to properly escape pluses (+) in the sig $sig64 =~ s/ /+/g; my $returnto = $self->message("return_to") or return $self->_fail("no_return_to"); my $signed = $self->message("signed"); my $possible_endpoints; my $server; my $claimed_identity; my $real_ident = ($self->_message_version == 1 ? $self->args("oic.identity") : $self->message("claimed_id") ) || $a_ident; my $real_canon = $self->_canonicalize_id_url($real_ident); return $self->_fail("no_identity_server") unless ($real_canon && @{ $possible_endpoints = $self->_discover_acceptable_endpoints ($real_canon, force_version => $self->_message_version) }); # FIXME: It kinda sucks that the above will always do both Yadis and HTML discovery, even though # in most cases only one will be in use. if ($self->_message_version == 1) { # In version 1, we have to assume that the primary server # found during discovery is the one sending us this message. splice(@$possible_endpoints,1); $server = $possible_endpoints->[0]->{uri}; $self->_debug("Server is $server"); } else { # In version 2, the OpenID provider tells us its URL. $server = $self->message("op_endpoint"); $self->_debug("Server is $server"); # but make sure that URL matches one of the discovered ones. @$possible_endpoints = grep {$_->{uri} eq $server} @$possible_endpoints or return $self->_fail("server_not_allowed"); } # check that returnto is for the right host return $self->_fail("bogus_return_to") if $rr && $returnto !~ /^\Q$rr\E/; my $now = time(); # check that we have not seen response_nonce before my $response_nonce = $self->message("response_nonce"); unless ($response_nonce) { # 1.0/1.1 does not require nonces return $self->_fail("nonce_missing") if $self->_message_version >= 2; } else { return unless $self->_nonce_check_succeeds($now, $server, $response_nonce); } # check age/signature of return_to { my ($sig_time, $sig) = split(/\-/, $self->args("oic.time") || ""); # complain if more than an hour since we sent them off return $self->_fail("time_expired") if $sig_time < $now - 3600; # also complain if the signature is from the future by more than 30 seconds, # which compensates for potential clock drift between nodes in a web farm. return $self->_fail("time_in_future") if $sig_time - 30 > $now; # and check that the time isn't faked my $c_secret = $self->_get_consumer_secret($sig_time); my $good_sig = substr(hmac_sha1_hex($sig_time, $c_secret), 0, 20); return $self->_fail("time_bad_sig") unless OpenID::util::timing_indep_eq($sig, $good_sig); } my $last_error = undef; my $error = sub { $self->_debug("$server not acceptable: ".$_[0]); $last_error = $_[0]; }; foreach my $endpoint (@$possible_endpoints) { # Known: # $endpoint->{version} == $self->_message_version # $endpoint->{uri} == $server my $final_url = $endpoint->{final_url}; my $delegate = $endpoint->{delegate}; # OpenID 2.0 wants us to exclude the fragment part of the URL when doing equality checks my $a_ident_nofragment = $a_ident; my $real_ident_nofragment = $real_ident; my $final_url_nofragment = $final_url; if ($self->_message_version >= 2) { $a_ident_nofragment =~ s/\#.*$//x; $real_ident_nofragment =~ s/\#.*$//x; $final_url_nofragment =~ s/\#.*$//x; } unless ($final_url_nofragment eq $real_ident_nofragment) { $error->("unexpected_url_redirect"); next; } # if openid.delegate was used, check that it was done correctly if ($a_ident_nofragment ne $real_ident_nofragment) { unless ($delegate eq $a_ident_nofragment) { $error->("bogus_delegation"); next; } } # If we've got this far then we've found the right endpoint. $claimed_identity = Net::OpenID::ClaimedIdentity->new( identity => $endpoint->{final_url}, server => $endpoint->{uri}, consumer => $self, delegate => $endpoint->{delegate}, protocol_version => $endpoint->{version}, semantic_info => $endpoint->{sem_info}, ); last; } unless ($claimed_identity) { # We failed to find a good endpoint in the above loop, so # lets bail out. return $self->_fail($last_error); } my $assoc_handle = $self->message("assoc_handle"); $self->_debug("verified_identity: assoc_handle" . ($assoc_handle ? ": $assoc_handle" : " missing")); my $assoc = Net::OpenID::Association::handle_assoc($self, $server, $assoc_handle); my @signed_fields = grep {m/^[\w\.]+$/} split(/,/, $signed); my %signed_value = map {$_,$self->args("openid.$_")} @signed_fields; # Auth 2.0 requires certain keys to be signed. if ($self->_message_version >= 2) { my %unsigned; # these fields must be signed unconditionally foreach my $f (qw/op_endpoint return_to response_nonce assoc_handle/) { $unsigned{$f}++ unless exists $signed_value{$f}; } # these fields must be signed if present foreach my $f (qw/claimed_id identity/) { $unsigned{$f}++ if $self->args("openid.$f") && !exists $signed_value{$f}; } if (%unsigned) { return $self->_fail("unsigned_field", undef, keys %unsigned); } } if ($assoc) { $self->_debug("verified_identity: verifying with found association"); return $self->_fail("expired_association") if $assoc->expired; # verify the token my $token = join '',map {"$_:$signed_value{$_}\n"} @signed_fields; utf8::encode($token); my $good_sig = $assoc->generate_signature($token); return $self->_fail("signature_mismatch") unless OpenID::util::timing_indep_eq($sig64, $good_sig); } else { $self->_debug("verified_identity: verifying using HTTP (dumb mode)"); # didn't find an association. have to do dumb consumer mode # and check it with a POST my %post; my @mkeys; if ($self->_message_version >= 2 && (@mkeys = $self->message->all_parameters)) { # OpenID 2.0: copy *EVERYTHING*, not just signed parameters. # (XXX: Do we need to copy non "openid." parameters as well? # For now, assume if provider is sending them, there is a reason) %post = map {$_ eq 'openid.mode' ? () : ($_, $self->args($_)) } @mkeys; } else { # OpenID 1.1 *OR* legacy client did not provide a proper # enumerator; in the latter case under 2.0 we have no # choice but to send a partial (1.1-style) # check_authentication request and hope for the best. %post = ( "openid.assoc_handle" => $assoc_handle, "openid.signed" => $signed, "openid.sig" => $sig64, ); if ($self->_message_version >= 2) { $post{'openid.ns'} = OpenID::util::VERSION_2_NAMESPACE(); } # and copy in all signed parameters that we don't already have into %post $post{"openid.$_"} = $signed_value{$_} foreach grep {!exists $post{"openid.$_"}} @signed_fields; # if the provider told us our handle as bogus, let's ask in our # check_authentication mode whether that's true if (my $ih = $self->message("invalidate_handle")) { $post{"openid.invalidate_handle"} = $ih; } } $post{"openid.mode"} = "check_authentication"; my $req = HTTP::Request->new(POST => $server); $req->header("Content-Type" => "application/x-www-form-urlencoded"); $req->content(join("&", map { "$_=" . uri_escape_utf8($post{$_}) } keys %post)); my $ua = $self->ua; my $res = $ua->request($req); return $self->_fail("naive_verify_failed_network", ($res ? ($res->status_line) : ())) unless $res && $res->is_success; my $content = $res->content; my %args = OpenID::util::parse_keyvalue($content); # delete the handle from our cache if (my $ih = $args{'invalidate_handle'}) { Net::OpenID::Association::invalidate_handle($self, $server, $ih); } return $self->_fail("naive_verify_failed_return") unless $args{'is_valid'} eq "true" || # protocol 1.1 $args{'lifetime'} > 0; # DEPRECATED protocol 1.0 } $self->_debug("verified identity! = $real_ident"); # verified! return Net::OpenID::VerifiedIdentity->new( claimed_identity => $claimed_identity, consumer => $self, signed_fields => \%signed_value, ); } sub supports_consumer_secret { 1; } sub _get_consumer_secret { my Net::OpenID::Consumer $self = shift; my $time = shift; my $ss; if (ref $self->{consumer_secret} eq "CODE") { $ss = $self->{consumer_secret}; } elsif ($self->{consumer_secret}) { $ss = sub { return $self->{consumer_secret}; }; } else { Carp::croak("You haven't defined a consumer_secret value or subref.\n"); } my $sec = $ss->($time); Carp::croak("Consumer secret too long") if length($sec) > 255; return $sec; } our $nonce_default_delay = 1200; our $nonce_default_skew = 300; sub _canonicalize_nonce_options { my Net::OpenID::Consumer $self = shift; my $o = shift; my ($no_check,$ignore_time,$lifetime,$window,$start,$skew,$timecop) = delete @{$o}{qw(no_check ignore_time lifetime window start skew timecop)}; Carp::croak("Unrecognized nonce_options: ".join(',',keys %$o)) if keys %$o; return +{ no_check => 1 } if ($no_check); return +{ window => 0, lifetime => ($lifetime && $lifetime > 0 ? $lifetime : 0), } if ($ignore_time); $window = defined($lifetime) ? $lifetime : $nonce_default_delay + 2*(defined($skew) && $skew > $nonce_default_skew ? $skew : $nonce_default_skew) unless (defined($window)); $lifetime = $window unless (defined($lifetime)); $lifetime = 0 if $lifetime < 0; $window = 0 if $window < 0; $skew = $window < 2*$nonce_default_skew ? $window/2 : $nonce_default_skew unless (defined($skew)); Carp::croak("Unrecognized nonce_options: ".join(',',keys %$o)) if keys %$o; return +{ window => $window, lifetime => $lifetime, skew => $skew, defined($start) ? (start => $start) : (), }; } # The contract: # IF the provider adheres to protocol and is properly configured # which, for our purposes here means # (1) it sends properly formatted nonces # that reflect provider clock time and # (2) provider clock is not skewed from our own by more than # (the maximum acceptable) # AND # we have a cache that can reliably hold onto entries # for at least seconds # THEN we must not accept a duplicate nonce. # # Preconditions imply that no message with this nonce will be received # prior to - (i.e., provider clock is running # maximally fast and there is no transmission delay). If our cache # start time is prior to this and the lifetime of cache entries is # long enough, then we can know for certain that it's not a duplicate, # otherwise we do not and therefore must reject it. # # If we detect an instance where preconditions do not hold, there is # not much we can do: rejecting nonces in this case will not make the # protocol more secure. As long as the provider's clock is skewed too # far forward, an attacker will be able to take advantage of it. Best # we can do is issue warnings, which is the point of 'timecop', but if # there's no place to send the warnings, then it's a waste of time. # sub _nonce_check_succeeds { my Net::OpenID::Consumer $self = shift; my ($now, $uri, $nonce) = @_; my $o = $self->nonce_options; my $cache = $self->cache; return 1 if $o->{no_check} || !$cache; my $cache_key = "nonce:$uri:$nonce"; return $self->_fail('nonce_reused') if ($cache->get($cache_key)); $cache->set($cache_key, 1, ($o->{lifetime} ? ($now + $o->{lifetime}) : ())); return 1 unless $o->{window} || $o->{start}; # parse RFC3336 timestamp restricted as per 10.1 my ($year,$mon,$day,$hour,$min,$sec) = $nonce =~ m/^([0-9]{4})-([0-9]{2})-([0-9]{2})T([0-9]{2}):([0-9]{2}):([0-9]{2})Z/ or return $self->_fail('nonce_format'); # $nonce_time is a lower bound on when the nonce could have been # received according to our clock my $nonce_time = eval { timegm($sec,$min,$hour,$day,$mon-1,$year) - $o->{skew} }; return $self->_fail('nonce_format') if $@; # nonces from the future indicate misconfigured providers # that we can do nothing about except give warnings return !$o->{timecop} || $self->_fail('nonce_future') if ($now < $nonce_time); # the check that matters return $self->_fail('nonce_stale') if ($o->{window} && $nonce_time < $now - $o->{window}) || ($o->{start} && $nonce_time < $o->{start}); # win return 1; } 1; __END__ =head1 NAME Net::OpenID::Consumer - Library for consumers of OpenID identities =head1 VERSION version 1.18 =head1 SYNOPSIS use Net::OpenID::Consumer; my $csr = Net::OpenID::Consumer->new( ua => LWPx::ParanoidAgent->new, cache => Cache::File->new( cache_root => '/tmp/mycache' ), args => $cgi, consumer_secret => ..., required_root => "http://site.example.com/", assoc_options => [ max_encrypt => 1, session_no_encrypt_https => 1, ], ); # Say a user enters "bradfitz.com" as his/her identity. The first # step is to perform discovery, i.e., fetch that page, parse it, # find out the actual identity provider and other useful information, # which gets encapsulated in a Net::OpenID::ClaimedIdentity object: my $claimed_identity = $csr->claimed_identity("bradfitz.com"); unless ($claimed_identity) { die "not actually an openid? " . $csr->err; } # We can then launch the actual authentication of this identity. # The first step is to redirect the user to the appropriate URL at # the identity provider. This URL is constructed as follows: # my $check_url = $claimed_identity->check_url( return_to => "http://example.com/openid-check.app?yourarg=val", trust_root => "http://example.com/", # to do a "checkid_setup mode" request, in which the user can # interact with the provider, e.g., so that the user can sign in # there if s/he has not done so already, you will need this, delayed_return => 1 # otherwise, this will be a "check_immediate mode" request, the # provider will have to immediately return some kind of answer # without interaction ); # Once you redirect the user to $check_url, the provider should # eventually redirect back, at which point you need some kind of # handler at openid-check.app to deal with that response. # You can either use the callback-based API (recommended)... # $csr->handle_server_response( not_openid => sub { die "Not an OpenID message"; }, setup_needed => sub { if ($csr->message->protocol_version >= 2) { # (OpenID 2) retry request in checkid_setup mode (above) } else { # (OpenID 1) redirect user to $csr->user_setup_url } }, cancelled => sub { # User hit cancel; restore application state prior to check_url }, verified => sub { my ($vident) = @_; my $verified_url = $vident->url; print "You are $verified_url !"; }, error => sub { my ($errcode,$errtext) = @_; die("Error validating identity: $errcode: $errcode"); }, ); # ... or handle the various cases yourself # unless ($csr->is_server_response) { die "Not an OpenID message"; } elsif ($csr->setup_needed) { # (OpenID 2) retry request in checkid_setup mode # (OpenID 1) redirect/link/popup user to $csr->user_setup_url } elsif ($csr->user_cancel) { # User hit cancel; restore application state prior to check_url } elsif (my $vident = $csr->verified_identity) { my $verified_url = $vident->url; print "You are $verified_url !"; } else { die "Error validating identity: " . $csr->err; } =head1 DESCRIPTION This is the Perl API for (the consumer half of) OpenID, a distributed identity system based on proving you own a URL, which is then your identity. More information is available at: http://openid.net/ =head1 CONSTRUCTOR =over 4 =item B my $csr = Net::OpenID::Consumer->new( %options ); The following option names are recognized: C, C, C, C, C, C, C, and C in the constructor. In each case the option value is treated exactly as the argument to the corresponding method described below under L. =back =head1 METHODS =head2 State =over 4 =item $csr->B($key) Returns the value for the given key/field from the OpenID protocol message contained in the request URL parameters (i.e., the value for the URL parameter C). This can only be used to obtain core OpenID fields not extension fields. Calling this method without a C<$key> argument returns a L object representing the protocol message, at which point the various object methods are available, including $csr->message->protocol_version $csr->message->has_ext $csr->message->get_ext Returns undef in either case if no URL parameters have been supplied (i.e., because B() has not been initialized) or if the request is not an actual OpenID message. =item $csr->B Returns the last error, in form "errcode: errtext", as set by the various handlers below. =item $csr->B Returns the last error code. See L below. =item $csr->B Returns the last error text. =item $csr->B Returns the last error code/text in JSON format. =back =head2 Configuration =over 4 =item $csr->B($user_agent) =item $csr->B Getter/setter for the L (or subclass) instance which will be used when direct HTTP requests to a provider are needed. It's highly recommended that you use L, or at least read its documentation so you're aware of why you should care. =item $csr->B($cache) =item $csr->B Getter/setter for the cache instance which is used for storing fetched HTML or XRDS pages, keys for associations with identity providers, and received response_nonce values from positive provider assertions. The $cache object can be anything that has a -Eget($key) and -Eset($key,$value[,$expire]) methods. See L for more information. This cache object is passed to L directly. Setting a cache instance is not absolutely required, But without it, provider associations will not be possible and the same pages may be fetched multiple times during discovery. B =item $csr->B($scalar) =item $csr->B($code) $code = $csr->B; ($secret) = $code->($time); The consumer secret is used to generate self-signed nonces for the return_to URL, to prevent spoofing. In the simplest (and least secure) form, you configure a static secret value with a scalar. If you use this method and change the scalar value, any outstanding requests from the last 30 seconds or so will fail. You may also supply a subref that takes one argument, I<$time>, a unix timestamp and returns a secret. Your secret may not exceed 255 characters. For the best protection against replays and login cross-site request forgery, consumer_secret should additionally depend on something known to be specific to the client browser instance and not visible to an attacker. If C is available, you should use that. Otherwise you'll need to set a (Secure) cookie on the (HTTPS) page where the signin form appears in order to establish a pre-login session, then make sure to change this cookie upon successful login. =item $csr->B(2) =item $csr->B Get or set the minimum OpenID protocol version supported. Currently the only useful value you can set here is 2, which will cause 1.1 identifiers to fail discovery with the error C and responses from version 1 providers to not be recognized. In most cases you'll want to allow both 1.1 and 2.0 identifiers, which is the default. If you want, you can set this property to 1 to make this behavior explicit. =item $csr->B($ref) =item $csr->B($param) =item $csr->B Can be used in 1 of 3 ways: =over =item 1. Set the object from which URL parameter names and values are to be retrieved: $csr->args( $reference ) where C<$reference> is either an unblessed C ref, a C ref, or some kind of "request object" E the latter being either a L, L, L, L, or L object. If you pass in a C ref, it must, =over =item * given a single parameter name argument, return the corresponding parameter value, I, =item * given no arguments at all, return the full list of parameter names from the request. =back If you pass in an L (mod_perl 1.x interface) object and this is a POST request, you must I have already called C<< $r->content >> as this routine will be making said call itself in order to extract the request parameters. =item 2. Get a parameter value: my $foo = $csr->args("foo"); When given an unblessed scalar, it retrieves the value. It croaks if you haven't defined a way to get at the parameters. Most callers should instead use the C method above, which abstracts away the need to understand OpenID's message serialization. =item 3. Get the parameter getter: my $code = $csr->args; this being a subref that takes a parameter name and returns the corresponding value. Most callers should instead use the C method above with no arguments, which returns an object from which extension attributes can be obtained by their documented namespace URI. =back =item $csr->B($url_prefix) =item $csr->B Gets or sets the string prefix that, if nonempty, all return_to URLs must start with. Messages with return_to URLS that don't match will be considered invalid (spoofed from another site). =item $csr->B(...) =item $csr->B Get or sets the hash of parameters that determine how associations with identity providers will be made. Available options include: =over 4 =item C Association type, (default 'HMAC-SHA1') =item C Association session type, (default 'DH-SHA1') =item C (boolean) Use best encryption available for protocol version for both session type and association type. This overrides C and C =item C (boolean) Use an unencrypted session type if the ID provider URL scheme is C. This overrides C if both are set. =item C (boolean) Because it is generally a bad idea, we abort associations where an unencrypted session over a non-SSL connection is called for. However the OpenID 1.1 specification technically allows this, so if that is what you really want, set this flag true. Ignored under protocol version 2. =back =item $csr->B(...) =item $csr->B Gets or sets the hash of options for how response_nonce should be checked. In OpenID 2.0, response_nonce is sent by the identity provider as part of a positive identity assertion in order to help prevent replay attacks. In the check_authentication phase, the provider is also required to not authenticate the same response_nonce twice. The relying party is strongly encouraged but not required to reject multiple occurrences of a nonce (which can matter if associations are in use and there is no check_authentication phase). Relying party may also choose to reject a nonce on the basis of the timestamp being out of an acceptable range. Available options include: =over =item C (boolean) Skip response_nonce checking entirely. This overrides all other nonce_options. C is implied and is the only possibility if $csr->B is unset. =item C (integer) Cache entries for nonces will expire after this many seconds. Defaults to the value of C, below. If C is zero or negative, expiration times will not be set at all; entries will expire as per the default behavior for your cache (or you will need to purge them via some separate process). If your cache implementation ignores the third argument on $entry->B() calls (see L), then this option has no effect beyond serving as a default for C. =item C (boolean) Do not do any checking of timestamps, i.e., only test whether nonce is in the cache. This overrides all other nonce options except for C and C =item C (integer) Number of seconds that a provider clock can be ahead of ours before we deem it to be misconfigured. Default skew is 300 (5 minutes) or C, if C is specified and C is smaller. (C is treated as 0 if set negative, but don't do that). Misconfiguration of the provider clock means its timestamps are not reliable, which then means there is no way to know whether or not the nonce could have been sent before the start of the cache window, which nullifies any obligation to detect all multiply sent nonces. Conversely, if proper configuration can be assumed, then the timestamp value minus C will be the earliest possible time that we could have received a previous instance of this response_nonce, and if the cache is reliable about holding entries from that time forward, then (and only then) can one be certain that an uncached nonce instance is indeed the first. =item C (integer) Reject nonces where I minus C is earlier than C (absolute seconds; default is zero a.k.a. midnight 1/1/1970 UTC) If you know the start time of your HTTP server (or your cache server, if that is separate E or the maximum of the start times if you have multiple cache servers), you should use this option to declare that. =item C (integer) Reject nonces where I minus C is more than C seconds ago. Zero or negative values of C are treated as infinite (i.e., allow everything). If C is specified, C defaults to that. If C is not specified, C defaults to 1800 (30 minutes), adjusted upwards if C is specified and larger than the default skew. On general principles, C should be a maximal expected propagation delay plus twice the C. Values between 0 and C (causing all nonces to be rejected) and values greater than C (cache may fail to keep all nonces that are still within the window) are I recommended. =item C (boolean) Reject nonces from The Future (i.e., timestamped more than C seconds from now). Note that rejecting future nonces is not required. Nor does it protect from anything since an attacker can retry the message once it has expired from the cache but is still within the time interval where we would not yet I that it could expire E this being the essential problem with future nonces. It may, however, be useful to have warnings about misconfigured provider clocks E and hence about this insecurity E at the cost of impairing interoperability (since this rejects messages that are otherwise allowed by the protocol), hence this option. =back In most cases it will be enough to either set C to dispense with response_nonce checking entirely because some other (better) method of preventing replay attacks (see B) has been implemented, or use C to declare/set the lifetime of cache entries for nonces whether because the default lifetime is unsatisfactory or because the cache implementation is incapable of setting individual expiration times. All other options should default reasonably in these cases. In order for the nonce check to be as reliable/secure as possible (i.e., that it block all instances of duplicate nonces from properly configured providers as defined by C, which is the best we can do), C must be no earlier than the cache start time and the cache must be guaranteed to hold nonce entries for at least C seconds (though, to be sure, if you can tolerate being vulnerable for the first C seconds of a server run, then you do not need to set C). =back =head2 Performing Discovery =over =item $csr->B($url) Given a user-entered $url (which could be missing http://, or have extra whitespace, etc), converts it to canonical form, performs partial discovery to confirm that at least one provider endpoint exists, and returns a L object, or, on failure of any of the above, returns undef and sets last error ($csr->B). Note that the identity returned is I verified yet. It's only who the user claims they are, but they could be lying. If this method returns undef, an error code will be set. See L below. =back =head2 Handling Provider Responses The following routines are for handling a redirected provider response and assume that, among other things, $csr->B has been properly populated with the URL parameters. =over =item $csr->B( %callbacks ); When a request comes in that contains a response from an OpenID provider, figure out what it means and dispatch to an appropriate callback to handle the request. This is the callback-based alternative to explicitly calling the methods below in the correct sequence, and is recommended unless you need to do something strange. Anything you return from the selected callback function will be returned by this method verbatim. This is useful if the caller needs to return something different in each case. The available callbacks are: =over =item C the request isn't an OpenID response after all. =item C a checkid_immediate mode request was rejected, indicating that the provider requires user interaction. =item C the user cancelled the authentication request from the provider's UI. =item C the user's identity has been successfully verified. A L object is passed in. =item C an error has occurred. An error code and message are provided. See L below for the meanings of the codes. =back For the sake of legacy code we also allow =over =item C B<[DEPRECATED]> a checkid_immediate mode request was rejected I $setup_url was provided. Clients using this callback should be updated to use B at the earliest opportunity. Here $setup_url is the same as returned by $csr->B. =back =item $csr->B Returns true if a set of URL parameters has been supplied (via $csr->B) and constitutes an actual OpenID protocol message. =item $csr->B Returns true if a checkid_immediate request failed because the provider requires user interaction. The correct action to take at this point depends on the OpenID protocol version (Version 1) Redirect to or otherwise make available a link to C<$csr>->C. (Version 2) Retry the request in checkid_setup mode; the provider will then issue redirects as needed. =over B: While some providers have been known to supply the C parameter in Version 2 C responses, you I rely on this, and, moreover, since the OpenID 2.0 specification has nothing to say about the meaning of such a parameter, you cannot rely on it meaning anything in particular even if it is supplied. =back =item $csr->B( [ %opts ] ) (Version 1 only) Returns the URL the user must return to in order to login, setup trust, or do whatever the identity provider needs them to do in order to make the identity assertion which they previously initiated by entering their claimed identity URL. =over B: Checking whether C is set in order to determine whether a checkid_immediate request failed is DEPRECATED and will fail under OpenID 2.0. Use C instead. =back The base URL that this function returns can be modified by using the following options in %opts: =over =item C What you're asking the identity provider to do with the user after they setup trust. Can be either C or C to return the user back to the return_to URL, or close the browser window with JavaScript. If you don't specify, the behavior is undefined (probably the user gets a dead-end page with a link back to the return_to URL). In any case, the identity provider can do whatever it wants, so don't depend on this. =back =item $csr->B Returns true if the user declined to share their identity, false otherwise. (This function is literally one line: returns true if "openid.mode" eq "cancel") It's then your job to restore your app to where it was prior to redirecting them off to the user_setup_url, using the other query parameters that you'd sent along in your return_to URL. =item $csr->B( [ %opts ] ) Returns a Net::OpenID::VerifiedIdentity object, or returns undef and sets last error ($csr->B). Verification includes double-checking the reported identity URL declares the identity provider, verifying the signature, etc. The options in %opts may contain: =over =item C Sets the required_root just for this request. Values returns to its previous value afterwards. =back If this method returns undef, an error code will be set. See L below. =back =head1 ERROR CODES This is the complete list of error codes that can be set. Errors marked with (C) are set by B. Other errors occur during handling of provider responses and can be set by B (A), B (V), and B (S), all of which can show up in the C callback for B. =over =over =item C (A) The protocol message is a (2.0) error mode (i.e., C) message, typically used for provider-specific error responses. Use $csr->B to get at the C and C fields. =item C (C) Tried to do discovery on an empty or all-whitespace string. =item C (C) Tried to do discovery on a non-http:/https: URL. =item C (C) None of the ID providers found support even the minimum protocol version ($csr->B) =item C (CV) Tried to do discovery on a URL that does not seem to have any providers at all. =item C (SV) The C was expected to be C (positive assertion or, in version 1, checkid_immediate failed). =item C (V) The C parameter is missing. =item C (V) The C parameter is missing. =item C (V) The C parameter is missing =item C (V) The C URL does not match $csr->B =item C (V) The C parameter is missing. =item C (V) A previous assertion from this provider used this response_nonce already. Someone may be attempting a replay attack. =item C (V) Either the response_nonce timestamp was not in the correct format (e.g., tried to have fractional seconds or not UTC) or one of the components was out of range (e.g., month = 13). =item C (V) C was set and we got a response_nonce that was more than C seconds into the future. =item C (V) We got a response_nonce that was either prior to the start time or more than window seconds ago. =item C (V) The return_to signature time (C) is from too long ago. =item C (V) The return_to signature time (C) is too far into the future. =item C (V) The HMAC of the return_to signature (C) is not what it should be. =item C (V) None of the provider endpoints found for the given ID match the server specified by the C parameter (OpenID 2 only). =item C (V) Discovery for the given ID ended up at the wrong place =item C (V) Asserted identity (C) does not match claimed_id or local_id/delegate. =item C (V) In OpenID 2.0, C, C, C, and C must always be signed, while C and C must be signed if present. =item C (V) C is for an association that has expired. =item C (V) An attempt to confirm the positive assertion using the association given by C failed; the signature is not what it should be. =item C (V) An attempt to confirm the positive assertion via direct contact (check_authentication) with the provider failed with no response or a bad status code (!= 200). =item C (V) An attempt to confirm a positive assertion via direct contact (check_authentication) received an explicitly negative response (C). =back =back =head1 PROTOCOL VARIANCES XRI-based identities are not supported. Meanwhile, here are answers to the security profile questions from L
that are relevant to the Consumer/Relying-Party: =over =item 1. I B =item 2. N/A. =item 3. I B =item 4. I B) supplied. L, as of version 6.0, can be configured to only accept connections to sites with certificates deriving from a set of trusted roots.> =item 5. I B =item 6. I B =item 7. I B,C,C> =item 8. N/A. =item 9. N/A. =item 10. I B, then Yes for version 2.0 providers and likewise for version 1.1 providers if C is not set, otherwise No.> =back =head1 COPYRIGHT This module is Copyright (c) 2005 Brad Fitzpatrick. All rights reserved. You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. If you need more liberal licensing terms, please contact the maintainer. =head1 WARRANTY This is free software. IT COMES WITHOUT WARRANTY OF ANY KIND. =head1 MAILING LIST The Net::OpenID family of modules has a mailing list powered by Google Groups. For more information, see L. =head1 SEE ALSO OpenID website: L L -- part of this module L -- part of this module L -- another module, for implementing an OpenID identity provider/server =head1 AUTHORS Brad Fitzpatrick Tatsuhiko Miyagawa Martin Atkins Robert Norris Roger Crew Net-OpenID-Consumer-1.18/lib/Net/OpenID/Association.pm0000644000175000017500000003360212655770672020455 0ustar rfcrfcuse strict; use Carp (); ############################################################################ package Net::OpenID::Association; $Net::OpenID::Association::VERSION = '1.18'; use fields ( 'server', # author-identity identity provider endpoint 'secret', # the secret for this association 'handle', # the 255-character-max ASCII printable handle (33-126) 'expiry', # unixtime, adjusted, of when this association expires 'type', # association type ); use Storable (); use Digest::SHA (); use Net::OpenID::Common; use URI::Escape qw(uri_escape); ################################################################ # Association and Session Types # session type hash # name - by which session type appears in URI parameters (required) # len - number of bytes in digest (undef => accommodates any length) # fn - DH hash function (undef => secret passed in the clear) # https - must use encrypted connection (boolean) # my %_session_types = (); # {versionkey}{name} -> session type # {NO}{versionkey} -> no-encryption stype for this version # {MAX}{versionkey} -> strongest encryption stype for this version # association type hash # name - by which assoc. type appears in URI parameters (required) # len - number of bytes in digest (required) # macfn - MAC hash function (required) # my %_assoc_types = (); # {versionkey}{name} -> association type # {MAX}{versionkey} -> strongest encryption atype for this version my %_assoc_macfn = (); # {name} -> hmac function # ... since association types in the cache are only listed by name # and don't say what version they're from. Which should not matter # as long as the macfn associated with a given association type # name does not change in future versions. # (floating point version numbers scare me) # (also version key can stay the same if the # set of hash functions available does not change) # ('NO' and 'MAX' should never be used as version keys) sub _version_key_from_numeric { my ($numeric_protocol_version) = @_; return $numeric_protocol_version < 2 ? 'v1' : 'v2'; } # can SESSION_TYPE be used with ASSOC_TYPE? sub _compatible_stype_atype { my ($s_type, $a_type) = @_; return !$s_type->{len} || $s_type->{len} == $a_type->{len}; } { # Define the no-encryption session types. # In version 1.1/1.0, the no-encryption session type # is the default and never explicitly specified $_session_types{$_->[0]}{$_->[1]} = $_session_types{NO}{$_->[0]} = { name => $_->[1], https => 1, } foreach ([v1 => ''], [v2 => 'no-encryption']); # Define SHA-based session and association types my %_sha_fns = ( SHA1 => { minv => 'v1', # first version group in which this appears v1max => 1, # best encryption for v1 len => 20, # number of bytes in digest fn => \&Digest::SHA::sha1, macfn => \&Digest::SHA::hmac_sha1, }, SHA256 => { minv => 'v2', v2max => 1, # best encryption for v2 len => 32, fn => \&Digest::SHA::sha256, macfn => \&Digest::SHA::hmac_sha256, }, # doubtless there will be more... ); foreach my $SHAX (keys %_sha_fns) { my $s = $_sha_fns{$SHAX}; my $a_type = { name => "HMAC-${SHAX}", map {$_,$s->{$_}} qw(len macfn) }; my $s_type = { name => "DH-${SHAX}", map {$_,$s->{$_}} qw(len fn) }; my $seen_minv = 0; foreach my $v (qw(v1 v2)) { $seen_minv = 1 if $v eq $s->{minv}; next unless $seen_minv; $_assoc_types{$v}{$a_type->{name}} = $a_type; $_session_types{$v}{$s_type->{name}} = $s_type; if ($s->{"${v}max"}) { $_assoc_types{MAX}{$v} = $a_type; $_session_types{MAX}{$v} = $s_type; } } $_assoc_macfn{$a_type->{name}} = $a_type->{macfn}; } } ################################################################ sub new { my Net::OpenID::Association $self = shift; $self = fields::new( $self ) unless ref $self; my %opts = @_; for my $f (qw( server secret handle expiry type )) { $self->{$f} = delete $opts{$f}; } Carp::croak("unknown options: " . join(", ", keys %opts)) if %opts; return $self; } sub handle { my $self = shift; die if @_; $self->{'handle'}; } sub secret { my $self = shift; die if @_; $self->{'secret'}; } sub type { my $self = shift; die if @_; $self->{'type'}; } sub generate_signature { my Net::OpenID::Association $self = shift; my $string = shift; return OpenID::util::b64($_assoc_macfn{$self->type}->($string, $self->secret)); } sub server { my Net::OpenID::Association $self = shift; Carp::croak("Too many parameters") if @_; return $self->{server}; } sub expired { my Net::OpenID::Association $self = shift; return time() > $self->{'expiry'}; } sub usable { my Net::OpenID::Association $self = shift; return 0 unless $self->{'handle'} =~ /^[\x21-\x7e]{1,255}$/; return 0 unless $self->{'expiry'} =~ /^\d+$/; return 0 unless $self->{'secret'}; return 0 if $self->expired; return 1; } # server_assoc(CSR, SERVER, FORCE_REASSOCIATE, OPTIONS...) # # Return an association for SERVER (provider), whether already # cached and not yet expired, or freshly negotiated. # Return undef if no local storage/cache is available # or negotiation fails for whatever reason, # in which case the caller goes into dumb consumer mode. # FORCE_REASSOCIATE true => ignore the cache # OPTIONS... are passed to new_server_assoc() # sub server_assoc { my ($csr, $server, $force_reassociate, @opts) = @_; # closure to return undef (dumb consumer mode) and log why my $dumb = sub { $csr->_debug("server_assoc: dumb mode: $_[0]"); return undef; }; my $cache = $csr->cache; return $dumb->("no_cache") unless $cache; unless ($force_reassociate) { # try first from cached association handle if (my $handle = $cache->get("shandle:$server")) { my $assoc = handle_assoc($csr, $server, $handle); if ($assoc && $assoc->usable) { $csr->_debug("Found association from cache (handle=$handle)"); return $assoc; } } } # make a new association my ($assoc, $err, $retry) = new_server_assoc($csr, $server, @opts); return $dumb->($err) if $err; ($assoc, $err) = new_server_assoc($csr, $server, @opts, %$retry) if $retry; return $dumb->($err || 'second_retry') unless $assoc; my $ahandle = $assoc->handle; $cache->set("hassoc:$server:$ahandle", Storable::freeze({%$assoc})); $cache->set("shandle:$server", $ahandle); # now we test that the cache object given to us actually works. if it # doesn't, it'll also fail later, making the verify fail, so let's # go into stateless (dumb mode) earlier if we can detect this. $cache->get("shandle:$server") or return $dumb->("cache_broken"); return $assoc; } # new_server_assoc(CSR, SERVER, OPTIONS...) # # Attempts to negotiate a fresh association from C<$server> (provider) # with session and association types determined by OPTIONS... # (accepts protocol_version and all assoc_options from Consumer, # however max_encrypt and session_no_encrypt_https are ignored # if assoc_type and session_type are passed directly as hashes) # Returns # ($association) on success # (undef, $error_message) on unrecoverable failure # (undef, undef, {retry...}) if identity provider suggested # alternate session/assoc types in an error response # sub new_server_assoc { my ($csr, $server, %opts) = @_; my $server_is_https = lc($server) =~ m/^https:/; my $protocol_version = delete $opts{protocol_version} || 1; my $version_key = _version_key_from_numeric($protocol_version); my $allow_eavesdropping = (delete $opts{allow_eavesdropping} || 0) && $protocol_version < 2; my $a_maxencrypt = delete $opts{max_encrypt} || 0; my $s_noencrypt = delete $opts{session_no_encrypt_https} && $server_is_https; my $s_type = delete $opts{session_type} || "DH-SHA1"; unless (ref $s_type) { if ($s_noencrypt) { $s_type = $_session_types{NO}{$version_key}; } elsif ($a_maxencrypt) { $s_type = $_session_types{MAX}{$version_key}; } } my $a_type = delete $opts{assoc_type} || "HMAC-SHA1"; unless (ref $a_type) { $a_type = $_assoc_types{MAX}{$version_key} if $a_maxencrypt; } Carp::croak("unknown options: " . join(", ", keys %opts)) if %opts; $a_type = $_assoc_types{$version_key}{$a_type} unless ref $a_type; Carp::croak("unknown association type") unless $a_type; $s_type = $_session_types{$version_key}{$s_type} unless ref $s_type; Carp::croak("unknown session type") unless $s_type; my $error = sub { return (undef, $_[0].($_[1]?" ($_[1])":'')); }; return $error->("incompatible_session_type") unless _compatible_stype_atype($s_type, $a_type); return $error->("https_required") if $s_type->{https} && !$server_is_https && !$allow_eavesdropping; my %post = ( "openid.mode" => "associate" ); $post{'openid.ns'} = OpenID::util::version_2_namespace() if $protocol_version == 2; $post{'openid.assoc_type'} = $a_type->{name}; $post{'openid.session_type'} = $s_type->{name} if $s_type->{name}; my $dh; if ($s_type->{fn}) { $dh = OpenID::util::get_dh(); $post{'openid.dh_consumer_public'} = OpenID::util::int2arg($dh->pub_key); } my $req = HTTP::Request->new(POST => $server); $req->header("Content-Type" => "application/x-www-form-urlencoded"); $req->content(join("&", map { "$_=" . uri_escape($post{$_}) } keys %post)); $csr->_debug("Associate mode request: " . $req->content); my $ua = $csr->ua; my $res = $ua->request($req); return $error->("http_no_response") unless $res; my $recv_time = time(); my $content = $res->content; my %args = OpenID::util::parse_keyvalue($content); $csr->_debug("Response to associate mode: [$content] parsed = " . join(",", %args)); my $r_a_type = $_assoc_types{$version_key}{$args{'assoc_type'}}; my $r_s_type = $_session_types{$version_key}{$args{'session_type'}||''}; unless ($res->is_success) { # direct error return $error->("http_failure_no_associate") if ($protocol_version < 2); return $error->("http_direct_error") unless $args{'error_code'} eq 'unsupported_type'; return (undef,undef,{assoc_type => $r_a_type, session_type => $r_s_type}) if $r_a_type && $r_s_type && ($r_a_type != $a_type || $r_s_type != $s_type); return $error->("unsupported_type"); } return $error->("unknown_assoc_type",$args{'assoc_type'}) unless $r_a_type; return $error->("unknown_session_type",$args{'session_type'}) unless $r_s_type; return $error->("wrong_assoc_type",$r_a_type->{name}) unless $a_type == $r_a_type; return $error->("wrong_session_type",$r_s_type->{name}) unless $s_type == $r_s_type || ($protocol_version < 2); # protocol version 1.1 my $expires_in = $args{'expires_in'}; # protocol version 1.0 (DEPRECATED) if (! $expires_in) { if (my $issued = OpenID::util::w3c_to_time($args{'issued'})) { my $expiry = OpenID::util::w3c_to_time($args{'expiry'}); my $replace_after = OpenID::util::w3c_to_time($args{'replace_after'}); # seconds ahead (positive) or behind (negative) the provider is $expires_in = ($replace_after || $expiry) - $issued; } } # between 1 second and 2 years return $error->("bogus_expires_in") unless $expires_in > 0 && $expires_in < 63072000; my $ahandle = $args{'assoc_handle'}; my $secret; unless ($r_s_type->{fn}) { $secret = OpenID::util::d64($args{'mac_key'}); } else { my $server_pub = OpenID::util::arg2int($args{'dh_server_public'}); my $dh_sec = $dh->compute_secret($server_pub); $secret = OpenID::util::d64($args{'enc_mac_key'}) ^ $r_s_type->{fn}->(OpenID::util::int2bytes($dh_sec)); } return $error->("bad_secret_length") if $r_s_type->{len} && length($secret) != $r_s_type->{len}; my %assoc = ( handle => $ahandle, server => $server, secret => $secret, type => $r_a_type->{name}, expiry => $recv_time + $expires_in, ); return Net::OpenID::Association->new( %assoc ); } # returns association, or undef if it can't be found sub handle_assoc { my ($csr, $server, $handle) = @_; # closure to return undef (dumb consumer mode) and log why my $dumb = sub { $csr->_debug("handle_assoc: dumb mode: $_[0]"); return undef; }; return $dumb->("no_handle") unless $handle; my $cache = $csr->cache; return $dumb->("no_cache") unless $cache; my $frozen = $cache->get("hassoc:$server:$handle"); return $dumb->("not_in_cache") unless $frozen; my $param = eval { Storable::thaw($frozen) }; return $dumb->("not_a_hashref") unless ref $param eq "HASH"; return Net::OpenID::Association->new( %$param ); } sub invalidate_handle { my ($csr, $server, $handle) = @_; my $cache = $csr->cache or return; $cache->set("hassoc:$server:$handle", ""); } 1; __END__ =head1 NAME Net::OpenID::Association - A relationship with an identity provider =head1 VERSION version 1.18 =head1 DESCRIPTION Internal class. =head1 COPYRIGHT, WARRANTY, AUTHOR See L for author, copyright and licensing information. =head1 SEE ALSO L L L Website: L Net-OpenID-Consumer-1.18/lib/Net/OpenID/ClaimedIdentity.pm0000644000175000017500000003007112655770672021246 0ustar rfcrfcuse strict; use Carp (); ############################################################################ package Net::OpenID::ClaimedIdentity; $Net::OpenID::ClaimedIdentity::VERSION = '1.18'; use fields ( 'identity', # the canonical URL that was found, following redirects 'server', # author-identity identity provider endpoint 'consumer', # ref up to the Net::OpenID::Consumer which generated us 'delegate', # the delegated URL actually asserted by the provider 'protocol_version', # The version of the OpenID Authentication Protocol that is used 'semantic_info', # Stuff that we've discovered in the identifier page's metadata 'extension_args', # Extension arguments that the caller wants to add to the request ); use Digest::SHA qw(hmac_sha1_hex); sub new { my Net::OpenID::ClaimedIdentity $self = shift; $self = fields::new( $self ) unless ref $self; my %opts = @_; for my $f (qw( identity server consumer delegate protocol_version semantic_info )) { $self->{$f} = delete $opts{$f}; } $self->{protocol_version} ||= 1; unless ($self->{protocol_version} == 1 || $self->{protocol_version} == 2) { Carp::croak("Unsupported protocol version"); } # lowercase the scheme and hostname $self->{'identity'} =~ s!^(https?://.+?)(/(?:.*))?$!lc($1) . $2!ie; $self->{extension_args} = {}; Carp::croak("unknown options: " . join(", ", keys %opts)) if %opts; return $self; } sub claimed_url { my Net::OpenID::ClaimedIdentity $self = shift; Carp::croak("Too many parameters") if @_; return $self->{'identity'}; } sub delegated_url { my Net::OpenID::ClaimedIdentity $self = shift; Carp::croak("Too many parameters") if @_; return $self->{'delegate'}; } sub identity_server { my Net::OpenID::ClaimedIdentity $self = shift; Carp::croak("Too many parameters") if @_; return $self->{server}; } sub protocol_version { my Net::OpenID::ClaimedIdentity $self = shift; Carp::croak("Too many parameters") if @_; return $self->{protocol_version}; } sub semantic_info { my Net::OpenID::ClaimedIdentity $self = shift; Carp::croak("Too many parameters") if @_; return $self->{semantic_info} if $self->{semantic_info}; my $final_url = ''; my $info = $self->{consumer}->_find_semantic_info($self->claimed_url, \$final_url); # Don't return anything if the URL has changed. Something bad may be happening. $info = {} if $final_url ne $self->claimed_url; return $self->{semantic_info} = $info; } sub set_extension_args { my Net::OpenID::ClaimedIdentity $self = shift; my $ext_uri = shift; my $args = shift; Carp::croak("Too many parameters") if @_; Carp::croak("No extension URI given") unless $ext_uri; Carp::croak("Expecting hashref of args") if defined($args) && ref $args ne 'HASH'; $self->{extension_args}{$ext_uri} = $args; } sub check_url { my Net::OpenID::ClaimedIdentity $self = shift; my (%opts) = @_; my $return_to = delete $opts{'return_to'}; my $trust_root = delete $opts{'trust_root'}; my $delayed_ret = delete $opts{'delayed_return'}; my $force_reassociate = delete $opts{'force_reassociate'}; my $use_assoc_handle = delete $opts{'use_assoc_handle'}; my $actually_return_association = delete $opts{'actually_return_association'}; Carp::croak("Unknown options: " . join(", ", keys %opts)) if %opts; Carp::croak("Invalid/missing return_to") unless $return_to =~ m!^https?://!; my $csr = $self->{consumer}; my $ident_server = $self->{server} or Carp::croak("No identity server"); # get an assoc (or undef for dumb mode) my $assoc; if ($use_assoc_handle) { $assoc = Net::OpenID::Association::handle_assoc($csr, $ident_server, $use_assoc_handle); } else { $assoc = Net::OpenID::Association::server_assoc($csr, $ident_server, $force_reassociate, ( %{$csr->assoc_options}, protocol_version => $self->protocol_version, )); } # for the openid-test project: (doing interop testing) if ($actually_return_association) { return $assoc; } my $identity_arg = $self->{'delegate'} || $self->{'identity'}; # make a note back to ourselves that we're using a delegate # but only in the 1.1 case because 2.0 has a core field for this if ($self->{'delegate'} && $self->protocol_version == 1) { OpenID::util::push_url_arg(\$return_to, "oic.identity", $self->{identity}); } # add a HMAC-signed time so we can verify the return_to URL wasn't spoofed my $sig_time = time(); my $c_secret = $csr->_get_consumer_secret($sig_time); my $sig = substr(hmac_sha1_hex($sig_time, $c_secret), 0, 20); OpenID::util::push_url_arg(\$return_to, "oic.time", "${sig_time}-$sig"); my $curl = $ident_server; if ($self->protocol_version == 1) { OpenID::util::push_url_arg(\$curl, "openid.mode" => ($delayed_ret ? "checkid_setup" : "checkid_immediate"), "openid.identity" => $identity_arg, "openid.return_to" => $return_to, ($trust_root ? ( "openid.trust_root" => $trust_root ) : ()), ($assoc ? ( "openid.assoc_handle" => $assoc->handle ) : ()), ); } elsif ($self->protocol_version == 2) { # NOTE: OpenID Auth 2.0 uses different terminology for a bunch # of things than 1.1 did. This library still uses the 1.1 terminology # in its API. OpenID::util::push_openid2_url_arg(\$curl, "mode" => ($delayed_ret ? "checkid_setup" : "checkid_immediate"), "claimed_id" => $self->claimed_url, "identity" => $identity_arg, "return_to" => $return_to, ($trust_root ? ( "realm" => $trust_root ) : ()), ($assoc ? ( "assoc_handle" => $assoc->handle ) : ()), ); } # Finally we add in the extension arguments, if any my %ext_url_args = (); my $ext_idx = 1; foreach my $ext_uri (keys %{$self->{extension_args}}) { my $ext_alias; if ($ext_uri eq "http://openid.net/extensions/sreg/1.1") { # For OpenID 1.1 only the "SREG" extension is allowed, # and it must use the "openid.sreg." prefix. $ext_alias = "sreg"; } elsif ($self->protocol_version < 2) { next; } else { $ext_alias = 'e'.($ext_idx++); } $ext_url_args{'openid.ns.'.$ext_alias} = $ext_uri; foreach my $k (keys %{$self->{extension_args}{$ext_uri}}) { $ext_url_args{'openid.'.$ext_alias.'.'.$k} = $self->{extension_args}{$ext_uri}{$k}; } } OpenID::util::push_url_arg(\$curl, %ext_url_args) if %ext_url_args; $self->{consumer}->_debug("check_url for (del=$self->{delegate}, id=$self->{identity}) = $curl"); return $curl; } 1; __END__ =head1 NAME Net::OpenID::ClaimedIdentity - A not-yet-verified OpenID identity =head1 VERSION version 1.18 =head1 SYNOPSIS use Net::OpenID::Consumer; my $csr = Net::OpenID::Consumer->new; .... my $cident = $csr->claimed_identity("bradfitz.com") or die $csr->err; if ($AJAX_mode) { my $url = $cident->claimed_url; my $openid_server = $cident->identity_server; # ... return JSON with those to user agent (whose request was # XMLHttpRequest, probably) } if ($CLASSIC_mode) { my $check_url = $cident->check_url( delayed_return => 1, return_to => "http://example.com/get-identity.app", trust_root => "http://*.example.com/", ); WebApp::redirect($check_url); } =head1 DESCRIPTION After L crawls a user's declared identity URL and finds openid.server link tags in the HTML head, you get this object. It represents an identity that can be verified with OpenID (the link tags are present), but hasn't been actually verified yet. =head1 METHODS =over 4 =item $url = $cident->B The URL, now canonicalized, that the user claims to own. You can't know whether or not they do own it yet until you send them off to the check_url, though. =item $id_server = $cident->B Returns the identity provider that will assert whether or not this claimed identity is valid, and sign a message saying so. =item $url = $cident->B If the claimed URL is using delegation, this returns the delegated identity that will actually be sent to the identity provider. =item $version = $cident->B Determines whether this identifier is to be verified by OpenID 1.1 or by OpenID 2.0. Returns C<1> or C<2> respectively. This will affect the way the C is constructed. =item $cident->B($ns_uri, $args) If called before you access C, the arguments given in the hashref $args will be added to the request in the given extension namespace. For example, to use the Simple Registration (SREG) extension: $cident->set_extension_args( 'http://openid.net/extensions/sreg/1.1', { required => 'email', optional => 'fullname,nickname', policy_url => 'http://example.com/privacypolicy.html', }, ); Note that when making an OpenID 1.1 request, only the Simple Registration extension is supported. There was no general extension mechanism defined in OpenID 1.1, so SREG (with the namespace URI as in the example above) is supported as a special case. All other extension namespaces will be silently ignored when making a 1.1 request. =item $url = $cident->B( %opts ) Makes the URL that you have to somehow send the user to in order to validate their identity. The options to put in %opts are: =over =item C The URL that the identity provider should redirect the user with either a verified identity signature -or- a setup_needed message (indicating actual interaction with the user is required before an assertion can be made). This URL may contain query parameters, and the identity provider must preserve them. =item C The URL that you want the user to actually see and declare trust for. Your C URL must be at or below your trust_root. Sending the trust_root is optional, and defaults to your C value, but it's highly recommended (and prettier for users) to see a simple trust_root. Note that the trust root may contain a wildcard at the beginning of the host, like C =item C If set to a true value, the check_url returned will indicate to the user's identity provider that it has permission to control the user's user-agent for awhile, giving them real pages (not just redirects) and lets them bounce around the identity provider site for a while until the requested assertion can be made, and they can finally be redirected back to your return_to URL above. The default value, false, means that the identity provider will immediately return to your return_to URL with either a "yes" or "no" answer. In the "no" case, you'll instead have control of what to do, whether to retry the request with C set true (the only way to proceed in version 2.0) or to somehow send (be it link, redirect, or pop-up window) the user the provider's user_setup_url (which is made available in version 1.0/1.1). When writing a dynamic "AJAX"-style application, you can't use delayed_return because the remote site can't usefully take control of a 1x1 pixel hidden IFRAME, so you'll need to either (1.0/1.1) get the user_setup_url and present it to the user somehow or (2.0) launch a delayed_return request from an actual window if the AJAX-style request fails. =back =back =head1 COPYRIGHT, WARRANTY, AUTHOR See L for author, copyright and licensing information. =head1 SEE ALSO L L L Website: L Net-OpenID-Consumer-1.18/lib/Net/OpenID/VerifiedIdentity.pm0000644000175000017500000002514512655770672021453 0ustar rfcrfcuse strict; use Carp (); ############################################################################ package Net::OpenID::VerifiedIdentity; $Net::OpenID::VerifiedIdentity::VERSION = '1.18'; use fields ( 'identity', # the verified identity URL 'id_uri', # the verified identity's URI object 'claimed_identity', # The ClaimedIdentity object that we've verified 'semantic_info', # The "semantic info" (RSS URLs, etc) at the verified identity URL 'consumer', # The Net::OpenID::Consumer module which created us 'signed_fields' , # hashref of key->value of things that were signed. without "openid." prefix 'signed_message', # the signed fields as an IndirectMessage object. Created when needed. ); use URI; sub new { my Net::OpenID::VerifiedIdentity $self = shift; $self = fields::new( $self ) unless ref $self; my %opts = @_; $self->{'consumer'} = delete $opts{'consumer'}; if ($self->{'claimed_identity'} = delete $opts{'claimed_identity'}) { $self->{identity} = $self->{claimed_identity}->claimed_url; unless ($self->{'id_uri'} = URI->new($self->{identity})) { return $self->{'consumer'}->_fail("invalid_uri"); } } for my $par (qw(signed_fields)) { $self->$par(delete $opts{$par}); } Carp::croak("Unknown options: " . join(", ", keys %opts)) if %opts; return $self; } sub url { my Net::OpenID::VerifiedIdentity $self = shift; return $self->{'identity'}; } sub display { my Net::OpenID::VerifiedIdentity $self = shift; return DisplayOfURL($self->{'identity'}); } sub _semantic_info_hash { my ($self) = @_; return $self->{semantic_info} if $self->{semantic_info}; my $sem_info = $self->{claimed_identity}->semantic_info; $self->{semantic_info} = { 'foaf' => $self->_identity_relative_uri($sem_info->{"foaf"}), 'foafmaker' => $sem_info->{"foaf.maker"}, 'rss' => $self->_identity_relative_uri($sem_info->{"rss"}), 'atom' => $self->_identity_relative_uri($sem_info->{"atom"}), }; return $self->{semantic_info}; } sub _identity_relative_uri { my $self = shift; my $url = shift; return $url if ref $url; return undef unless $url; return URI->new_abs($url, $self->{'id_uri'}); } sub signed_fields { &_getset; } sub foaf { &_getset_semurl; } sub rss { &_getset_semurl; } sub atom { &_getset_semurl; } sub foafmaker { &_getset_sem; } sub declared_foaf { &_dec_semurl; } sub declared_rss { &_dec_semurl; } sub declared_atom { &_dec_semurl; } sub extension_fields { my ($self, $ns_uri) = @_; return $self->_extension_fields($ns_uri, $self->{consumer}->message); } sub signed_extension_fields { my ($self, $ns_uri) = @_; return $self->_extension_fields($ns_uri, $self->signed_message); } sub _extension_fields { my ($self, $ns_uri, $args) = @_; return $args->get_ext($ns_uri); } sub signed_message { my ($self) = @_; return $self->{signed_message} if $self->{signed_message}; # This is maybe a bit hacky. # We need to synthesize an IndirectMessage object # representing the signed fields, which means # that we need to fake up the mandatory message # arguments that probably weren't signed. my %args = map { 'openid.'.$_ => $self->{signed_fields}{$_} } keys %{$self->{signed_fields}}; my $real_message = $self->{consumer}->message; if ($real_message->protocol_version == 1) { # OpenID 1.1 just needs a mode. $args{'openid.mode'} = 'id_res'; } else { # OpenID 2.2 needs the namespace URI as well $args{'openid.ns'} = 'http://specs.openid.net/auth/2.0'; $args{'openid.mode'} = 'id_res'; } my $message = Net::OpenID::IndirectMessage->new(\%args); return $self->{signed_message} = $message; } sub _getset { my $self = shift; my $param = (caller(1))[3]; $param =~ s/.+:://; if (@_) { my $val = shift; Carp::croak("Too many parameters") if @_; $self->{$param} = $val; } return $self->{$param}; } sub _getset_sem { my $self = shift; my $param = (caller(1))[3]; $param =~ s/.+:://; my $info = $self->_semantic_info_hash; if (my $value = shift) { Carp::croak("Too many parameters") if @_; $info->{$param} = $value; } return $info->{$param}; } sub _getset_semurl { my $self = shift; my $param = (caller(1))[3]; $param =~ s/.+:://; my $info = $self->_semantic_info_hash; if (my $surl = shift) { Carp::croak("Too many parameters") if @_; # TODO: make absolute URL from possibly relative one my $abs = URI->new_abs($surl, $self->{'id_uri'}); $info->{$param} = $abs; } my $uri = $info->{$param}; return $uri && _url_is_under($self->{'id_uri'}, $uri) ? $uri->as_string : undef; } sub _dec_semurl { my $self = shift; my $param = (caller(1))[3]; $param =~ s/.+::declared_//; my $info = $self->_semantic_info_hash; my $uri = $info->{$param}; return $uri ? $uri->as_string : undef; } sub DisplayOfURL { my $url = shift; my $dev_mode = shift; return $url unless $url =~ m!^https?://([^/]+)(/.*)?$!; my ($host, $path) = ($1, $2); $host = lc($host); if ($dev_mode) { $host =~ s!^dev\.!!; $host =~ s!:\d+!!; } $host =~ s/:.+//; $host =~ s/^www\.//i; if (length($path) <= 1) { return $host; } # obvious username if ($path =~ m!^/~([^/]+)/?$! || $path =~ m!^/(?:users?|members?)/([^/]+)/?$!) { return "$1 [$host]"; } if ($host =~ m!^profile\.(.+)!i) { my $site = $1; if ($path =~ m!^/([^/]+)/?$!) { return "$1 [$site]"; } } return $url; } # FIXME: duplicated in Net::OpenID::Server sub _url_is_under { my ($root, $test, $err_ref) = @_; my $err = sub { $$err_ref = shift if $err_ref; return undef; }; my $ru = ref $root ? $root : URI->new($root); return $err->("invalid root scheme") unless $ru->scheme =~ /^https?$/; my $tu = ref $test ? $test : URI->new($test); return $err->("invalid test scheme") unless $tu->scheme =~ /^https?$/; return $err->("schemes don't match") unless $ru->scheme eq $tu->scheme; return $err->("ports don't match") unless $ru->port == $tu->port; # check hostnames my $ru_host = $ru->host; my $tu_host = $tu->host; my $wildcard_host = 0; if ($ru_host =~ s!^\*\.!!) { $wildcard_host = 1; } unless ($ru_host eq $tu_host) { if ($wildcard_host) { return $err->("host names don't match") unless $tu_host =~ /\.\Q$ru_host\E$/; } else { return $err->("host names don't match"); } } # check paths my $ru_path = $ru->path || "/"; my $tu_path = $tu->path || "/"; $ru_path .= "/" unless $ru_path =~ m!/$!; $tu_path .= "/" unless $tu_path =~ m!/$!; return $err->("path not a subpath") unless $tu_path =~ m!^\Q$ru_path\E!; return 1; } 1; __END__ =head1 NAME Net::OpenID::VerifiedIdentity - Object representing a verified OpenID identity =head1 VERSION version 1.18 =head1 SYNOPSIS use Net::OpenID::Consumer; my $csr = Net::OpenID::Consumer->new; .... my $vident = $csr->verified_identity or die $csr->err; my $url = $vident->url; =head1 DESCRIPTION After L verifies a user's identity and does the signature checks, it gives you this Net::OpenID::VerifiedIdentity object, from which you can learn more about the user. =head1 METHODS =over 4 =item $vident->B Returns the URL (as a scalar) that was verified. (Remember, an OpenID is just a URL.) =item $vident->B Returns the a short "display form" of the verified URL using a couple brain-dead patterns. For instance, the identity "http://www.foo.com/~bob/" will map to "bob [foo.com]" The www. prefix is removed, as well as http, and a username is looked for, in either the tilde form, or "/users/USERNAME" or "/members/USERNAME". If the path component is empty or just "/", then the display form is just the hostname, so "http://myblog.com/" is just "myblog.com". Suggestions for improving this function are welcome, but you'll probably get more satisfying results if you make use of the data returned by the Simple Registration (SREG) extension, which allows the user to choose a preferred nickname to use on your site. =item $vident->B($ns_uri) Return the fields from the given extension namespace, if any, that were included in the assertion request. The fields are returned in a hashref. In most cases you'll probably want to use B instead, to avoid attacks where a man-in-the-middle alters the extension fields in transit. Note that for OpenID 1.1 transactions only Simple Registration (SREG) 1.1 is supported. =item $vident->B($ns_uri) The same as B except that only fields that were signed as part of the assertion are included in the returned hashref. For example, if you included a Simple Registration request in your initial message, you might fetch the results (if any) like this: $sreg = $vident->signed_extension_fields( 'http://openid.net/extensions/sreg/1.1', ); An important gotcha to bear in mind is that for OpenID 2.0 responses no extension fields can be considered signed unless the corresponding extension namespace declaration is also signed. If that is not the case, this method will behave as if no extension fields for that URI were signed. =item $vident->B =item $vident->B =item $vident->B =item $vident->B =item $vident->B =item $vident->B Returns the absolute URLs (as scalars) of the user's RSS, Atom, and FOAF XML documents that were also found in their HTML's EheadE section. The short versions will only return a URL if they're below the root URL that was verified. If you want to get at the user's declared rss/atom/foaf, even if it's on a different host or parent directory, use the declared_* versions, which don't have the additional checks. 2005-05-24: A future module will take a Net::OpenID::VerifiedIdentity object and create an OpenID profile object so you don't have to manually parse all those documents to get profile information. =item $vident->B Returns the value of the C meta tag, if declared. =back =head1 COPYRIGHT, WARRANTY, AUTHOR See L for author, copyrignt and licensing information. =head1 SEE ALSO L L L Website: L