Revision history for Catalyst::Authentication::Credential::OpenID
-0.14 Tue Aug 18 22:37:51 PDT 2009
- - Split live tests into two test apps to avoid the need to fork
- to have a self-answering server; crudely done, it's the same
- exact code as before doubled for now.
- - Took LWPx::ParanoidAgent out of tests. It's been too long
- since it's been broken by the LWP debug deprecation.
+0.14 Mon Dec 8 20:01:53 PST 2008
+ - Added a test case to see if bad openid URIs cause failure.
+ - Added a test case to see if "tarpit" URIs cause failure.
+
+0.13 Mon Dec 1 19:42:31 PST 2008
+ - s/Meno/Menno/ and version fix in the Pod are the only changes. Sigh.
+
+0.12 Mon Dec 1 19:28:02 PST 2008
+ - Everything is finally passing tests so I put most of the
+ previous versions on the backpan because they're nearly
+ identical except for Makefile changes.
+ - Applied code from Menno Blom to allow simple registration
+ to work. Considered experimental for now, I think. Not because
+ it won't stay but because it might not work as expected.
+ - Bumped reqs on OpenID family to support 2.0 features.
+
+0.11 Sun Oct 5 00:41:37 PDT 2008
+ - Added LWPx paranoid to build_requires.
+ - Put some experimental mdash entities into the Pod.
+
+0.10 Thu Oct 2 19:13:42 PDT 2008
+ - Just twiddled the requirements calls in the Makefile. I can't
+ figure out why testers are failing it for prereqs it *is*
+ listing. Someone recently mentioned this same problem on
+ use.perl so I'm giving this a shot.
+ - Spelling fix in Pod.
+ - Updated tests and test server script too.
+
+0.09 Mon Sep 29 18:29:59 PDT 2008
+ - Bug patch for boneheaded return v detach bug given by M. Blom.
+
+0.08 Sat Jul 5 13:13:14 PDT 2008
+ - Again, only change is to Makefile.PL reqs.
+
+0.07 Thu Jul 3 21:26:12 PDT 2008
+ - Only changes are to Makefile for prereqs. The failures on CPAN
+ testers are really weird. I think I misunderstood
+ build_requires() in ModInst.
+
+0.06 Thu Jul 3 17:20:39 PDT 2008
+ - All CPAN reports for 0.05 are failing. Added Catalyst::Devel and
+ Catalyst to prereqs. It was just Catalyst::Runtime before.
+ - Also changed around Test App storage a bit to avoid permission
+ errors on tmp cache file from different user runs.
+
+0.05 Wed Jul 2 20:17:21 PDT 2008
+ - Removed UNIVERSAL::require to shrink prereqs and protect
+ namespaces.
+ - Turned on test app tests. I want to know if it's failing for
+ others.
+ - Swapped LWPx::ParanoidAgent for LWP::UA in the test.
+
+0.04 Thu Jun 19 23:20:00 PDT 2008
+ - Fixed some of the .conf example. Sigh.
+ - Other minor Pod tweaks.
+
+0.03 Thu Jun 19 20:48:04 PDT 2008
+ - Updated config information with Config::General examples.
+ - Cleaned up TestApp a little.
+ - Swapped some code order around to make Perl::Critic my friend.
+ - Extended SEE ALSO.
+ - Updated Makefile a bit.
+
+0.02 Tue Apr 8 22:18:22 PDT 2008
+ - Changed "use base" to "use parent."
+ - Moved SVN to Catalyst dev box.
+ - Took out left over toss copy of earlier Credential module.
+ - Took out weird closure over secret; not just sets it plainly.
+ - Put config stuff in POD a bit differently and added info on consumer_secret.
+ - POD tweaks.
+
+0.01 Sat Apr 5 21:35:25 PDT 2008
+ - Initial release.
+Revision history for Catalyst::Authentication::Credential::OpenID
0.13 Mon Dec 1 19:42:31 PST 2008
- s/Meno/Menno/ and version fix in the Pod are the only changes. Sigh.
+Catalyst-Authentication-Credential-OpenID.patch
Changes
inc/Module/AutoInstall.pm
inc/Module/Install.pm
META.yml
README
t/00.load.t
-t/Consumer/lib/TestApp.pm
-t/Consumer/lib/TestApp/Controller/Root.pm
-t/Consumer/script/testapp_server.pl
-t/live-app.t
+t/live_app.t
t/pod-coverage.t
t/pod.t
-t/Provider/lib/TestApp.pm
-t/Provider/lib/TestApp/Controller/Root.pm
-t/Provider/script/testapp_server.pl
+t/TestApp/lib/TestApp.pm
+t/TestApp/lib/TestApp/Controller/Root.pm
+t/TestApp/script/testapp_server.pl
+Catalyst-Authentication-Credential-OpenID.patch
+Changes
+inc/Module/AutoInstall.pm
+inc/Module/Install.pm
+inc/Module/Install/AutoInstall.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+lib/Catalyst/Authentication/Credential/OpenID.pm
+Makefile.PL
+MANIFEST This list of files
+MANIFEST.skip
+META.yml
+README
+t/00.load.t
+t/live_app.t
+t/pod-coverage.t
+t/pod.t
+t/TestApp/lib/TestApp.pm
+t/TestApp/lib/TestApp/Controller/Root.pm
+t/TestApp/script/testapp_server.pl
\#$
\b\.#
\.DS_Store
+Catalyst/Authentication/Store
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+\B\.cvsignore\b
+
+\bMakefile$
+\bblib
+\bMakeMaker-\d
+\bpm_to_blib$
+\bblibdirs$
+\.tar
+\.gz
+\bBuild$
+\b_build
+
+~$
+\.tmp$
+\.old$
+\.bak$
+\#$
+\b\.#
+\.DS_Store
+use inc::Module::Install;
+
+name "Catalyst-Authentication-Credential-OpenID";
+all_from "lib/Catalyst/Authentication/Credential/OpenID.pm";
+author "Ashley Pond V <ashley@cpan.org>";
+
+requires "parent" => "0.2";
+requires "Class::Accessor::Fast" => undef;
+requires "HTML::Parser" => "3";
+requires "LWP::UserAgent" => undef;
+requires "Cache::FastMmap" => "1.28";
+requires "Catalyst" => "5.7";
+requires "Catalyst::Devel" => "1";
+requires "Crypt::DH" => "0.05"; # IIRC OpenID stuff forgets to prereq this
+requires "Net::OpenID::Consumer" => "1.03";
+requires "Catalyst::Authentication::User::Hash" => undef;
+requires "Catalyst::Plugin::Session::Store::FastMmap" => "0.05";
+requires "Catalyst::Plugin::Session::State::Cookie" => "0.08";
+requires "Catalyst::Engine::HTTP" => undef;
+
+recommends "Config::General" => "2";
+recommends "YAML" => "0.6";
+recommends "Math::BigInt" => undef;
+recommends "LWPx::ParanoidAgent" => "1.03";
+
+build_requires "LWPx::ParanoidAgent" => "1.03";
+build_requires "Test::More" => "0.42";
+build_requires "Net::OpenID::Server" => "1.02";
+build_requires "Test::WWW::Mechanize" => "1.20";
+build_requires "Net::DNS" => undef;
+build_requires "IO::Socket::INET" => undef;
+
+auto_install;
+WriteAll;
+
+__END__
use inc::Module::Install 0.87;
-name "Catalyst-Authentication-Credential-OpenID";
-all_from "lib/Catalyst/Authentication/Credential/OpenID.pm";
-author "Ashley Pond V <ashley@cpan.org>";
-
-requires "parent" => "0.2";
-requires "Class::Accessor::Fast" => undef;
-requires "HTML::Parser" => "3";
-requires "LWP::UserAgent" => undef;
-requires "Cache::FastMmap" => "1.28";
-requires "Catalyst" => "5.7";
-requires "Catalyst::Devel" => "1";
-requires "Crypt::DH" => "0.05"; # IIRC OpenID stuff forgets to prereq this
-requires "Net::OpenID::Consumer" => "1.03";
-requires "Catalyst::Authentication::User::Hash" => undef;
-requires "Catalyst::Plugin::Session::Store::FastMmap" => "0.05";
-requires "Catalyst::Plugin::Session::State::Cookie" => "0.08";
-requires "Catalyst::Engine::HTTP" => undef;
-
-recommends "Config::General" => "2";
-recommends "YAML" => "0.6";
-recommends "Math::BigInt" => undef;
+name "Catalyst-Authentication-Credential-OpenID";
+all_from "lib/Catalyst/Authentication/Credential/OpenID.pm";
+author "Ashley Pond V <ashley@cpan.org>";
+
+requires "parent" => "0.2";
+requires "Class::Accessor::Fast" => undef;
+requires "HTML::Parser" => "3";
+requires "LWP::UserAgent" => undef;
+requires "Cache::FastMmap" => "1.28";
+requires "Catalyst" => "5.7";
+requires "Catalyst::Devel" => "1";
+requires "Crypt::DH" => "0.05"; # IIRC OpenID stuff forgets to prereq this
+requires "Net::OpenID::Consumer" => "1.03";
+requires "Catalyst::Authentication::User::Hash" => undef;
+requires "Catalyst::Plugin::Session::Store::FastMmap" => "0.05";
+requires "Catalyst::Plugin::Session::State::Cookie" => "0.08";
+requires "Catalyst::Engine::HTTP" => undef;
+
+recommends "Config::General" => "2";
+recommends "YAML" => "0.6";
+recommends "Math::BigInt" => undef;
recommends "LWPx::ParanoidAgent" => "1.03";
-test_requires "LWPx::ParanoidAgent" => "1.03";
-test_requires "Test::More" => "0.42";
-test_requires "Net::OpenID::Server" => "1.02";
-test_requires "Test::WWW::Mechanize" => "1.20";
-test_requires "Net::DNS" => undef;
-test_requires "IO::Socket::INET" => undef;
+build_requires "LWPx::ParanoidAgent" => "1.03";
+build_requires "Test::More" => "0.42";
+build_requires "Net::OpenID::Server" => "1.02";
+build_requires "Test::WWW::Mechanize" => "1.20";
+build_requires "Net::DNS" => undef;
+build_requires "IO::Socket::INET" => undef;
auto_install;
-resources repository => 'http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-Authentication-Credential-OpenID/';
+resources repository => 'http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-Authentication-Credential-OpenID/0.13/';
WriteAll;
make test
make install
+Catalyst::Authentication::Credential::OpenID
+
+Just say "no" to document drift. See the POD for any details,
+including copyright and licence, beyond installation.
+
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ # See below for TEST_HTTP info
+ make test
+ make install
+
package Catalyst::Authentication::Credential::OpenID;
use strict;
-# use warnings; no warnings "uninitialized"; # for testing, not production
+use warnings; no warnings "uninitialized"; # for testing, not production 321
use parent "Class::Accessor::Fast";
BEGIN {
my ( $self, $c, $realm, $authinfo ) = @_;
$c->log->debug("authenticate() called from " . $c->request->uri) if $self->debug;
+return 1;
+ my $field = $self->{_config}->{openid_field};
+
+ my $claimed_uri = $authinfo->{ $field };
+
+ # Its security related so we want to be explicit about GET/POST param retrieval.
+ $claimed_uri ||= $c->req->method eq 'GET' ?
+ $c->req->query_params->{ $field } : $c->req->body_params->{ $field };
+
+ my $csr = Net::OpenID::Consumer->new(
+ ua => $self->_config->{ua_class}->new(%{$self->_config->{ua_args} || {}}),
+ args => $c->req->params,
+ consumer_secret => $self->secret,
+ );
+
+ if ( $claimed_uri )
+ {
+ my $current = $c->uri_for($c->req->uri->path); # clear query/fragment...
+
+ my $identity = $csr->claimed_identity($claimed_uri)
+ or Catalyst::Exception->throw($csr->err);
+
+ $identity->set_extension_args(@{$self->_config->{extension_args}})
+ if $self->_config->{extension_args};
+
+ my $check_url = $identity->check_url(
+ return_to => $current . '?openid-check=1',
+ trust_root => $current,
+ delayed_return => 1,
+ );
+ $c->res->redirect($check_url);
+ $c->detach();
+ }
+ elsif ( $c->req->params->{'openid-check'} )
+ {
+ if ( my $setup_url = $csr->user_setup_url )
+ {
+ $c->res->redirect($setup_url);
+ $c->detach();
+ }
+ elsif ( $csr->user_cancel )
+ {
+ return;
+ }
+ elsif ( my $identity = $csr->verified_identity )
+ {
+ # This is where we ought to build an OpenID user and verify against the spec.
+ my $user = +{ map { $_ => scalar $identity->$_ }
+ qw( url display rss atom foaf declared_rss declared_atom declared_foaf foafmaker ) };
+
+ for(keys %{$self->{_config}->{extensions}}) {
+ $user->{extensions}->{$_} = $identity->signed_extension_fields($_);
+ }
+
+ my $user_obj = $realm->find_user($user, $c);
+
+ if ( ref $user_obj )
+ {
+ return $user_obj;
+ }
+ else
+ {
+ $c->log->debug("Verified OpenID identity failed to load with find_user; bad user_class? Try 'Null.'") if $c->debug;
+ return;
+ }
+ }
+ else
+ {
+ Catalyst::Exception->throw("Error validating identity: " .
+ $csr->err);
+ }
+ }
+ return;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Catalyst::Authentication::Credential::OpenID - OpenID credential for Catalyst::Plugin::Authentication framework.
+
+=head1 VERSION
+
+0.14
+
+=head1 SYNOPSIS
+
+In MyApp.pm-
+
+ use Catalyst qw/
+ Authentication
+ Session
+ Session::Store::FastMmap
+ Session::State::Cookie
+ /;
+
+Somewhere in myapp.conf-
+
+ <Plugin::Authentication>
+ default_realm openid
+ <realms>
+ <openid>
+ <credential>
+ class OpenID
+ </credential>
+ ua_class LWPx::ParanoidAgent
+ </openid>
+ </realms>
+ </Plugin::Authentication>
+
+Or in your myapp.yml if you're using L<YAML> instead-
+
+ Plugin::Authentication:
+ default_realm: openid
+ realms:
+ openid:
+ credential:
+ class: OpenID
+ ua_class: LWPx::ParanoidAgent
+
+In a controller, perhaps C<Root::openid>-
+
+ sub openid : Local {
+ my($self, $c) = @_;
+
+ if ( $c->authenticate() )
+ {
+ $c->flash(message => "You signed in with OpenID!");
+ $c->res->redirect( $c->uri_for('/') );
+ }
+ else
+ {
+ # Present OpenID form.
+ }
+ }
+
+And a L<Template> to match in C<openid.tt>-
+
+ <form action="[% c.uri_for('/openid') %]" method="GET" name="openid">
+ <input type="text" name="openid_identifier" class="openid" />
+ <input type="submit" value="Sign in with OpenID" />
+ </form>
+
+=head1 DESCRIPTION
+
+This is the B<third> OpenID related authentication piece for
+L<Catalyst>. The first E<mdash> L<Catalyst::Plugin::Authentication::OpenID>
+by Benjamin Trott E<mdash> was deprecated by the second E<mdash>
+L<Catalyst::Plugin::Authentication::Credential::OpenID> by Tatsuhiko
+Miyagawa E<mdash> and this is an attempt to deprecate both by conforming to
+the newish, at the time of this module's inception, realm-based
+authentication in L<Catalyst::Plugin::Authentication>.
+
+ 1. Catalyst::Plugin::Authentication::OpenID
+ 2. Catalyst::Plugin::Authentication::Credential::OpenID
+ 3. Catalyst::Authentication::Credential::OpenID
+
+The benefit of this version is that you can use an arbitrary number of
+authentication systems in your L<Catalyst> application and configure
+and call all of them in the same way.
+
+Note that both earlier versions of OpenID authentication use the method
+C<authenticate_openid()>. This module uses C<authenticate()> and
+relies on you to specify the realm. You can specify the realm as the
+default in the configuration or inline with each
+C<authenticate()> call; more below.
+
+This module functions quite differently internally from the others.
+See L<Catalyst::Plugin::Authentication::Internals> for more about this
+implementation.
+
+=head1 METHODS
+
+=over 4
+
+=item $c->authenticate({},"your_openid_realm");
+
+Call to authenticate the user via OpenID. Returns false if
+authorization is unsuccessful. Sets the user into the session and
+returns the user object if authentication succeeds.
+
+You can see in the call above that the authentication hash is empty.
+The implicit OpenID parameter is, as the 2.0 specification says it
+SHOULD be, B<openid_identifier>. You can set it anything you like in
+your realm configuration, though, under the key C<openid_field>. If
+you call C<authenticate()> with the empty info hash and no configured
+C<openid_field> then only C<openid_identifier> is checked.
+
+It implicitly does this (sort of, it checks the request method too)-
+
+ my $claimed_uri = $c->req->params->{openid_identifier};
+ $c->authenticate({openid_identifier => $claimed_uri});
+
+=item Catalyst::Authentication::Credential::OpenID->new()
+
+You will never call this. Catalyst does it for you. The only important
+thing you might like to know about it is that it merges its realm
+configuration with its configuration proper. If this doesn't mean
+anything to you, don't worry.
+
+=back
+
+=head2 USER METHODS
+
+Currently the only supported user class is L<Catalyst::Plugin::Authentication::User::Hash>.
+
+=over 4
+
+=item $c->user->url
+
+=item $c->user->display
+
+=item $c->user->rss
+
+=item $c->user->atom
+
+=item $c->user->foaf
+
+=item $c->user->declared_rss
+
+=item $c->user->declared_atom
+
+=item $c->user->declared_foaf
+
+=item $c->user->foafmaker
+
+=back
+
+See L<Net::OpenID::VerifiedIdentity> for details.
+
+=head1 CONFIGURATION
+
+Catalyst authentication is now configured entirely from your
+application's configuration. Do not, for example, put
+C<Credential::OpenID> into your C<use Catalyst ...> statement.
+Instead, tell your application that in one of your authentication
+realms you will use the credential.
+
+In your application the following will give you two different
+authentication realms. One called "members" which authenticates with
+clear text passwords and one called "openid" which uses... uh, OpenID.
+
+ __PACKAGE__->config
+ ( name => "MyApp",
+ "Plugin::Authentication" => {
+ default_realm => "members",
+ realms => {
+ members => {
+ credential => {
+ class => "Password",
+ password_field => "password",
+ password_type => "clear"
+ },
+ store => {
+ class => "Minimal",
+ users => {
+ paco => {
+ password => "l4s4v3n7ur45",
+ },
+ }
+ }
+ },
+ openid => {
+ consumer_secret => "Don't bother setting",
+ ua_class => "LWPx::ParanoidAgent",
+ ua_args => {
+ whitelisted_hosts => [qw/ 127.0.0.1 localhost /],
+ },
+ credential => {
+ class => "OpenID",
+ store => {
+ class => "OpenID",
+ },
+ },
+ extension_args => [
+ 'http://openid.net/extensions/sreg/1.1',
+ {
+ required => 'email',
+ optional => 'fullname,nickname,timezone',
+ },
+ ],
+ },
+ },
+ }
+ );
+
+This is the same configuration in the default L<Catalyst> configuration format from L<Config::General>.
+
+ name MyApp
+ <Plugin::Authentication>
+ default_realm members
+ <realms>
+ <members>
+ <store>
+ class Minimal
+ <users>
+ <paco>
+ password l4s4v3n7ur45
+ </paco>
+ </users>
+ </store>
+ <credential>
+ password_field password
+ password_type clear
+ class Password
+ </credential>
+ </members>
+ <openid>
+ <ua_args>
+ whitelisted_hosts 127.0.0.1
+ whitelisted_hosts localhost
+ </ua_args>
+ consumer_secret Don't bother setting
+ ua_class LWPx::ParanoidAgent
+ <credential>
+ <store>
+ class OpenID
+ </store>
+ class OpenID
+ </credential>
+ <extension_args>
+ http://openid.net/extensions/sreg/1.1
+ required email
+ optional fullname,nickname,timezone
+ </extension_args>
+ </openid>
+ </realms>
+ </Plugin::Authentication>
+
+And now, the same configuration in L<YAML>. B<NB>: L<YAML> is whitespace sensitive.
+
+ name: MyApp
+ Plugin::Authentication:
+ default_realm: members
+ realms:
+ members:
+ credential:
+ class: Password
+ password_field: password
+ password_type: clear
+ store:
+ class: Minimal
+ users:
+ paco:
+ password: l4s4v3n7ur45
+ openid:
+ credential:
+ class: OpenID
+ store:
+ class: OpenID
+ consumer_secret: Don't bother setting
+ ua_class: LWPx::ParanoidAgent
+ ua_args:
+ whitelisted_hosts:
+ - 127.0.0.1
+ - localhost
+ extension_args:
+ - http://openid.net/extensions/sreg/1.1
+ - required: email
+ optional: fullname,nickname,timezone
+
+B<NB>: There is no OpenID store yet.
+
+=head2 EXTENSIONS TO OPENID
+
+The L<Simple Registration|http://openid.net/extensions/sreg/1.1> (SREG) extension to OpenID is supported in the L<Net::OpenID> family now. Experimental support for it is included here as of v0.12. SREG is the only supported extension in OpenID 1.1. It's experimental in the sense it's a new interface and barely tested. Support for OpenID extensions is here to stay.
+
+=head2 MORE ON CONFIGURATION
+
+These are set in your realm. See above.
+
+=over 4
+
+=item ua_args and ua_class
+
+L<LWPx::ParanoidAgent> is the default agent E<mdash> C<ua_class>. You don't
+have to set it. I recommend that you do B<not> override it. You can
+with any well behaved L<LWP::UserAgent>. You probably should not.
+L<LWPx::ParanoidAgent> buys you many defenses and extra security
+checks. When you allow your application users freedom to initiate
+external requests, you open a big avenue for DoS (denial of service)
+attacks. L<LWPx::ParanoidAgent> defends against this.
+L<LWP::UserAgent> and any regular subclass of it will not.
+
+=item consumer_secret
+
+The underlying L<Net::OpenID::Consumer> object is seeded with a
+secret. If it's important to you to set your own, you can. The default
+uses this package name + its version + the sorted configuration keys
+of your Catalyst application (chopped at 255 characters if it's
+longer). This should generally be superior to any fixed string.
+
+=back
+
+=head1 TODO
+
+Support more of the new methods in the L<Net::OpenID> kit.
+
+There are some interesting implications with this sort of setup. Does
+a user aggregate realms or can a user be signed in under more than one
+realm? The documents could contain a recipe of the self-answering
+OpenID end-point that is in the tests.
+
+Debug statements need to be both expanded and limited via realm
+configuration.
+
+Better diagnostics in errors. Debug info at all consumer calls.
+
+Roles from provider domains? Mapped? Direct? A generic "openid" auto_role?
+
+=head1 THANKS
+
+To Benjamin Trott (L<Catalyst::Plugin::Authentication::OpenID>), Tatsuhiko Miyagawa (L<Catalyst::Plugin::Authentication::Credential::OpenID>), Brad Fitzpatrick for the great OpenID stuff, Martin Atkins for picking up the code to handle OpenID 2.0, and Jay Kuri and everyone else who has made Catalyst such a wonderful framework.
+
+L<Menno Blom|http://search.cpan.org/~blom/> provided a bug fix and the hook to use OpenID extensions.
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c) 2008, Ashley Pond V C<< <ashley@cpan.org> >>. Some of Tatsuhiko Miyagawa's work is reused here.
+
+This module is free software; you can redistribute it and modify it under the same terms as Perl itself. See L<perlartistic>.
+
+=head1 DISCLAIMER OF WARRANTY
+
+Because this software is licensed free of charge, there is no warranty
+for the software, to the extent permitted by applicable law. Except when
+otherwise stated in writing the copyright holders and other parties
+provide the software "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 software is with
+you. Should the software prove defective, you assume the cost of all
+necessary servicing, repair, or correction.
+
+In no event unless required by applicable law or agreed to in writing
+will any copyright holder, or any other party who may modify or
+redistribute the software as permitted by the above license, be
+liable to you for damages, including any general, special, incidental,
+or consequential damages arising out of the use or inability to use
+the software (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 software to operate with any other software), even if
+such holder or other party has been advised of the possibility of
+such damages.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item OpenID
+
+L<Net::OpenID::Server>, L<Net::OpenID::VerifiedIdentity>, L<Net::OpenID::Consumer>, L<http://openid.net/>, L<http://openid.net/developers/specs/>, and L<http://openid.net/extensions/sreg/1.1>.
+
+=item Catalyst Authentication
+
+L<Catalyst>, L<Catalyst::Plugin::Authentication>, L<Catalyst::Manual::Tutorial::Authorization>, and L<Catalyst::Manual::Tutorial::Authentication>.
+
+=item Catalyst Configuration
+
+L<Catalyst::Plugin::ConfigLoader>, L<Config::General>, and L<YAML>.
+
+=item Miscellaneous
+
+L<Catalyst::Manual::Tutorial>, L<Template>, L<LWPx::ParanoidAgent>.
+
+=back
+
+=cut
+package Catalyst::Authentication::Credential::OpenID;
+use strict;
+# use warnings; no warnings "uninitialized"; # for testing, not production
+use parent "Class::Accessor::Fast";
+
+BEGIN {
+ __PACKAGE__->mk_accessors(qw/ _config realm debug secret /);
+}
+
+our $VERSION = "0.13";
+
+use Net::OpenID::Consumer;
+use Catalyst::Exception ();
+
+sub new : method {
+ my ( $class, $config, $c, $realm ) = @_;
+ my $self = { _config => { %{ $config },
+ %{ $realm->{config} }
+ }
+ };
+ bless $self, $class;
+
+ # 2.0 spec says "SHOULD" be named "openid_identifier."
+ $self->_config->{openid_field} ||= "openid_identifier";
+
+ $self->debug( $self->_config->{debug} );
+
+ my $secret = $self->_config->{consumer_secret} ||= join("+",
+ __PACKAGE__,
+ $VERSION,
+ sort keys %{ $c->config }
+ );
+
+ $secret = substr($secret,0,255) if length $secret > 255;
+ $self->secret($secret);
+ $self->_config->{ua_class} ||= "LWPx::ParanoidAgent";
+
+ my $agent_class = $self->_config->{ua_class};
+ eval "require $agent_class"
+ or Catalyst::Exception->throw("Could not 'require' user agent class " .
+ $self->_config->{ua_class});
+
+ $c->log->debug("Setting consumer secret: " . $secret) if $self->debug;
+
+ return $self;
+}
+
+sub authenticate : method {
+ my ( $self, $c, $realm, $authinfo ) = @_;
+
+ $c->log->debug("authenticate() called from " . $c->request->uri) if $self->debug;
my $field = $self->{_config}->{openid_field};
}
diag( "Testing Catalyst::Authentication::Credential::OpenID $Catalyst::Authentication::Credential::OpenID::VERSION" );
+use Test::More tests => 1;
+
+BEGIN {
+use_ok( 'Catalyst::Authentication::Credential::OpenID' );
+# use_ok( 'Catalyst::Authentication::Store::OpenID' );
+}
+
+diag( "Testing Catalyst::Authentication::Credential::OpenID $Catalyst::Authentication::Credential::OpenID::VERSION" );
+++ /dev/null
-package TestApp;
-
-use strict;
-use warnings;
-
-use Catalyst::Runtime '5.70';
-
-use Catalyst qw(
- -Debug
- ConfigLoader
- Authentication
- Session
- Session::Store::FastMmap
- Session::State::Cookie
- );
-
-our $VERSION = '0.00001';
-
-__PACKAGE__->config
- ( name => "TestApp",
- session => {
- storage => "/tmp/" . __PACKAGE__ . "-" . $VERSION,
- },
- startup_time => time(),
- "Plugin::Authentication" => {
- default_realm => "members",
- realms => {
- members => {
- credential => {
- class => "Password",
- password_field => "password",
- password_type => "clear"
- },
- store => {
- class => "Minimal",
- users => {
- paco => {
- password => "l4s4v3n7ur45",
- },
- }
- }
- },
- openid => {
- # ua_class => "LWPx::ParanoidAgent",
- ua_class => "LWP::UserAgent",
- ua_args => {
- whitelisted_hosts => [qw/ 127.0.0.1 localhost /],
- timeout => 10,
- },
- extension_args => [
- 'http://openid.net/extensions/sreg/1.1',
- {
- required => 'email',
- optional => 'fullname,nickname,timezone',
- },
- ],
- debug => 1,
- credential => {
- class => "OpenID",
-#DOES NOTHING use_session => 1,
- store => {
- class => "OpenID",
- },
- },
- },
- },
- },
- );
-
-__PACKAGE__->setup();
-
-1;
-
-__END__
+++ /dev/null
-package TestApp::Controller::Root;
-
-use strict;
-use warnings;
-no warnings "uninitialized";
-use base 'Catalyst::Controller';
-use Net::OpenID::Server;
-
-__PACKAGE__->config->{namespace} = '';
-
-=head1 NAME
-
-TestApp::Controller::Root - Root Controller for TestApp.
-
-=head1 DESCRIPTION
-
-D'er... testing. Has an OpenID provider to test the OpenID credential against.
-
-=cut
-
-sub provider : Local {
- my ( $self, $c, $username ) = @_;
-
- my $nos = Net::OpenID::Server
- ->new(
- get_args => $c->req->query_params,
- post_args => $c->req->body_params,
- get_user => sub { $c->user },
- is_identity => sub {
- my ( $user, $identity_url ) = @_;
- return unless $user;
- my ( $check ) = $identity_url =~ /(\w+)\z/;
- return $check eq $user->id; # simple auth here
- },
- is_trusted => sub {
- my ( $user, $trust_root, $is_identity ) = @_;
- return $is_identity; # enough that they passed is_identity
- },
- setup_url => $c->uri_for($c->req->path, {moo => "setup"}),
- server_secret => $c->config->{startup_time},
- );
-
- # From your OpenID server endpoint:
-
- my ( $type, $data ) = $nos->handle_page;
-
- if ($type eq "redirect")
- {
- $c->res->redirect($data);
- }
- elsif ($type eq "setup")
- {
- my %setup_opts = %{$data};
- $c->res->body(<<"");
-You're not signed in so you can't be verified.
-<a href="/login">Sign in</a> | <a href="/signin_openid">OpenId</a>.
-
- # it's then your job to redirect them at the end to "return_to"
- # (or whatever you've named it in setup_map)
- }
- else
- {
- $c->res->content_type($type);
- if ( $username )
- {
- my $server_uri = $c->uri_for($c->req->path);
- $data =~ s,(?=</head>),<link rel="openid.server" href="$server_uri" />,;
- }
- $c->res->body($data);
- }
-}
-
-sub logout : Local {
- my($self, $c) = @_;
- $c->logout if $c->user_exists;
- $c->delete_session();
- $c->res->redirect($c->uri_for("/"));
-}
-
-sub login : Local {
- my($self, $c) = @_;
-
- if ( $c->req->method eq 'POST'
- and
- $c->authenticate({ username => $c->req->body_params->{username},
- password => $c->req->body_params->{password} }) )
- {
-# $c->res->body("You are signed in!");
- $c->res->redirect($c->uri_for("/"));
- }
- else
- {
- my $action = $c->req->uri->path;
- $c->res->body(<<"");
-<html><head/><body><form name="login" action="$action" method="POST">
- <input type="text" name="username" />
- <input type="password" name="password" />
- <input type="submit" value="Sign in" />
-</form>
-</body></html>
-
- }
-}
-
-sub signin_openid : Local {
- my($self, $c) = @_;
-
- if ( $c->authenticate({}, "openid") )
- {
- $c->res->body("You did it with OpenID!");
- }
- else
- {
- my $action = $c->req->uri->path;
- $c->res->body(<<"");
- <form action="$action" method="GET" name="openid">
- <input type="text" name="openid_identifier" class="openid" size="50" />
- <input type="submit" value="Sign in with OpenID" />
- </form>
-
- }
-}
-
-sub default : Private {
- my ( $self, $c ) = @_;
- $c->response->body(
- join(" ",
- "You are",
- $c->user ? "" : "not",
- "signed in. <br/>",
- $c->user ? ( $c->user->id || %{$c->user} ) : '<a href="/login">Sign in</a> | <a href="/signin_openid">OpenId</a>.'
- )
- );
-}
-
-sub end : Private {
- my ( $self, $c ) = @_;
- $c->response->content_type("text/html");
-}
-
-=head1 LICENSE
-
-This library is free software, you can redistribute it and modify
-it under the same terms as Perl itself.
-
-=cut
-
-1;
+++ /dev/null
-#!/usr/bin/env perl
-
-BEGIN {
- $ENV{CATALYST_ENGINE} ||= 'HTTP';
- $ENV{CATALYST_SCRIPT_GEN} = 39;
- require Catalyst::Engine::HTTP;
-}
-
-use strict;
-use warnings;
-use Getopt::Long;
-use Pod::Usage;
-use FindBin;
-use lib "$FindBin::Bin/../lib";
-
-my $debug = 0;
-my $fork = 0;
-my $help = 0;
-my $host = undef;
-my $port = $ENV{TESTAPP_PORT} || $ENV{CATALYST_PORT} || 3000;
-my $keepalive = 0;
-my $restart = $ENV{TESTAPP_RELOAD} || $ENV{CATALYST_RELOAD} || 0;
-my $background = 0;
-my $pidfile = undef;
-
-my $check_interval;
-my $file_regex;
-my $watch_directory;
-my $follow_symlinks;
-
-my @argv = @ARGV;
-
-GetOptions(
- 'debug|d' => \$debug,
- 'fork|f' => \$fork,
- 'help|?' => \$help,
- 'host=s' => \$host,
- 'port|p=s' => \$port,
- 'keepalive|k' => \$keepalive,
- 'restart|r' => \$restart,
- 'restartdelay|rd=s' => \$check_interval,
- 'restartregex|rr=s' => \$file_regex,
- 'restartdirectory=s@' => \$watch_directory,
- 'followsymlinks' => \$follow_symlinks,
- 'background' => \$background,
- 'pidfile=s' => \$pidfile,
-);
-
-pod2usage(1) if $help;
-
-if ( $debug ) {
- $ENV{CATALYST_DEBUG} = 1;
-}
-
-# If we load this here, then in the case of a restarter, it does not
-# need to be reloaded for each restart.
-require Catalyst;
-
-# If this isn't done, then the Catalyst::Devel tests for the restarter
-# fail.
-$| = 1 if $ENV{HARNESS_ACTIVE};
-
-my $runner = sub {
- # This is require instead of use so that the above environment
- # variables can be set at runtime.
- require TestApp;
-
- TestApp->run(
- $port, $host,
- {
- argv => \@argv,
- 'fork' => $fork,
- keepalive => $keepalive,
- background => $background,
- pidfile => $pidfile,
- }
- );
-};
-
-if ( $restart ) {
- die "Cannot run in the background and also watch for changed files.\n"
- if $background;
-
- require Catalyst::Restarter;
-
- my $subclass = Catalyst::Restarter->pick_subclass;
-
- my %args;
- $args{follow_symlinks} = 1
- if $follow_symlinks;
- $args{directories} = $watch_directory
- if defined $watch_directory;
- $args{sleep_interval} = $check_interval
- if defined $check_interval;
- $args{filter} = qr/$file_regex/
- if defined $file_regex;
-
- my $restarter = $subclass->new(
- %args,
- start_sub => $runner,
- argv => \@argv,
- );
-
- $restarter->run_and_watch;
-}
-else {
- $runner->();
-}
-
-1;
-
-=head1 NAME
-
-testapp_server.pl - Catalyst Testserver
-
-=head1 SYNOPSIS
-
-testapp_server.pl [options]
-
- Options:
- -d -debug force debug mode
- -f -fork handle each request in a new process
- (defaults to false)
- -? -help display this help and exits
- -host host (defaults to all)
- -p -port port (defaults to 3000)
- -k -keepalive enable keep-alive connections
- -r -restart restart when files get modified
- (defaults to false)
- -rd -restartdelay delay between file checks
- (ignored if you have Linux::Inotify2 installed)
- -rr -restartregex regex match files that trigger
- a restart when modified
- (defaults to '\.yml$|\.yaml$|\.conf|\.pm$')
- -restartdirectory the directory to search for
- modified files, can be set mulitple times
- (defaults to '[SCRIPT_DIR]/..')
- -follow_symlinks follow symlinks in search directories
- (defaults to false. this is a no-op on Win32)
- -background run the process in the background
- -pidfile specify filename for pid file
-
- See also:
- perldoc Catalyst::Manual
- perldoc Catalyst::Manual::Intro
-
-=head1 DESCRIPTION
-
-Run a Catalyst Testserver for this application.
-
-=head1 AUTHORS
-
-Catalyst Contributors, see Catalyst.pm
-
-=head1 COPYRIGHT
-
-This library is free software. You can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
+++ /dev/null
-package TestApp;
-
-use strict;
-use warnings;
-
-use Catalyst::Runtime '5.70';
-
-use Catalyst qw(
- -Debug
- ConfigLoader
- Authentication
- Session
- Session::Store::FastMmap
- Session::State::Cookie
- );
-
-our $VERSION = '0.00002';
-
-__PACKAGE__->config
- ( name => "TestApp",
- session => {
- storage => "/tmp/" . __PACKAGE__ . "-" . $VERSION,
- },
- startup_time => time(),
- "Plugin::Authentication" => {
- default_realm => "members",
- realms => {
- members => {
- credential => {
- class => "Password",
- password_field => "password",
- password_type => "clear"
- },
- store => {
- class => "Minimal",
- users => {
- paco => {
- password => "l4s4v3n7ur45",
- },
- }
- }
- },
- openid => {
- #ua_class => "LWPx::ParanoidAgent",
- ua_class => "LWP::UserAgent",
- ua_args => {
- whitelisted_hosts => [qw/ 127.0.0.1 localhost /],
- timeout => 10,
- },
- extension_args => [
- 'http://openid.net/extensions/sreg/1.1',
- {
- required => 'email',
- optional => 'fullname,nickname,timezone',
- },
- ],
- debug => 1,
- credential => {
- class => "OpenID",
-#DOES NOTHING use_session => 1,
- store => {
- class => "OpenID",
- },
- },
- },
- },
- },
- );
-
-__PACKAGE__->setup();
-
-1;
-
-__END__
+++ /dev/null
-package TestApp::Controller::Root;
-
-use strict;
-use warnings;
-no warnings "uninitialized";
-use base 'Catalyst::Controller';
-use Net::OpenID::Server;
-
-__PACKAGE__->config->{namespace} = '';
-
-=head1 NAME
-
-TestApp::Controller::Root - Root Controller for TestApp.
-
-=head1 DESCRIPTION
-
-D'er... testing. Has an OpenID provider to test the OpenID credential against.
-
-=cut
-
-sub provider : Local {
- my ( $self, $c, $username ) = @_;
-
- my $nos = Net::OpenID::Server
- ->new(
- get_args => $c->req->query_params,
- post_args => $c->req->body_params,
- get_user => sub { $c->user },
- is_identity => sub {
- my ( $user, $identity_url ) = @_;
- return unless $user;
- my ( $check ) = $identity_url =~ /(\w+)\z/;
- return $check eq $user->id; # simple auth here
- },
- is_trusted => sub {
- my ( $user, $trust_root, $is_identity ) = @_;
- return $is_identity; # enough that they passed is_identity
- },
- setup_url => $c->uri_for($c->req->path, {moo => "setup"}),
- server_secret => $c->config->{startup_time},
- );
-
- # From your OpenID server endpoint:
-
- my ( $type, $data ) = $nos->handle_page;
-
- if ($type eq "redirect")
- {
- $c->res->redirect($data);
- }
- elsif ($type eq "setup")
- {
- my %setup_opts = %{$data};
- $c->res->body(<<"");
-You're not signed in so you can't be verified.
-<a href="/login">Sign in</a> | <a href="/signin_openid">OpenId</a>.
-
- # it's then your job to redirect them at the end to "return_to"
- # (or whatever you've named it in setup_map)
- }
- else
- {
- $c->res->content_type($type);
- if ( $username )
- {
- my $server_uri = $c->uri_for($c->req->path);
- $data =~ s,(?=</head>),<link rel="openid.server" href="$server_uri" />,;
- }
- $c->res->body($data);
- }
-}
-
-sub logout : Local {
- my($self, $c) = @_;
- $c->logout if $c->user_exists;
- $c->delete_session();
- $c->res->redirect($c->uri_for("/"));
-}
-
-sub login : Local {
- my($self, $c) = @_;
-
- if ( $c->req->method eq 'POST'
- and
- $c->authenticate({ username => $c->req->body_params->{username},
- password => $c->req->body_params->{password} }) )
- {
-# $c->res->body("You are signed in!");
- $c->res->redirect($c->uri_for("/"));
- }
- else
- {
- my $action = $c->req->uri->path;
- $c->res->body(<<"");
-<html><head/><body><form name="login" action="$action" method="POST">
- <input type="text" name="username" />
- <input type="password" name="password" />
- <input type="submit" value="Sign in" />
-</form>
-</body></html>
-
- }
-}
-
-sub signin_openid : Local {
- my($self, $c) = @_;
-
- if ( $c->authenticate({}, "openid") )
- {
- $c->res->body("You did it with OpenID!");
- }
- else
- {
- my $action = $c->req->uri->path;
- $c->res->body(<<"");
- <form action="$action" method="GET" name="openid">
- <input type="text" name="openid_identifier" class="openid" size="50" />
- <input type="submit" value="Sign in with OpenID" />
- </form>
-
- }
-}
-
-sub default : Private {
- my ( $self, $c ) = @_;
- $c->response->body(
- join(" ",
- "You are",
- $c->user ? "" : "not",
- "signed in. <br/>",
- $c->user ? ( $c->user->id || %{$c->user} ) : '<a href="/login">Sign in</a> | <a href="/signin_openid">OpenId</a>.'
- )
- );
-}
-
-sub end : Private {
- my ( $self, $c ) = @_;
- $c->response->content_type("text/html");
-}
-
-=head1 LICENSE
-
-This library is free software, you can redistribute it and modify
-it under the same terms as Perl itself.
-
-=cut
-
-1;
+++ /dev/null
-#!/usr/bin/env perl
-
-BEGIN {
- $ENV{CATALYST_ENGINE} ||= 'HTTP';
- $ENV{CATALYST_SCRIPT_GEN} = 39;
- require Catalyst::Engine::HTTP;
-}
-
-use strict;
-use warnings;
-use Getopt::Long;
-use Pod::Usage;
-use FindBin;
-use lib "$FindBin::Bin/../lib";
-
-my $debug = 0;
-my $fork = 0;
-my $help = 0;
-my $host = undef;
-my $port = $ENV{TESTAPP_PORT} || $ENV{CATALYST_PORT} || 3000;
-my $keepalive = 0;
-my $restart = $ENV{TESTAPP_RELOAD} || $ENV{CATALYST_RELOAD} || 0;
-my $background = 0;
-my $pidfile = undef;
-
-my $check_interval;
-my $file_regex;
-my $watch_directory;
-my $follow_symlinks;
-
-my @argv = @ARGV;
-
-GetOptions(
- 'debug|d' => \$debug,
- 'fork|f' => \$fork,
- 'help|?' => \$help,
- 'host=s' => \$host,
- 'port|p=s' => \$port,
- 'keepalive|k' => \$keepalive,
- 'restart|r' => \$restart,
- 'restartdelay|rd=s' => \$check_interval,
- 'restartregex|rr=s' => \$file_regex,
- 'restartdirectory=s@' => \$watch_directory,
- 'followsymlinks' => \$follow_symlinks,
- 'background' => \$background,
- 'pidfile=s' => \$pidfile,
-);
-
-pod2usage(1) if $help;
-
-if ( $debug ) {
- $ENV{CATALYST_DEBUG} = 1;
-}
-
-# If we load this here, then in the case of a restarter, it does not
-# need to be reloaded for each restart.
-require Catalyst;
-
-# If this isn't done, then the Catalyst::Devel tests for the restarter
-# fail.
-$| = 1 if $ENV{HARNESS_ACTIVE};
-
-my $runner = sub {
- # This is require instead of use so that the above environment
- # variables can be set at runtime.
- require TestApp;
-
- TestApp->run(
- $port, $host,
- {
- argv => \@argv,
- 'fork' => $fork,
- keepalive => $keepalive,
- background => $background,
- pidfile => $pidfile,
- }
- );
-};
-
-if ( $restart ) {
- die "Cannot run in the background and also watch for changed files.\n"
- if $background;
-
- require Catalyst::Restarter;
-
- my $subclass = Catalyst::Restarter->pick_subclass;
-
- my %args;
- $args{follow_symlinks} = 1
- if $follow_symlinks;
- $args{directories} = $watch_directory
- if defined $watch_directory;
- $args{sleep_interval} = $check_interval
- if defined $check_interval;
- $args{filter} = qr/$file_regex/
- if defined $file_regex;
-
- my $restarter = $subclass->new(
- %args,
- start_sub => $runner,
- argv => \@argv,
- );
-
- $restarter->run_and_watch;
-}
-else {
- $runner->();
-}
-
-1;
-
-=head1 NAME
-
-testapp_server.pl - Catalyst Testserver
-
-=head1 SYNOPSIS
-
-testapp_server.pl [options]
-
- Options:
- -d -debug force debug mode
- -f -fork handle each request in a new process
- (defaults to false)
- -? -help display this help and exits
- -host host (defaults to all)
- -p -port port (defaults to 3000)
- -k -keepalive enable keep-alive connections
- -r -restart restart when files get modified
- (defaults to false)
- -rd -restartdelay delay between file checks
- (ignored if you have Linux::Inotify2 installed)
- -rr -restartregex regex match files that trigger
- a restart when modified
- (defaults to '\.yml$|\.yaml$|\.conf|\.pm$')
- -restartdirectory the directory to search for
- modified files, can be set mulitple times
- (defaults to '[SCRIPT_DIR]/..')
- -follow_symlinks follow symlinks in search directories
- (defaults to false. this is a no-op on Win32)
- -background run the process in the background
- -pidfile specify filename for pid file
-
- See also:
- perldoc Catalyst::Manual
- perldoc Catalyst::Manual::Intro
-
-=head1 DESCRIPTION
-
-Run a Catalyst Testserver for this application.
-
-=head1 AUTHORS
-
-Catalyst Contributors, see Catalyst.pm
-
-=head1 COPYRIGHT
-
-This library is free software. You can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
__PACKAGE__->setup();
+use YAML; die YAML::Dump \%INC;
+
+
+1;
+
+__END__
+package TestApp;
+
+use strict;
+use warnings;
+
+use Catalyst::Runtime '5.70';
+
+use Catalyst qw(
+ -Debug
+ ConfigLoader
+ Authentication
+ Session
+ Session::Store::FastMmap
+ Session::State::Cookie
+ );
+
+our $VERSION = '0.03';
+
+__PACKAGE__->config
+ ( name => "TestApp",
+ session => {
+ storage => "/tmp/" . __PACKAGE__ . "-" . $VERSION,
+ },
+ startup_time => time(),
+ "Plugin::Authentication" => {
+ default_realm => "members",
+ realms => {
+ members => {
+ credential => {
+ class => "Password",
+ password_field => "password",
+ password_type => "clear"
+ },
+ store => {
+ class => "Minimal",
+ users => {
+ paco => {
+ password => "l4s4v3n7ur45",
+ },
+ }
+ }
+ },
+ openid => {
+ ua_class => "LWPx::ParanoidAgent",
+# ua_class => "LWP::UserAgent",
+ ua_args => {
+ whitelisted_hosts => [qw/ 127.0.0.1 localhost /],
+ timeout => 10,
+ },
+ extension_args => [
+ 'http://openid.net/extensions/sreg/1.1',
+ {
+ required => 'email',
+ optional => 'fullname,nickname,timezone',
+ },
+ ],
+ debug => 1,
+ credential => {
+ class => "OpenID",
+#DOES NOTHING use_session => 1,
+ store => {
+ class => "OpenID",
+ },
+ },
+ },
+ },
+ },
+ );
+
+__PACKAGE__->setup();
+
1;
__END__
);
}
+sub not_a_valid_openid_uri : Global {
+ my ( $self, $c ) = @_;
+ $c->response->body("OPENID. UR DOIN IT RONG.");
+}
+
+sub i_can_has_tarpit : Global {
+ my ( $self, $c ) = @_;
+ local $/ = 1;
+ $c->response->content_type("text/html");
+ # Expect an arbitrary, biggish amount of content; it's a lie.
+ $c->response->headers->header("Content-length" => 1_024 * 100);
+ # Do this for 30 seconds; tests will timeout at 10 or 15.
+ sleep 1 && $c->response->write("sucker\n") for 1 .. 30;
+}
+
+sub end : Private {
+ my ( $self, $c ) = @_;
+ $c->response->content_type("text/html") unless $c->response->content_type;
+}
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
+package TestApp::Controller::Root;
+
+use strict;
+use warnings;
+no warnings "uninitialized";
+use base 'Catalyst::Controller';
+use Net::OpenID::Server;
+
+__PACKAGE__->config->{namespace} = '';
+
+=head1 NAME
+
+TestApp::Controller::Root - Root Controller for TestApp.
+
+=head1 DESCRIPTION
+
+D'er... testing. Has an OpenID provider to test the OpenID credential against.
+
+=cut
+
+sub provider : Local {
+ my ( $self, $c, $username ) = @_;
+
+ my $nos = Net::OpenID::Server
+ ->new(
+ get_args => $c->req->query_params,
+ post_args => $c->req->body_params,
+ get_user => sub { $c->user },
+ is_identity => sub {
+ my ( $user, $identity_url ) = @_;
+ return unless $user;
+ my ( $check ) = $identity_url =~ /(\w+)\z/;
+ return $check eq $user->id; # simple auth here
+ },
+ is_trusted => sub {
+ my ( $user, $trust_root, $is_identity ) = @_;
+ return $is_identity; # enough that they passed is_identity
+ },
+ setup_url => $c->uri_for($c->req->path, {moo => "setup"}),
+ server_secret => $c->config->{startup_time},
+ );
+
+ # From your OpenID server endpoint:
+
+ my ( $type, $data ) = $nos->handle_page;
+
+ if ($type eq "redirect")
+ {
+ $c->res->redirect($data);
+ }
+ elsif ($type eq "setup")
+ {
+ my %setup_opts = %{$data};
+ $c->res->body(<<"");
+You're not signed in so you can't be verified.
+<a href="/login">Sign in</a> | <a href="/signin_openid">OpenId</a>.
+
+ # it's then your job to redirect them at the end to "return_to"
+ # (or whatever you've named it in setup_map)
+ }
+ else
+ {
+ $c->res->content_type($type);
+ if ( $username )
+ {
+ my $server_uri = $c->uri_for($c->req->path);
+ $data =~ s,(?=</head>),<link rel="openid.server" href="$server_uri" />,;
+ }
+ $c->res->body($data);
+ }
+}
+
+sub logout : Local {
+ my($self, $c) = @_;
+ $c->logout if $c->user_exists;
+ $c->delete_session();
+ $c->res->redirect($c->uri_for("/"));
+}
+
+sub login : Local {
+ my($self, $c) = @_;
+
+ if ( $c->req->method eq 'POST'
+ and
+ $c->authenticate({ username => $c->req->body_params->{username},
+ password => $c->req->body_params->{password} }) )
+ {
+# $c->res->body("You are signed in!");
+ $c->res->redirect($c->uri_for("/"));
+ }
+ else
+ {
+ my $action = $c->req->uri->path;
+ $c->res->body(<<"");
+<html><head/><body><form name="login" action="$action" method="POST">
+ <input type="text" name="username" />
+ <input type="password" name="password" />
+ <input type="submit" value="Sign in" />
+</form>
+</body></html>
+
+ }
+}
+
+sub signin_openid : Local {
+ my($self, $c) = @_;
+
+ if ( $c->authenticate({}, "openid") )
+ {
+ $c->res->body("You did it with OpenID!");
+ }
+ else
+ {
+ my $action = $c->req->uri->path;
+ $c->res->body(<<"");
+ <form action="$action" method="GET" name="openid">
+ <input type="text" name="openid_identifier" class="openid" size="50" />
+ <input type="submit" value="Sign in with OpenID" />
+ </form>
+
+ }
+}
+
+sub default : Private {
+ my ( $self, $c ) = @_;
+ $c->response->body(
+ join(" ",
+ "You are",
+ $c->user ? "" : "not",
+ "signed in. <br/>",
+ $c->user ? ( $c->user->id || %{$c->user} ) : '<a href="/login">Sign in</a> | <a href="/signin_openid">OpenId</a>.'
+ )
+ );
+}
+
sub end : Private {
my ( $self, $c ) = @_;
$c->response->content_type("text/html");
+#!/usr/bin/env perl
+
+BEGIN {
+ $ENV{CATALYST_ENGINE} ||= 'HTTP';
+ $ENV{CATALYST_SCRIPT_GEN} = 39;
+ require Catalyst::Engine::HTTP;
+}
+
+use strict;
+use warnings;
+use Getopt::Long;
+use Pod::Usage;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+my $debug = 0;
+my $fork = 0;
+my $help = 0;
+my $host = undef;
+my $port = $ENV{TESTAPP_PORT} || $ENV{CATALYST_PORT} || 3000;
+my $keepalive = 0;
+my $restart = $ENV{TESTAPP_RELOAD} || $ENV{CATALYST_RELOAD} || 0;
+my $background = 0;
+my $pidfile = undef;
+
+my $check_interval;
+my $file_regex;
+my $watch_directory;
+my $follow_symlinks;
+
+my @argv = @ARGV;
+
+GetOptions(
+ 'debug|d' => \$debug,
+ 'fork|f' => \$fork,
+ 'help|?' => \$help,
+ 'host=s' => \$host,
+ 'port|p=s' => \$port,
+ 'keepalive|k' => \$keepalive,
+ 'restart|r' => \$restart,
+ 'restartdelay|rd=s' => \$check_interval,
+ 'restartregex|rr=s' => \$file_regex,
+ 'restartdirectory=s@' => \$watch_directory,
+ 'followsymlinks' => \$follow_symlinks,
+ 'background' => \$background,
+ 'pidfile=s' => \$pidfile,
+);
+
+pod2usage(1) if $help;
+
+if ( $debug ) {
+ $ENV{CATALYST_DEBUG} = 1;
+}
+
+# If we load this here, then in the case of a restarter, it does not
+# need to be reloaded for each restart.
+require Catalyst;
+
+# If this isn't done, then the Catalyst::Devel tests for the restarter
+# fail.
+$| = 1 if $ENV{HARNESS_ACTIVE};
+
+my $runner = sub {
+ # This is require instead of use so that the above environment
+ # variables can be set at runtime.
+ require TestApp;
+
+ TestApp->run(
+ $port, $host,
+ {
+ argv => \@argv,
+ 'fork' => $fork,
+ keepalive => $keepalive,
+ background => $background,
+ pidfile => $pidfile,
+ }
+ );
+};
+
+if ( $restart ) {
+ die "Cannot run in the background and also watch for changed files.\n"
+ if $background;
+
+ require Catalyst::Restarter;
+
+ my $subclass = Catalyst::Restarter->pick_subclass;
+
+ my %args;
+ $args{follow_symlinks} = 1
+ if $follow_symlinks;
+ $args{directories} = $watch_directory
+ if defined $watch_directory;
+ $args{sleep_interval} = $check_interval
+ if defined $check_interval;
+ $args{filter} = qr/$file_regex/
+ if defined $file_regex;
+
+ my $restarter = $subclass->new(
+ %args,
+ start_sub => $runner,
+ argv => \@argv,
+ );
+
+ $restarter->run_and_watch;
+}
+else {
+ $runner->();
+}
+
+1;
+
+=head1 NAME
+
+testapp_server.pl - Catalyst Testserver
+
+=head1 SYNOPSIS
+
+testapp_server.pl [options]
+
+ Options:
+ -d -debug force debug mode
+ -f -fork handle each request in a new process
+ (defaults to false)
+ -? -help display this help and exits
+ -host host (defaults to all)
+ -p -port port (defaults to 3000)
+ -k -keepalive enable keep-alive connections
+ -r -restart restart when files get modified
+ (defaults to false)
+ -rd -restartdelay delay between file checks
+ (ignored if you have Linux::Inotify2 installed)
+ -rr -restartregex regex match files that trigger
+ a restart when modified
+ (defaults to '\.yml$|\.yaml$|\.conf|\.pm$')
+ -restartdirectory the directory to search for
+ modified files, can be set mulitple times
+ (defaults to '[SCRIPT_DIR]/..')
+ -follow_symlinks follow symlinks in search directories
+ (defaults to false. this is a no-op on Win32)
+ -background run the process in the background
+ -pidfile specify filename for pid file
+
+ See also:
+ perldoc Catalyst::Manual
+ perldoc Catalyst::Manual::Intro
+
+=head1 DESCRIPTION
+
+Run a Catalyst Testserver for this application.
+
+=head1 AUTHORS
+
+Catalyst Contributors, see Catalyst.pm
+
+=head1 COPYRIGHT
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
#!/usr/local/bin/perl -w
BEGIN {
+++ /dev/null
-#!/usr/bin/env perl
-use strict;
-use warnings;
-
-use FindBin;
-use IO::Socket;
-use Test::More;
-use Test::WWW::Mechanize;
-
-plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP};
-eval "use Catalyst::Devel 1.0";
-plan skip_all => 'Catalyst::Devel required' if $@;
-
-plan "no_plan";
-# plan tests => 17;
-
-# One port for consumer app, one for provider.
-my $consumer_port = 10000 + int rand(1 + 10000);
-my $provider_port = $consumer_port;
-$provider_port = 10000 + int rand(1 + 10000) until $consumer_port != $provider_port;
-
-my $provider_pipe = "perl -I$FindBin::Bin/../lib -I$FindBin::Bin/Provider/lib $FindBin::Bin/Provider/script/testapp_server.pl -p $consumer_port |";
-
-my $consumer_pipe = "perl -I$FindBin::Bin/../lib -I$FindBin::Bin/Consumer/lib $FindBin::Bin/Consumer/script/testapp_server.pl -p $provider_port |";
-
-my $provider_pid = open my $provider, $provider_pipe
- or die "Unable to spawn standalone HTTP server for Provider: $!";
-
-diag("Started Provider with pid $provider_pid");
-
-my $consumer_pid = open my $consumer, $consumer_pipe
- or die "Unable to spawn standalone HTTP server for Consumer: $!";
-
-diag("Started Consumer with pid $consumer_pid");
-
-# How long to wait for test server to start and timeout for UA.
-my $seconds = 15;
-
-
-diag("Waiting (up to $seconds seconds) for application servers to start...");
-
-eval {
- local $SIG{ALRM} = sub { die "Servers took too long to start\n" }; # NB: \n required
- alarm($seconds);
- sleep 1 while check_port( 'localhost', $provider_port ) != 1;
- sleep 1 while check_port( 'localhost', $consumer_port ) != 1;
- alarm(0)
-};
-
-if ( $@ )
-{
- shut_down();
- die "Could not run test: $@";
-}
-
-my $root = $ENV{CATALYST_SERVER} = "http://localhost:$consumer_port";
-my $openid_server = "http://localhost:$provider_port";
-
-# Tests start --------------------------------------------
-diag("Started...") if $ENV{TEST_VERBOSE};
-
-my $mech = Test::WWW::Mechanize->new(timeout => $seconds);
-
-$mech->get_ok($root, "GET $root");
-$mech->content_contains("not signed in", "Content looks right");
-
-$mech->get_ok("$openid_server/login", "GET $root/login");
-
-# diag($mech->content);
-
-$mech->submit_form_ok({ form_name => "login",
- fields => { username => "paco",
- password => "l4s4v3n7ur45",
- },
- },
- "Trying cleartext login, 'memebers' realm");
-
-$mech->content_contains("signed in", "Signed in successfully");
-
-$mech->get_ok("$root/signin_openid", "GET $root/signin_openid");
-
-$mech->content_contains("Sign in with OpenID", "Content looks right");
-
-my $claimed_uri = "$openid_server/provider/paco";
-
-$mech->submit_form_ok({ form_name => "openid",
- fields => { openid_identifier => $claimed_uri,
- },
- },
- "Trying OpenID login, 'openid' realm");
-
-$mech->content_contains("You did it with OpenID!",
- "Successfully signed in with OpenID");
-
-$mech->get_ok($root, "GET $root");
-
-$mech->content_contains("provider/paco", "OpenID info is in the user");
-
-# can't be verified
-
-$mech->get_ok("$root/logout", "GET $root/logout");
-
-$mech->get_ok("$root/signin_openid", "GET $root/signin_openid");
-
-$mech->content_contains("Sign in with OpenID", "Content looks right");
-
-$mech->submit_form_ok({ form_name => "openid",
- fields => { openid_identifier => $claimed_uri,
- },
- },
- "Trying OpenID login, 'openid' realm");
-
-$mech->content_contains("can't be verified",
- "Proper failure for unauthenticated memember.");
-
-shut_down();
-
-exit 0;
-
-# Tests end ----------------------------------------------
-
-sub shut_down {
- kill INT => $provider_pid, $consumer_pid;
- close $provider;
- close $consumer;
-}
-
-sub check_port {
- my ( $host, $port ) = @_;
-
- my $remote = IO::Socket::INET->new(
- Proto => "tcp",
- PeerAddr => $host,
- PeerPort => $port
- );
- if ($remote) {
- close $remote;
- return 1;
- }
- else {
- return 0;
- }
-}
-
-__END__
-
--- /dev/null
+#!perl
+use strict;
+use warnings;
+use FindBin;
+use IO::Socket;
+use Test::More;
+use Test::WWW::Mechanize;
+
+# plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP};
+eval "use Catalyst::Devel";
+plan skip_all => 'Catalyst::Devel required' if $@;
+
+plan tests => 20;
+
+# How long to wait for test server to start and timeout for UA.
+my $seconds = 30;
+
+# Spawn the standalone HTTP server.
+my $port = 3000 + int rand(1 + 1000);
+
+ my $pipe = "perl -I$FindBin::Bin/../lib -I$FindBin::Bin/TestApp/lib $FindBin::Bin/TestApp/script/testapp_server.pl -f -p $port |";
+
+# my $pipe = "perl -I$FindBin::Bin/../lib -I$FindBin::Bin/TestApp/lib $FindBin::Bin/TestApp/script/testapp_server.pl -f -port $port 2>&1 |";
+
+my $pid = open my $server, $pipe
+ or die "Unable to spawn standalone HTTP server: $!";
+
+diag("Waiting (up to $seconds seconds) for server to start...");
+
+eval {
+ local $SIG{ALRM} = sub { die "Server took too long to start\n" }; # NB: \n required
+ alarm($seconds);
+
+ while ( check_port( 'localhost', $port ) != 1 ) {
+ sleep 1;
+ }
+ alarm(0)
+};
+
+if ( $@ )
+{
+ kill 'INT', $pid;
+ close $server;
+ die "Could not run test: $@\n$pipe";
+}
+
+my $root = $ENV{CATALYST_SERVER} = "http://localhost:$port";
+
+# Tests start --------------------------------------------
+ok("Started");
+eval {
+
+my $mech = Test::WWW::Mechanize->new(timeout => $seconds);
+
+$mech->get_ok($root, "GET $root");
+$mech->content_contains("not signed in", "Content looks right");
+
+$mech->get_ok("$root/login", "GET $root/login");
+
+# diag($mech->content);
+
+$mech->submit_form_ok({ form_name => "login",
+ fields => { username => "paco",
+ password => "l4s4v3n7ur45",
+ },
+ },
+ "Trying cleartext login, 'memebers' realm");
+
+$mech->content_contains("signed in", "Signed in successfully");
+$mech->get_ok("$root/signin_openid", "GET $root/signin_openid");
+$mech->content_contains("Sign in with OpenID", "Content looks right");
+
+my $claimed_uri = "$root/provider/paco";
+
+$mech->submit_form_ok({ form_name => "openid",
+ fields => { openid_identifier => $claimed_uri,
+ },
+ },
+ "Trying OpenID login, 'openid' realm");
+
+$mech->content_contains("You did it with OpenID!",
+ "Successfully signed in with OpenID");
+
+$mech->get_ok($root, "GET $root");
+
+$mech->content_contains("provider/paco", "OpenID signed in");
+
+# Bad claimed URL.
+$mech->get_ok("$root/signin_openid", "GET $root/signin_openid");
+my $non_openid_uri = "$root/not_a_valid_openid_uri";
+$mech->submit_form_ok({ form_name => "openid",
+ fields => { openid_identifier => $non_openid_uri,
+ },
+ },
+ "FAIL");
+
+# Can't be verified.
+$mech->get_ok("$root/logout", "GET $root/logout");
+$mech->content_contains("You are not signed in", "Content looks right");
+$mech->get_ok("$root/signin_openid", "GET $root/signin_openid");
+$mech->content_contains("Sign in with OpenID", "Content looks right");
+
+$mech->submit_form_ok({ form_name => "openid",
+ fields => { openid_identifier => $claimed_uri,
+ },
+ },
+ "Trying OpenID login, 'openid' realm");
+
+$mech->content_contains("can't be verified",
+ "Proper failure for unauthenticated memember.")
+ or diag($mech->content);
+
+
+};
+# Tests end ----------------------------------------------
+
+<>;
+
+# shut it down
+kill 'INT', $pid;
+close $server;
+
+exit 0;
+
+sub check_port {
+ my ( $host, $port ) = @_;
+
+ my $remote = IO::Socket::INET->new(
+ Proto => "tcp",
+ PeerAddr => $host,
+ PeerPort => $port
+ );
+ if ($remote) {
+ close $remote;
+ return 1;
+ }
+ else {
+ return 0;
+ }
+}
+
+__END__
+
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use IO::Socket;
+use Test::More;
+use Test::WWW::Mechanize;
+
+# plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP};
+eval "use Catalyst::Devel 1.0";
+plan skip_all => 'Catalyst::Devel required' if $@;
+
+plan tests => 17;
+
+# How long to wait for test server to start and timeout for UA.
+my $seconds = 30;
+
+# Spawn the standalone HTTP server.
+my $port = 30000 + int rand(1 + 10000);
+
+ my $pipe = "perl -I$FindBin::Bin/../lib -I$FindBin::Bin/TestApp/lib $FindBin::Bin/TestApp/script/testapp_server.pl -fork -port $port |";
+
+# my $pipe = "perl -I$FindBin::Bin/../lib -I$FindBin::Bin/TestApp/lib $FindBin::Bin/TestApp/script/testapp_server.pl -f -port $port 2>&1 |";
+
+my $pid = open my $server, $pipe
+ or die "Unable to spawn standalone HTTP server: $!";
+
+diag("Waiting (up to $seconds seconds) for server to start...");
+
+eval {
+ local $SIG{ALRM} = sub { die "Server took too long to start\n" }; # NB: \n required
+ alarm($seconds);
+
+ while ( check_port( 'localhost', $port ) != 1 ) {
+ sleep 1;
+ }
+ alarm(0)
+};
+
+if ( $@ )
+{
+ kill 'INT', $pid;
+ close $server;
+ die "Could not run test: $@\n$pipe";
+}
+
+my $root = $ENV{CATALYST_SERVER} = "http://localhost:$port";
+
+# Tests start --------------------------------------------
+ok("Started");
+
+
+my $mech = Test::WWW::Mechanize->new(timeout => $seconds);
+
+$mech->get_ok($root, "GET $root");
+$mech->content_contains("not signed in", "Content looks right");
+
+$mech->get_ok("$root/login", "GET $root/login");
+
+# diag($mech->content);
+
+$mech->submit_form_ok({ form_name => "login",
+ fields => { username => "paco",
+ password => "l4s4v3n7ur45",
+ },
+ },
+ "Trying cleartext login, 'memebers' realm");
+
+$mech->content_contains("signed in", "Signed in successfully");
+
+$mech->get_ok("$root/signin_openid", "GET $root/signin_openid");
+
+$mech->content_contains("Sign in with OpenID", "Content looks right");
+
+my $claimed_uri = "$root/provider/paco";
+
+$mech->submit_form_ok({ form_name => "openid",
+ fields => { openid_identifier => $claimed_uri,
+ },
+ },
+ "Trying OpenID login, 'openid' realm");
+
+$mech->content_contains("You did it with OpenID!",
+ "Successfully signed in with OpenID");
+
+$mech->get_ok($root, "GET $root");
+
+$mech->content_contains("provider/paco", "OpenID signed in");
+#$mech->content_contains("paco", "OpenID signed in as paco");
+
+# can't be verified
+
+$mech->get_ok("$root/logout", "GET $root/logout");
+
+$mech->get_ok("$root/signin_openid", "GET $root/signin_openid");
+
+$mech->content_contains("Sign in with OpenID", "Content looks right");
+
+$mech->submit_form_ok({ form_name => "openid",
+ fields => { openid_identifier => $claimed_uri,
+ },
+ },
+ "Trying OpenID login, 'openid' realm");
+
+$mech->content_contains("can't be verified",
+ "Proper failure for unauthenticated memember.");
+
+# Tests end ----------------------------------------------
+
+# shut it down
+kill 'INT', $pid;
+close $server;
+
+exit 0;
+
+sub check_port {
+ my ( $host, $port ) = @_;
+
+ my $remote = IO::Socket::INET->new(
+ Proto => "tcp",
+ PeerAddr => $host,
+ PeerPort => $port
+ );
+ if ($remote) {
+ close $remote;
+ return 1;
+ }
+ else {
+ return 0;
+ }
+}
+
+__END__
+
eval "use Test::Pod::Coverage 1.04";
plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
all_pod_coverage_ok();
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
eval "use Test::Pod 1.14";
plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
all_pod_files_ok();
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
projects / catagits/Catalyst-Authentication-Credential-OpenID.git / commitdiff