Authen-Bitcard-0.90000755000765000024 011574621001 13273 5ustar00askstaff000000000000README000644000765000024 1423111574621001 14254 0ustar00askstaff000000000000Authen-Bitcard-0.90NAME Authen::Bitcard - Bitcard authentication verification SYNOPSIS use CGI; use Authen::Bitcard; my $q = CGI->new; my $bc = Authen::Bitcard->new; $bc->token('bitcard-token'); # send user to $bc->login_url(r => $return_url); # when the user comes back, get the user id with: my $user = $bc->verify($q) or die $bc->errstr; DESCRIPTION *Authen::Bitcard* is an implementation of verification for signatures generated by Bitcard authentication. For information on the Bitcard protocol and using Bitcard in other applications, see *http://www.bitcard.org/api*. The module and the protocol are heavily based on *Authen::Typekey*. (In fact, the Bitcard authentication server also supports the TypeKey API!) USAGE Authen::Bitcard->new Create a new *Authen::Bitcard* object. $bc->token([ $bitcard_token ]) Your Bitcard token, which you passed to Bitcard when creating the original sign-in link. This must be set before calling *verify* or *login_url* (etc). $bc->bitcard_url( [ $url ]) Get/set the base URL for the Bitcard service. The default URL is *https://www.bitcard.org/*. The other *_url methods are build based on the "bitcard_url" value. $bc->login_url( r => $return_url ) Returns the URL for the user to login. Takes a hash or hash ref with extra parameters to put in the URL. One of them must be the "r" parameter with the URL the user will get returned to after logging in (or canceling the login). $bc->logout_url( r => $return_url ) Returns the URL you can send the user if they wish to logout. Also needs the "r" parameter for the URL the Bitcard server should send the user back to after logging out. $bc->account_url( r => $return_url ) Returns the URL the user can edit his Bitcard account information at. Also needs the "r" parameter like "login_url" and "logout_url". $bc->register_url( r => $return_url ) Returns the URL for a user to register a new Bitcard account. Also needs the "r" parameter as above. $bc->key_url() Get the URL from which the Bitcard public key can be obtained. $bc->info_required( $string | [ array ref ] ) With info_required you specify what user data you require. The possible fields are "username", "name" and "email" (see "verify" for more information). The method takes either a comma separated string or a reference to an array. This must be called before "login_url". NOTE: "name" is currently not implemented well in the Bitcard server, so we recommend you require "username", but mark "name" as optional if you want the "display name" of the user returned. $bc->info_optional( $string | [ array ref ] ) As "info_required" except the Bitcard server will ask the user to allow the information to be forwarded, but not require it to proceed. The Bitcard server will always have a confirmed email address on file before letting a user login. $bc->verify($query) Verify a Bitcard signature based on the other parameters given. The signature and other parameters are found in the *$query* object, which should be either a hash reference, or any object that supports a *param* method--for example, a *CGI* or *Apache::Request* object. If the signature is successfully verified, *verify* returns a reference to a hash containing the following values. * id The unique user id of the Bitcard user on your site. It's a 128bit number as a 40 byte hex value. The id is always returned when the verification was successful (all other user data fields are optional, see "info_required" and "info_optional"). * username The unique username of the Bitcard user. * name The user's display name. * email The user's email address. * ts The timestamp at which the signature was generated, expressed as seconds since the epoch. If verification is unsuccessful, *verify* will return "undef", and the error message can be found in "$bc->errstr". $bc->key_cache([ $cache ]) Provide a caching mechanism for the public key. If *$cache* is a CODE reference, it is treated as a callback that should return the public key. The callback will be passed two arguments: the *Authen::TypeKey* object, and the URI of the key. It should return a hash reference with the *p*, *g*, *q*, and *pub_key* keys set to *Math::BigInt* objects representing the pieces of the DSA public key. Otherwise, *$cache* should be the path to a local file where the public key will be cached/mirrored. If *$cache* is not set, the key is not cached. By default, no caching occurs. $bc->skip_expiry_check([ $boolean ]) Get/set a value indicating whether *verify* should check the expiration date and time in the TypeKey parameters. The default is to check the expiration date and time. $bc->expires([ $secs ]) Get/set the amount of time at which a Bitcard signature is intended to expire. The default value is 600 seconds, i.e. 10 minutes. $bc->ua([ $user_agent ]) Get/set the LWP::UserAgent-like object which will be used to retrieve the regkeys from the network. Needs to support *mirror* and *get* methods. By default, LWP::UserAgent is used, and this method as a getter returns "undef" unless the user agent has been previously set. $bc->version([ $version ]) Get/set the version of the Bitcard protocol to use. The default version is 3. $bc->api_secret( $secret ) Get/set the api_secret (needed for some API calls, add_invite for example). $bc->add_invite Returns a hashref with "invite_url" and "invite_key". Can be used for "invitation only" sites where you have to login before you can access the site. LICENSE *Authen::Bitcard* is distributed under the Apache License; see the LICENSE file in the distribution for details. AUTHOR & COPYRIGHT Except where otherwise noted, *Authen::Bitcard* is Copyright 2004-2010 Develooper LLC, ask@develooper.com. Parts are Copyright 2004 Six Apart Ltd, cpan@sixapart.com. All rights reserved. Changes000644000765000024 134511574621001 14651 0ustar00askstaff000000000000Authen-Bitcard-0.90 0.90 June 11, 2011 - Make sure LWP is installed with https support - Fix spelling error in documentation (Ansgar Burchardt, RT#60022) 0.89 August 2, 2010 - Use JSON instead of JSON::XS - Use Digest::SHA instead of Digest::SHA1 (RT#59919, Ansgar Burchardt) - Add add_invite method - Various tweaks 0.87 - September 14, 2009 - Add Class::ErrorHandler to the prereqs list - Update documentation 0.86 - July 4th 2006 - Add the Changes file to the distribution - register_url method - bump version to 4 - prepare to support "unconfirmed users" - Use ExtUtils::MakeMaker instead of Module::Build 0.85 - July 21th 2005 - New API, works with http://www.bitcard.org/ 0.50 - July 3rd 2004 - Initial release LICENSE000644000765000024 2636111574621001 14410 0ustar00askstaff000000000000Authen-Bitcard-0.90This software is Copyright (c) 2011 by Ask Bjørn Hansen. This is free software, licensed under: The Apache License, Version 2.0, January 2004 Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work. To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "[]" replaced with your own identifying information. (Don't include the brackets!) The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright [yyyy] [name of copyright owner] Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. dist.ini000644000765000024 133411574621001 15020 0ustar00askstaff000000000000Authen-Bitcard-0.90name = Authen-Bitcard author = Ask Bjørn Hansen license = Apache_2_0 copyright_holder = Ask Bjørn Hansen # copyright_year = 2004-2010 [Prereqs] Math::BigInt = 0 MIME::Base64 = 0 Digest::SHA = 0 LWP::UserAgent = 0 LWP::Protocol::https = 0 HTTP::Status = 0 URI = 1.22 Class::ErrorHandler = 0 JSON = 2.12 [Prereqs / TestRequires ] Test::More = 0 [@Git] # push_to = all [@Filter] bundle = @Basic remove = Readme remove = Manifest [Repository] [Homepage] [BumpVersionFromGit] [PkgVersion] [CheckChangeLog] [CompileTests] [DistManifestTests] [HasVersionTests] [MetaTests] [ReadmeFromPod] [PodCoverageTests] [Manifest] [NextRelease] format = %-7v %{MMMM d, yyyy}d META.yml000644000765000024 133511574621001 14626 0ustar00askstaff000000000000Authen-Bitcard-0.90--- abstract: 'Bitcard authentication verification' author: - 'Ask Bjørn Hansen ' build_requires: Test::More: 0 configure_requires: ExtUtils::MakeMaker: 6.31 dynamic_config: 0 generated_by: 'Dist::Zilla version 4.200001, CPAN::Meta::Converter version 2.101670' license: apache meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Authen-Bitcard requires: Class::ErrorHandler: 0 Digest::SHA: 0 HTTP::Status: 0 JSON: 2.12 LWP::Protocol::https: 0 LWP::UserAgent: 0 MIME::Base64: 0 Math::BigInt: 0 URI: 1.22 resources: homepage: http://search.cpan.org/dist/Authen-Bitcard/ repository: http://git.develooper.com/bitcard-perl-api.git version: 0.90 MANIFEST000644000765000024 50011574621001 14457 0ustar00askstaff000000000000Authen-Bitcard-0.90Changes LICENSE MANIFEST META.yml Makefile.PL README dist.ini lib/Authen/Bitcard.pm t/00-compile.t t/10config.t t/11login.nt t/11verify.t t/12ticket.nt t/13podcoverage.t t/14session.nt t/15pod.t t/18attributes.nt t/coverage t/release-dist-manifest.t t/release-distmeta.t t/release-has-version.t t/release-pod-coverage.t t000755000765000024 011574621001 13457 5ustar00askstaff000000000000Authen-Bitcard-0.9015pod.t000644000765000024 20111574621001 14704 0ustar00askstaff000000000000Authen-Bitcard-0.90/tuse Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); coverage000644000765000024 33011574621001 15310 0ustar00askstaff000000000000Authen-Bitcard-0.90/t/home/perl/bin/cover -delete; PERL5OPT=-MDevel::Cover=-ignore,Build perl Build test /home/perl/bin/cover -report html -outputdir /home/ask/public_html/tmp/coverage # http://one.develooper.com/~ask/tmp/coverage/ Makefile.PL000644000765000024 234411574621001 15330 0ustar00askstaff000000000000Authen-Bitcard-0.90 use strict; use warnings; use ExtUtils::MakeMaker 6.31; my %WriteMakefileArgs = ( 'ABSTRACT' => 'Bitcard authentication verification', 'AUTHOR' => 'Ask Bjørn Hansen ', 'BUILD_REQUIRES' => { 'Test::More' => '0' }, 'CONFIGURE_REQUIRES' => { 'ExtUtils::MakeMaker' => '6.31' }, 'DISTNAME' => 'Authen-Bitcard', 'EXE_FILES' => [], 'LICENSE' => 'apache', 'NAME' => 'Authen::Bitcard', 'PREREQ_PM' => { 'Class::ErrorHandler' => '0', 'Digest::SHA' => '0', 'HTTP::Status' => '0', 'JSON' => '2.12', 'LWP::Protocol::https' => '0', 'LWP::UserAgent' => '0', 'MIME::Base64' => '0', 'Math::BigInt' => '0', 'URI' => '1.22' }, 'VERSION' => '0.90', 'test' => { 'TESTS' => 't/*.t' } ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) { my $br = delete $WriteMakefileArgs{BUILD_REQUIRES}; my $pp = $WriteMakefileArgs{PREREQ_PM}; for my $mod ( keys %$br ) { if ( exists $pp->{$mod} ) { $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod}; } else { $pp->{$mod} = $br->{$mod}; } } } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); 10config.t000644000765000024 143111574621001 15410 0ustar00askstaff000000000000Authen-Bitcard-0.90/tuse Test::More tests => 8; use strict; use URI; use_ok('Authen::Bitcard', 'load module'); ok(my $bc = Authen::Bitcard->new(), "new"); ok($bc->bitcard_url('http://test.bitcard.org/'), 'set bitcard_url'); ok($bc->token('a077fbb7942cbeb296dbac1de20020'), 'token'); ok(my $lurl = $bc->login_url(r => 'http://example.com/'), 'get login_url'); #my $u = URI->new('http://test.bitcard.org/login?bc_v=4&bc_r=http%3A%2F%2Fexample.com%2F&bc_t=a077fbb7942cbeb296dbac1de20020'); my $u = URI->new($lurl); is_deeply({ $u->query_form }, +{ bc_v => 4, bc_r => 'http://example.com/', bc_t => 'a077fbb7942cbeb296dbac1de20020' }, 'login_url query parms' ); ok($bc->info_required('email'), 'info_required'); is($bc->key_url, 'http://test.bitcard.org/regkey.txt', 'key_url' ); 11login.nt000644000765000024 260511574621001 15436 0ustar00askstaff000000000000Authen-Bitcard-0.90/tuse Test::More tests => 12; use strict; use warnings; use lib 't'; use_ok('Authen::Bitcard'); use Test::AuthClient; use Test::WWW::Mechanize; ok(Authen::Bitcard->set_config(Test::AuthClient->config_args), 'set config'); ok(my $auth = Authen::Bitcard->new(), "new"); my $agent = Test::WWW::Mechanize->new(); $agent->get($auth->login_url); ok($agent->success, "got login page"); $agent->form_name('login'); $agent->field('login', 'test'); $agent->field('password', 'foo'); $agent->click; my $uri = URI::URL->new($agent->uri); is($uri->host, "authtest.askask.com", "we got sent to authtest"); #if(open F, ">/home/ask/public_html/tmp/a1.html") { # print F $agent->content; # close F; #} my (%q) = $uri->query_form; ok($q{t}, "got ticket"); ok($auth = Authen::Bitcard->new(t => $q{t}), "new authclient, with ticket"); ok($auth->delete_session, "delete session right away"); my $return_url = "http://authtest.askask.com/?test=logout"; $agent->get($auth->logout_url("return_url" => $return_url)); $agent->follow_link( text_regex => qr/Continue/i ); ok($agent->success, 'got logout page'); is($agent->uri, $return_url, "landed at the right page"); my $url = $auth->login_url(info_request => "email"); like($url, qr/i=email/, 'login_url(info_request => "email")'); $url = $auth->login_url(info_request => ['username','email']); like($url, qr/i=username(,|\%2C)email/, 'login_url(info_request => [array])'); 11verify.t000644000765000024 337111574621001 15455 0ustar00askstaff000000000000Authen-Bitcard-0.90/tuse Test::More; use strict; my @urls = ( 'http://www.example.com/?bc_fields=bc_id%2Cbc_ts%2Cbc_fields&bc_id=cb77bb221a5cae1592489f51ee24006c2a1ee3c5&bc_sig=Y9s3bV%2BEpQl%2F6e7uqsoGRvUleqk%3D%3A0u80L0bpNkaRut3TfDuvuJt6OeI%3D&bc_ts=1121997143', 'http://www.example.com/?bc_email=ask%40develooper.com&bc_fields=bc_id%2Cbc_email%2Cbc_username%2Cbc_name%2Cbc_ts%2Cbc_fields&bc_id=cb77bb221a5cae1592489f51ee24006c2a1ee3c5&bc_name=Ask+Bjørn+Hansen&bc_sig=1T3KAgbdbz05utyO4cP16Kug4xo%3D%3Avm6Rp5bwRK5DYfozf5Crdmsh0HY%3D&bc_ts=1122022689&bc_username=ask' ); plan tests => 4 + 1*@urls; use_ok('Authen::Bitcard', 'load module'); ok(my $bc = Authen::Bitcard->new( bitcard_url => 'http://test.bitcard.org/' ), "new"); ok($bc->token('731f1d4110b4d03d6c65cd8df408c2'), 'token'); $bc->version(3); $bc->key_cache(sub { &__bitcard_key }); ok($bc->skip_expiry_check(1), 'skip_expiry_check'); # $bc->info_required('email,username,name'); for my $url (@urls) { my $url = URI->new($url); my %form = $url->query_form; ok(my $data = $bc->verify(\%form), 'verify'); } sub __bitcard_key { my $data ='p=11996369463481565292523121140449531889825095982121983761936827865954801073413849839236052880545722284106237673100457431775834799856485806364388478204231543 g=11079984797594333311123894730450538747563758095776837999552541421517868087145325620603225047995061886285778482662140484776140447470922327545853855737935682 q=1325099124387589349068596816147033244974696025417 pub_key=8544831415282596138360036915566670162338109712662730782097481290631305162711704659417023332347142944863751759764390118340330011853246719351387417817211195'; use Math::BigInt; chomp $data; my $key = {}; for my $f (split /\s+/, $data) { my($k, $v) = split /=/, $f, 2; $key->{$k} = Math::BigInt->new($v); } $key; }12ticket.nt000644000765000024 313211574621001 15606 0ustar00askstaff000000000000Authen-Bitcard-0.90/tuse Test::More qw(no_plan); use strict; use warnings; use lib 't'; use_ok('Authen::Bitcard'); use Test::AuthClient; use Test::WWW::Mechanize; my $agent = Test::WWW::Mechanize->new(); ok(Authen::Bitcard->set_config(Test::AuthClient->config_args), 'set config'); ok(my $auth = Authen::Bitcard->new(), "new"); $agent->get($auth->login_url); ok($agent->success, "got login page"); $agent->set_visible('test', 'foo'); $agent->click; my %q = URI::URL->new($agent->uri)->query_form; ok($q{t}, "got ticket"); # simulate new request to the site server ... ok($auth = Authen::Bitcard->new(ticket => $q{t}), "new authclient, with ticket"); ok($auth->is_authenticated, "is_authenticated"); ok($auth->user_id, "user_id"); is($auth->username, "test", "username"); ok($auth->email, "email"); ok(my $session_id = $auth->session_id, "get session_id"); # new request with the session_id ok($auth = Authen::Bitcard->new(session_id => $session_id), "new authclient, with session_id"); is($auth->username, "test", "username is still test with session_id"); ok(sleep 2, "sleep 2 seconds"); ok($auth->data_age >= 2, "data_age 2 seconds or older"); ok($auth->force_refresh(1), "force_refresh"); ok($auth->data_age < 2, "data_age less than 2 seconds"); ok($auth->delete_session, "delete session"); is($auth->data_age, undef, "data_age undef without a session"); my $return_url = "http://authtest.askask.com/?test=logout"; $agent->get($auth->logout_url("return_url" => $return_url)); ok($agent->success, 'got logout page'); $agent->follow_link( text_regex => qr/Continue/i ); is($agent->uri, $return_url, "landed at the right page"); 14session.nt000644000765000024 127211574621001 16013 0ustar00askstaff000000000000Authen-Bitcard-0.90/tuse Test::More qw(no_plan); use strict; use warnings; use lib 't'; use_ok('Authen::Bitcard'); use Test::AuthClient; # For now just testing non-working sessions here, the real session tests are in 12tickets.t ok(Authen::Bitcard->set_config(Test::AuthClient->config_args), 'set config'); ok(my $auth = Authen::Bitcard->new(session_id => "1234"), "new authclient, with non existing session_id"); ok(!$auth->is_authenticated, "isn't authenticated"); is($auth->username, "", "no session, no user_id"); is($auth->session_id, "", "invalid session_id makes auth->session_id return emptry string"); ok($auth = Authen::Bitcard->new(session_id => '44574810595a34b3c7dd5ba602a2366bea9166f3'), 'foo'); 00-compile.t000644000765000024 203611574621001 15651 0ustar00askstaff000000000000Authen-Bitcard-0.90/t#!perl use strict; use warnings; use Test::More; use File::Find; use File::Temp qw{ tempdir }; my @modules; find( sub { return if $File::Find::name !~ /\.pm\z/; my $found = $File::Find::name; $found =~ s{^lib/}{}; $found =~ s{[/\\]}{::}g; $found =~ s/\.pm$//; # nothing to skip push @modules, $found; }, 'lib', ); my @scripts = glob "bin/*"; my $plan = scalar(@modules) + scalar(@scripts); $plan ? (plan tests => $plan) : (plan skip_all => "no tests to run"); { # fake home for cpan-testers # no fake requested ## local $ENV{HOME} = tempdir( CLEANUP => 1 ); like( qx{ $^X -Ilib -e "require $_; print '$_ ok'" }, qr/^\s*$_ ok/s, "$_ loaded ok" ) for sort @modules; SKIP: { eval "use Test::Script 1.05; 1;"; skip "Test::Script needed to test script compilation", scalar(@scripts) if $@; foreach my $file ( @scripts ) { my $script = $file; $script =~ s!.*/!!; script_compiles( $file, "$script script compiles" ); } } } 13podcoverage.t000644000765000024 32711574621001 16427 0ustar00askstaff000000000000Authen-Bitcard-0.90/tuse Test::More; eval 'use Test::Pod::Coverage'; if ($@) { plan skip_all => "Could not load Test::Pod::Coverage"; } else { plan tests => 1; } pod_coverage_ok( "Authen::Bitcard", "Authen::Bitcard is covered" ); 18attributes.nt000644000765000024 235211574621001 16522 0ustar00askstaff000000000000Authen-Bitcard-0.90/tuse Test::More qw(no_plan); use strict; use warnings; use lib 't'; use_ok('Authen::Bitcard'); use Test::AuthClient; use Test::WWW::Mechanize; my $agent = Test::WWW::Mechanize->new(); ok(Authen::Bitcard->set_config(Test::AuthClient->config_args), 'set config'); ok(my $auth = Authen::Bitcard->new(), "new"); $agent->get($auth->login_url); ok($agent->success, "got login page"); $agent->set_visible('test', 'foo'); $agent->click; my %q = URI::URL->new($agent->uri)->query_form; ok($q{t}, "got ticket"); # simulate new request to the site server ... ok($auth = Authen::Bitcard->new(ticket => $q{t}), "new authclient, with ticket"); ok($auth->is_authenticated, "is_authenticated"); ok(my $session_id = $auth->session_id, "get session_id"); ## new request with the session_id #ok($auth = Authen::Bitcard->new(session_id => $session_id), "new authclient, with session_id"); my $attribute = "foobar"; ok($auth->set_attribute("test" => $attribute), "set_attribute"); is($auth->get_attribute("test", "get_attribute"), $attribute, "get_attribute"); ok($auth->delete_session, "delete session"); # cleanup the session on the auth server my $return_url = "http://authtest.askask.com/?test=logout"; $agent->get($auth->logout_url("return_url" => $return_url)); release-distmeta.t000644000765000024 45511574621001 17217 0ustar00askstaff000000000000Authen-Bitcard-0.90/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::CPAN::Meta"; plan skip_all => "Test::CPAN::Meta required for testing META.yml" if $@; meta_yaml_ok(); Authen000755000765000024 011574621001 15206 5ustar00askstaff000000000000Authen-Bitcard-0.90/libBitcard.pm000644000765000024 3057411574621001 17304 0ustar00askstaff000000000000Authen-Bitcard-0.90/lib/Authenpackage Authen::Bitcard; BEGIN { $Authen::Bitcard::VERSION = '0.90'; } use strict; use base qw( Class::ErrorHandler ); use Math::BigInt; use MIME::Base64 qw( decode_base64 ); use Digest::SHA qw( sha1 sha1_hex ); use LWP::UserAgent; use HTTP::Status qw( RC_NOT_MODIFIED ); use URI; use URI::QueryParam; use Carp qw(croak); use JSON qw(decode_json); sub new { my $class = shift; my $bc = bless { }, $class; $bc->skip_expiry_check(0); $bc->expires(600); $bc->bitcard_url('https://www.bitcard.org/'); $bc->version(4); $bc->token(''); my %args = @_; for my $k (keys %args) { next unless $bc->can($k); $bc->$k($args{$k}); } $bc; } sub _var { my $bc = shift; my $var = shift; $bc->{$var} = shift if @_; $bc->{$var}; } sub key_cache { shift->_var('key_cache', @_) } sub skip_expiry_check { shift->_var('skip_expiry_check', @_) } sub expires { shift->_var('expires', @_) } sub token { shift->_var('token', @_) } sub api_secret { shift->_var('api_secret', @_) } sub version { shift->_var('version', @_) } sub ua { shift->_var('ua', @_) } sub bitcard_url { shift->_var('bitcard_url', @_) } sub info_optional { shift->_var('io', @_) } sub info_required { shift->_var('ir', @_) } sub _url { my ($bc, $url) = (shift, shift); my $args = ($_[0] && ref $_[0]) ? $_[0] : { @_ }; $args->{"bc_$_"} = delete $args->{$_} for keys %$args; $args->{bc_t} = $bc->token; $args->{bc_v} = $bc->version; $args->{bc_io} = ref $bc->info_optional ? join ",", @{$bc->info_optional} : $bc->info_optional; $args->{bc_ir} = ref $bc->info_required ? join ",", @{$bc->info_required} : $bc->info_required; delete $args->{bc_io} unless $args->{bc_io}; delete $args->{bc_ir} unless $args->{bc_ir}; my $base = $bc->bitcard_url; $base = "$base/" unless $base =~ m!/$!; my $uri = URI->new($base . $url); unless ($url =~ m/regkey.txt/) { if ($url =~ m!^api/!) { croak "Bitcard API Secret required for API calls" unless $bc->api_secret; $args->{bc_ts} = time; my @fields = sort keys %$args; $args->{bc_fields} = join ",", @fields, 'bc_fields'; my $string = join "::", (map { "$args->{$_}" } @fields, 'bc_fields'), $bc->api_secret; warn "ST: $string"; $args->{bc_sig} = sha1_hex($string); } $uri->query_form_hash($args); } $uri->as_string; } sub key_url{ shift->_url("regkey.txt"); } sub login_url { shift->_url('login', @_) } sub logout_url { shift->_url('logout', @_) } sub account_url { shift->_url('account', @_) } sub register_url { shift->_url('register', @_) } sub _api_url { my ($self, $method) = (shift, shift); $self->_url("api/$method", @_); } sub verify { my $bc = shift; my %data; my $fields; if (@_ == 1) { my $q = $_[0]; if (ref $q eq 'HASH') { $fields = $_[0]->{bc_fields} || ''; %data = map { $_ => $_[0]->{$_} } grep { defined $_[0]->{$_} } split(/,/, $fields), 'bc_sig'; } else { $fields = $q->param('bc_fields') || ''; %data = map { $_ => $q->param($_) } grep { defined $q->param($_) } split(/,/, $fields), 'bc_sig'; } } else { ## Later we could process arguments passed in a hash. return $bc->error("usage: verify(\$query)"); } #warn Data::Dumper->Dump([\%data], [qw(data)]); for ($data{bc_email}, $data{bc_sig}) { defined $_ and tr/ /+/; } return $bc->error("Bitcard data has expired") unless $bc->skip_expiry_check or ($data{bc_ts}||0) + $bc->expires >= time; my $key = $bc->_fetch_key($bc->key_url) or return; my($r, $s) = split /:/, $data{bc_sig}; my $sig = {}; $sig->{r} = Math::BigInt->new("0b" . unpack("B*", decode_base64($r))); $sig->{s} = Math::BigInt->new("0b" . unpack("B*", decode_base64($s))); my $msg = join '::', (map { $data{$_} || '' } split /,/, $data{bc_fields} ), $bc->token; unless ($bc->_verify($msg, $key, $sig)) { return $bc->error("Bitcard signature verification failed"); } for my $k (keys %data) { my $nk = $k; $nk =~ s/^bc_//; $data{$nk} = delete $data{$k}; } if ($bc->version >= 4) { unless ($data{version} == $bc->version) { $data{version} =~ s/\D//g; return $bc->error(sprintf "Expected Bitcard protocol version [%i], got version [%i].", $bc->version, $data{version}); } unless ($data{confirmed}) { return $bc->error('Account not confirmed'); } } \%data; } sub _verify { my $bc = shift; my($msg, $key, $sig) = @_; my $u1 = Math::BigInt->new("0b" . unpack("B*", sha1($msg))); $sig->{s}->bmodinv($key->{q}); $u1 = ($u1 * $sig->{s}) % $key->{q}; $sig->{s} = ($sig->{r} * $sig->{s}) % $key->{q}; $key->{g}->bmodpow($u1, $key->{p}); $key->{pub_key}->bmodpow($sig->{s}, $key->{p}); $u1 = ($key->{g} * $key->{pub_key}) % $key->{p}; $u1 %= $key->{q}; $u1 == $sig->{r}; } sub _get_ua { shift->ua || LWP::UserAgent->new; } sub _fetch_key { my $bc = shift; my($uri) = @_; my $cache = $bc->key_cache; ## If it's a callback, call it and return the return value. return $cache->($bc, $uri) if $cache && ref($cache) eq 'CODE'; ## Otherwise, load the key. my $data; my $ua = $bc->_get_ua; if ($cache) { my $res = $ua->mirror($uri, $cache); return $bc->error("Failed to fetch key: " . $res->status_line) unless $res->is_success || $res->code == RC_NOT_MODIFIED; open my $fh, $cache or return $bc->error("Can't open $cache: $!"); $data = do { local $/; <$fh> }; close $fh; } else { my $res = $ua->get($uri); return $bc->error("Failed to fetch key: " . $res->status_line) unless $res->is_success; $data = $res->content; } chomp $data; my $key = {}; for my $f (split /\s+/, $data) { my($k, $v) = split /=/, $f, 2; $key->{$k} = Math::BigInt->new($v); } $key; } sub add_invite { my $self = shift; my $url = $self->_api_url('invite/add_invite', @_); warn "URL: $url\n"; my $res = $self->_get_ua->get($url); return $self->error("Failed to retrive invitation code: " . $res->status_line) unless $res->is_success; my $data = decode_json($res->content); $data; } 1; __END__ =head1 NAME Authen::Bitcard - Bitcard authentication verification =head1 SYNOPSIS use CGI; use Authen::Bitcard; my $q = CGI->new; my $bc = Authen::Bitcard->new; $bc->token('bitcard-token'); # send user to $bc->login_url(r => $return_url); # when the user comes back, get the user id with: my $user = $bc->verify($q) or die $bc->errstr; =head1 DESCRIPTION I is an implementation of verification for signatures generated by Bitcard authentication. For information on the Bitcard protocol and using Bitcard in other applications, see I. The module and the protocol are heavily based on I. (In fact, the Bitcard authentication server also supports the TypeKey API!) =head1 USAGE =head2 Authen::Bitcard->new Create a new I object. =head2 $bc->token([ $bitcard_token ]) Your Bitcard token, which you passed to Bitcard when creating the original sign-in link. This must be set B calling I or I (etc). =head2 $bc->bitcard_url( [ $url ]) Get/set the base URL for the Bitcard service. The default URL is I. The other *_url methods are build based on the C value. =head2 $bc->login_url( r => $return_url ) Returns the URL for the user to login. Takes a hash or hash ref with extra parameters to put in the URL. One of them must be the C parameter with the URL the user will get returned to after logging in (or canceling the login). =head2 $bc->logout_url( r => $return_url ) Returns the URL you can send the user if they wish to logout. Also needs the C parameter for the URL the Bitcard server should send the user back to after logging out. =head2 $bc->account_url( r => $return_url ) Returns the URL the user can edit his Bitcard account information at. Also needs the C parameter like C and C. =head2 $bc->register_url( r => $return_url ) Returns the URL for a user to register a new Bitcard account. Also needs the C parameter as above. =head2 $bc->key_url() Get the URL from which the Bitcard public key can be obtained. =head2 $bc->info_required( $string | [ array ref ] ) With info_required you specify what user data you require. The possible fields are "username", "name" and "email" (see C for more information). The method takes either a comma separated string or a reference to an array. This must be called before C. NOTE: "name" is currently not implemented well in the Bitcard server, so we recommend you require "username", but mark "name" as optional if you want the "display name" of the user returned. =head2 $bc->info_optional( $string | [ array ref ] ) As C except the Bitcard server will ask the user to allow the information to be forwarded, but not require it to proceed. The Bitcard server will always have a confirmed email address on file before letting a user login. =head2 $bc->verify($query) Verify a Bitcard signature based on the other parameters given. The signature and other parameters are found in the I<$query> object, which should be either a hash reference, or any object that supports a I method--for example, a I or I object. If the signature is successfully verified, I returns a reference to a hash containing the following values. =over 4 =item * id The unique user id of the Bitcard user on your site. It's a 128bit number as a 40 byte hex value. The id is always returned when the verification was successful (all other user data fields are optional, see C and C). =item * username The unique username of the Bitcard user. =item * name The user's display name. =item * email The user's email address. =item * ts The timestamp at which the signature was generated, expressed as seconds since the epoch. =back If verification is unsuccessful, I will return C, and the error message can be found in C<$bc-Eerrstr>. =head2 $bc->key_cache([ $cache ]) Provide a caching mechanism for the public key. If I<$cache> is a CODE reference, it is treated as a callback that should return the public key. The callback will be passed two arguments: the I object, and the URI of the key. It should return a hash reference with the I

, I, I, and I keys set to I objects representing the pieces of the DSA public key. Otherwise, I<$cache> should be the path to a local file where the public key will be cached/mirrored. If I<$cache> is not set, the key is not cached. By default, no caching occurs. =head2 $bc->skip_expiry_check([ $boolean ]) Get/set a value indicating whether I should check the expiration date and time in the TypeKey parameters. The default is to check the expiration date and time. =head2 $bc->expires([ $secs ]) Get/set the amount of time at which a Bitcard signature is intended to expire. The default value is 600 seconds, i.e. 10 minutes. =head2 $bc->ua([ $user_agent ]) Get/set the LWP::UserAgent-like object which will be used to retrieve the regkeys from the network. Needs to support I and I methods. By default, LWP::UserAgent is used, and this method as a getter returns C unless the user agent has been previously set. =head2 $bc->version([ $version ]) Get/set the version of the Bitcard protocol to use. The default version is C<3>. =head2 $bc->api_secret( $secret ) Get/set the api_secret (needed for some API calls, add_invite for example). =head2 $bc->add_invite Returns a hashref with C and C. Can be used for "invitation only" sites where you have to login before you can access the site. =head1 LICENSE I is distributed under the Apache License; see the LICENSE file in the distribution for details. =head1 AUTHOR & COPYRIGHT Except where otherwise noted, I is Copyright 2004-2010 Develooper LLC, ask@develooper.com. Parts are Copyright 2004 Six Apart Ltd, cpan@sixapart.com. All rights reserved. =cut release-has-version.t000644000765000024 47311574621001 17643 0ustar00askstaff000000000000Authen-Bitcard-0.90/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::HasVersion"; plan skip_all => "Test::HasVersion required for testing version numbers" if $@; all_pm_version_ok(); release-pod-coverage.t000644000765000024 76511574621001 17764 0ustar00askstaff000000000000Authen-Bitcard-0.90/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::Pod::Coverage 1.08"; plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" if $@; eval "use Pod::Coverage::TrustPod"; plan skip_all => "Pod::Coverage::TrustPod required for testing POD coverage" if $@; all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); release-dist-manifest.t000644000765000024 46611574621001 20156 0ustar00askstaff000000000000Authen-Bitcard-0.90/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::DistManifest"; plan skip_all => "Test::DistManifest required for testing the manifest" if $@; manifest_ok();