Catalyst-Plugin-Authentication-0.10023/000755 000765 000024 00000000000 12131606106 017513 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/.gitignore000644 000765 000024 00000000266 11751225134 021514 0ustar00t0mstaff000000 000000 .* !.gitignore Makefile* !Makefile.PL MYMETA.* META.yml blib build inc pm_to_blib MANIFEST* !MANIFEST.SKIP Debian* README Catalyst-Plugin-Authentication-* *.bs \.DS_Store$ ^\.Trash/ Catalyst-Plugin-Authentication-0.10023/Changes000644 000765 000024 00000020115 12131606020 021000 0ustar00t0mstaff000000 000000 Revision history for Perl extension Catalyst::Plugin::Authentication 0.10023 11 Jan 2013 - Add Howto on using the auth from the proxy server with ::Credential::Remote (Robert Rothenberg) 0.10022 08 Jan 2013 - Fix NoPasswd store (skaufman) 0.10021 30 June 2012 - Change all classes to Moose and MooseX::Emulate::Class::Accessor::Fast, fixing undeclared dependency on Class::Accessor::Fast. - Change Catalyst::Authentication::Realm to use String::RewritePrefix rather than doing namespace mangling manually. - Fix whitespace and tabs, add Test::EOL and Test::NoTabs - Document optional methods in stores needed for auto_create_user and auto_update_user in realms. - Clarify support channels - Note primary maintainer in docs. - Add x_authority metadata. - Get the NAME right by making it 1 line, due to crappy parsing in EU::MM (RT#77028) 0.10020 05 May 2012 - Allow user_class to be configured for Catalyst::Authentication::Store::Minimal (Jochen Lutz ) 0.10019 14 April 2012 - Upgrade code to use Moose compatibility layer (jnap) - Added some rules to .gitignore for people using macs (jnap) - Updated copyright info - Catalyst::Plugin::Authentication::Credential::NoPassword added (Okko) - Convert repository to git (fREW Schmidt) 0.10018 29 Jul 2011 - Fix failing tests with the new PSGI Catalyst dev release 0.10017 24 Jan 2010 - Fix failing tests with the new PSGI Catalyst dev release 0.10016 22 Jan 2010 - Move root actions out of applcation class in tests to remove warnings in the latest Catalyst. - Add AUTOLOAD method to the default user class so that methods are delegated down onto the underlieing user object retrieved from the store (if present) - Fix typos in documentation (RT#49476) - Fix compatibilty with Catalyst 5.70 (RT#50466) - Various documentation improvements - Fix Realm::Processive's authinfo_munge option (RT#47106) 0.10015 Tue Sep 1 01:40:36 BST 2009 - Remove (undeclared) dependency on Class::Data::Inhertiable (RT#49086) - Remove dependency on Test::MockObject - Fix repository metadata in META.yml / Makefile.PL - Make POD tests author side only. 0.10014 Tue Aug 25 15:42:57 BST 2009 - Don't always supply an "id" column in the authinfo passed to the store class in ::Credential::Remote. This means that it works better with the DBIC store. (t0m) - Make auth_realms method ensure authentication is initialized before calling methods which get created during auth initialization. Fixes back compat cases where auth store is in the plugin list before the authentication plugin. (t0m) 0.10013 Fri Jun 19 16:08:00 BST 2009 - Add a username_field config item to ::Credential::Remote (Nigel Metheringham) - Die with a useful error message if we are about to try to restore a user from a realm which does not exist. (t0m) 0.10012 Sat Jun 6 10:58:43 BST 2009 - Add Catalyst::Authentication::Credential::Remote which authenticates you directly from environment variables passed by your web server. This allows the use of SSL client certificates, NTLM, or just basic/digest auth done at the web server level to be used to authenticate users to your Catalyst application (kmx) - Tests for this - Change ->config invocations to be best practices (t0m) - Note about session auto-vification even when use_session is set to false (robert). - Note about how a realms key used to be needed to unconfuse people running an old version, but browsing the docs on search.cpan (ruoso) 0.10011 Sun Mar 8 23:32:12 GMT 2009 - Update t/live_app_session.t to skip unless you have a newer, more reliable version of TWMC (RT#43817) - Change check for isa Catalyst::Plugin::Session to just check the existance of a session method. (Edmund von der Burg) 0.10010 - Change from NEXT to MRO::Compat - Chop a number off the versions to get back to the correct 0.10000 version scheme. 0.100092_01 - Add hook for failing user restore. - Add test for this. - Fix bug in Credential::Password with password_type: clear. - Add test for this. - Add mock object tests for Credential::Password with password_type: clear. 0.100092 - Release new version, no changes since dev release. 0.10009_01 - Fix POD escaping, from RT#38694 (Luke Ross) - Change authentication backwards compatibility handling to not rely on Class::Data::Inheritable side effects, and so be Catalyst 5.80 safe (t0m) 0.10009 2008-11-27 - Including progressive realm for multiple authentication attempts in a single request. 0.10008 2008-10-23 - Updating config to allow for inclusion of realm ref's in the main config hash rather than in a subref called 'realms' 0.10007 2008-08-17 - Update tests prereqs to include Test::Exception (RT #36339) - Some documentation fixes (including RT #36062) - Compatibility fix where the use of new style config and old style Authentication::Store::Minimal would cause a crash (Reported & fixed by Jos Boumans C) - Documentation update on Password - to indicate proper field naming - Decouple Authentication system from session. The realm class now allows complete control over how a user is persisted across requests. - pod fixes (RT #36062, RT #36063) 0.10006 2008-02-15 - Additional documentation for Realms - Added update_user_in_session routine to allow re-saving of user data into the session. 0.10005 2008-01-24 - Bugfix release - correcting 'Plugin::Authentication' configuration problem. 0.10004 2007-12-04 - Added some code for back-compatibility 0.10003 2007-12-02 - Added a "Null" store for credentials that don't require real stores. - Make realms bonafide objects - Added auto_update_user and auto_create_user options to the Realm object - Doc updates [POSSIBLE INCOMPATIBILITIES] - authenticate() in credentials are now passed a realm object instead of a store object. A realm object still implements find_user() so unless you're doing something special you won't notice the difference. 0.10002 2007-07-22 - $user->store() should NOT be set by C::P::Auth - if it's needed - it should be set by whatever module creates the user. We use realm for saving into the session. 0.10001 2007-07-17 - updated tests 0.10000 2007-07-11 - Minor updates to work better with compatibility mode - Producion release - switch to Module::Install 0.09999_01 2007-02-21 - major changes to the internals of the plugin, to better encapsulate credentials and stores. - introduction of 'realms' concept, allowing multiple different pairs of credential and store in a single application. 0.09 2006-08-01 - be a bit more pedantic about checking values for definedness before invoking methods on them 0.08 2006-07-29 - factor test applications out to files due to changes in Catalyst::Test - don't load session at prepare time unless necessary 0.07 2006-03-17 17:33:12 - allow base64 hashed passwords 0.06 2006-03-14 19:23:50 - pass extra get_user args to store so they can be made use of 0.05 2006-01-01 13:58:00 - Add debugging to Credential::Password - Important doc fixes 0.04 - With User::Hash and Store::Minimal together session will store userid, not actual user object 0.03 2005-12-03 18:00:00 - Added user_exists method. 0.02 2005-11-29 11:39:00 - Fixed a typo (PLugin instead of Plugin) that caused user objects to not be restored from the session properly. Modified test suite to actually test for this case. 0.01 2005-11-27 02:30:00 - Initial release. Catalyst-Plugin-Authentication-0.10023/inc/000755 000765 000024 00000000000 12131606106 020264 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/lib/000755 000765 000024 00000000000 12131606106 020261 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/Makefile.PL000644 000765 000024 00000002402 12127121000 021451 0ustar00t0mstaff000000 000000 use strict; use warnings; use inc::Module::Install 0.87; use Module::Install::AuthorRequires; use Module::Install::AuthorTests; use Module::Install::Authority; if ( $Module::Install::AUTHOR ) { system( 'pod2text lib/Catalyst/Plugin/Authentication.pm > README' ) and die; } perl_version '5.008001'; name 'Catalyst-Plugin-Authentication'; all_from 'lib/Catalyst/Plugin/Authentication.pm'; authority 'cpan:BOBTFISH'; requires 'Catalyst::Runtime'; requires 'Class::Inspector'; requires 'MRO::Compat'; requires 'Catalyst::Plugin::Session' => '0.10'; requires 'Moose'; requires 'MooseX::Emulate::Class::Accessor::Fast'; requires 'namespace::autoclean'; requires 'String::RewritePrefix'; requires 'Try::Tiny'; test_requires 'Test::More' => '0.88'; test_requires 'Test::Exception'; test_requires 'Class::MOP'; test_requires 'Moose'; author_requires( 'Test::Pod' => '1.14', 'Test::Pod::Coverage' => '1.04', 'Test::NoTabs' => 0, 'Test::EOL' => 0, 'Test::WWW::Mechanize::Catalyst' => 0, 'Catalyst::Plugin::Session' => 0, 'Catalyst::Plugin::Session::State::Cookie' => 0, 'Digest::SHA1' => 0, ); author_tests 't/author'; auto_install; resources repository => 'git://git.shadowcat.co.uk/catagits/Catalyst-Plugin-Authentication.git'; WriteAll; Catalyst-Plugin-Authentication-0.10023/MANIFEST000644 000765 000024 00000004113 12073071324 020646 0ustar00t0mstaff000000 000000 .gitignore Changes inc/Module/AutoInstall.pm inc/Module/Install.pm inc/Module/Install/Authority.pm inc/Module/Install/AuthorRequires.pm inc/Module/Install/AuthorTests.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/NoPassword.pm lib/Catalyst/Authentication/Credential/Password.pm lib/Catalyst/Authentication/Credential/Remote.pm lib/Catalyst/Authentication/Realm.pm lib/Catalyst/Authentication/Realm/Compatibility.pm lib/Catalyst/Authentication/Realm/Progressive.pm lib/Catalyst/Authentication/Store.pod lib/Catalyst/Authentication/Store/Minimal.pm lib/Catalyst/Authentication/Store/Null.pm lib/Catalyst/Authentication/User.pm lib/Catalyst/Authentication/User/Hash.pm lib/Catalyst/Plugin/Authentication.pm lib/Catalyst/Plugin/Authentication/Credential/Password.pm lib/Catalyst/Plugin/Authentication/Internals.pod lib/Catalyst/Plugin/Authentication/Store/Minimal.pm lib/Catalyst/Plugin/Authentication/User.pm lib/Catalyst/Plugin/Authentication/User/Hash.pm Makefile.PL MANIFEST This list of files META.yml README t/04_authentication.t t/05_password.t t/06_user.t t/author/eol.t t/author/notabs.t t/author/pod.t t/author/pod_coverage.t t/lib/AuthRealmTestApp.pm t/lib/AuthRealmTestApp/Controller/Root.pm t/lib/AuthRealmTestAppCompat.pm t/lib/AuthRealmTestAppCompat/Controller/Root.pm t/lib/AuthRealmTestAppProgressive.pm t/lib/AuthRealmTestAppProgressive/Controller/Root.pm t/lib/AuthSessionTestApp.pm t/lib/AuthSessionTestApp/Controller/Root.pm t/lib/AuthTestApp.pm t/lib/AuthTestApp/Controller/Root.pm t/lib/RemoteTestApp1.pm t/lib/RemoteTestApp1/Controller/Root.pm t/lib/RemoteTestApp2.pm t/lib/RemoteTestApp2/Controller/Root.pm t/lib/RemoteTestEngine.pm t/lib/RemoteTestEngineRole.pm t/live_app.t t/live_app_realms.t t/live_app_realms_compat.t t/live_app_realms_progressive.t t/live_app_remote1.t t/live_app_remote2.t t/live_app_session.t t/store_nopassord.t Catalyst-Plugin-Authentication-0.10023/META.yml000644 000765 000024 00000001757 12131606054 021000 0ustar00t0mstaff000000 000000 --- abstract: 'Infrastructure plugin for the Catalyst authentication framework.' author: - 'Yuval Kogman, C - original author' build_requires: Class::MOP: 0 ExtUtils::MakeMaker: 6.59 Moose: 0 Test::Exception: 0 Test::More: 0.88 configure_requires: ExtUtils::MakeMaker: 6.59 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.06' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Catalyst-Plugin-Authentication no_index: directory: - inc - t requires: Catalyst::Plugin::Session: 0.10 Catalyst::Runtime: 0 Class::Inspector: 0 MRO::Compat: 0 Moose: 0 MooseX::Emulate::Class::Accessor::Fast: 0 String::RewritePrefix: 0 Try::Tiny: 0 namespace::autoclean: 0 perl: 5.8.1 resources: license: http://dev.perl.org/licenses/ repository: git://git.shadowcat.co.uk/catagits/Catalyst-Plugin-Authentication.git version: 0.10023 x_authority: cpan:BOBTFISH Catalyst-Plugin-Authentication-0.10023/README000644 000765 000024 00000060220 12131606053 020374 0ustar00t0mstaff000000 000000 NAME Catalyst::Plugin::Authentication - Infrastructure plugin for the Catalyst authentication framework. SYNOPSIS use Catalyst qw/ Authentication /; # later on ... $c->authenticate({ username => 'myusername', password => 'mypassword' }); my $age = $c->user->get('age'); $c->logout; DESCRIPTION The authentication plugin provides generic user support for Catalyst apps. It is the basis for both authentication (checking the user is who they claim to be), and authorization (allowing the user to do what the system authorises them to do). Using authentication is split into two parts. A Store is used to actually store the user information, and can store any amount of data related to the user. Credentials are used to verify users, using information from the store, given data from the frontend. A Credential and a Store are paired to form a 'Realm'. A Catalyst application using the authentication framework must have at least one realm, and may have several. To implement authentication in a Catalyst application you need to add this module, and specify at least one realm in the configuration. Authentication data can also be stored in a session, if the application is using the Catalyst::Plugin::Session module. NOTE in version 0.10 of this module, the interface to this module changed. Please see "COMPATIBILITY ROUTINES" for more information. INTRODUCTION The Authentication/Authorization Process Web applications typically need to identify a user - to tell the user apart from other users. This is usually done in order to display private information that is only that user's business, or to limit access to the application so that only certain entities can access certain parts. This process is split up into several steps. First you ask the user to identify themselves. At this point you can't be sure that the user is really who they claim to be. Then the user tells you who they are, and backs this claim with some piece of information that only the real user could give you. For example, a password is a secret that is known to both the user and you. When the user tells you this password you can assume they're in on the secret and can be trusted (ignore identity theft for now). Checking the password, or any other proof is called credential verification. By this time you know exactly who the user is - the user's identity is authenticated. This is where this module's job stops, and your application or other plugins step in. The next logical step is authorization, the process of deciding what a user is (or isn't) allowed to do. For example, say your users are split into two main groups - regular users and administrators. You want to verify that the currently logged in user is indeed an administrator before performing the actions in an administrative part of your application. These decisions may be made within your application code using just the information available after authentication, or it may be facilitated by a number of plugins. The Components In This Framework Realms Configuration of the Catalyst::Plugin::Authentication framework is done in terms of realms. In simplest terms, a realm is a pairing of a Credential verifier and a User storage (Store) backend. As of version 0.10003, realms are now objects that you can create and customize. An application can have any number of Realms, each of which operates independent of the others. Each realm has a name, which is used to identify it as the target of an authentication request. This name can be anything, such as 'users' or 'members'. One realm must be defined as the default_realm, which is used when no realm name is specified. More information about configuring realms is available in the configuration section. Credential Verifiers When user input is transferred to the Catalyst application (typically via form inputs) the application may pass this information into the authentication system through the "$c->authenticate()" method. From there, it is passed to the appropriate Credential verifier. These plugins check the data, and ensure that it really proves the user is who they claim to be. Credential verifiers compatible with versions of this module 0.10x and upwards should be in the namespace "Catalyst::Authentication::Credential". Storage Backends The authentication data also identifies a user, and the Storage backend modules use this data to locate and return a standardized object-oriented representation of a user. When a user is retrieved from a store it is not necessarily authenticated. Credential verifiers accept a set of authentication data and use this information to retrieve the user from the store they are paired with. Storage backends compatible with versions of this module 0.10x and upwards should be in the namespace "Catalyst::Authentication::Store". The Core Plugin This plugin on its own is the glue, providing realm configuration, session integration, and other goodness for the other plugins. Other Plugins More layers of plugins can be stacked on top of the authentication code. For example, Catalyst::Plugin::Session::PerUser provides an abstraction of browser sessions that is more persistent per user. Catalyst::Plugin::Authorization::Roles provides an accepted way to separate and group users into categories, and then check which categories the current user belongs to. EXAMPLE Let's say we were storing users in a simple Perl hash. Users are verified by supplying a password which is matched within the hash. This means that our application will begin like this: package MyApp; use Catalyst qw/ Authentication /; __PACKAGE__->config( 'Plugin::Authentication' => { default => { credential => { class => 'Password', password_field => 'password', password_type => 'clear' }, store => { class => 'Minimal', users => { bob => { password => "s00p3r", editor => 'yes', roles => [qw/edit delete/], }, william => { password => "s3cr3t", roles => [qw/comment/], } } } } } ); This tells the authentication plugin what realms are available, which credential and store modules are used, and the configuration of each. With this code loaded, we can now attempt to authenticate users. To show an example of this, let's create an authentication controller: package MyApp::Controller::Auth; sub login : Local { my ( $self, $c ) = @_; if ( my $user = $c->req->params->{user} and my $password = $c->req->params->{password} ) { if ( $c->authenticate( { username => $user, password => $password } ) ) { $c->res->body( "hello " . $c->user->get("name") ); } else { # login incorrect } } else { # invalid form input } } This code should be self-explanatory. If all the necessary fields are supplied, call the "authenticate" method on the context object. If it succeeds the user is logged in. The credential verifier will attempt to retrieve the user whose details match the authentication information provided to "$c->authenticate()". Once it fetches the user the password is checked and if it matches the user will be authenticated and "$c->user" will contain the user object retrieved from the store. In the above case, the default realm is checked, but we could just as easily check an alternate realm. If this were an admin login, for example, we could authenticate on the admin realm by simply changing the "$c->authenticate()" call: if ( $c->authenticate( { username => $user, password => $password }, 'admin' ) ) { $c->res->body( "hello " . $c->user->get("name") ); } ... Now suppose we want to restrict the ability to edit to a user with an 'editor' value of yes. The restricted action might look like this: sub edit : Local { my ( $self, $c ) = @_; $c->detach("unauthorized") unless $c->user_exists and $c->user->get('editor') eq 'yes'; # do something restricted here } (Note that if you have multiple realms, you can use "$c->user_in_realm('realmname')" in place of "$c->user_exists();" This will essentially perform the same verification as user_exists, with the added requirement that if there is a user, it must have come from the realm specified.) The above example is somewhat similar to role based access control. Catalyst::Authentication::Store::Minimal treats the roles field as an array of role names. Let's leverage this. Add the role authorization plugin: use Catalyst qw/ ... Authorization::Roles /; sub edit : Local { my ( $self, $c ) = @_; $c->detach("unauthorized") unless $c->check_user_roles("edit"); # do something restricted here } This is somewhat simpler and will work if you change your store, too, since the role interface is consistent. Let's say your app grows, and you now have 10,000 users. It's no longer efficient to maintain a hash of users, so you move this data to a database. You can accomplish this simply by installing the DBIx::Class Store and changing your config: __PACKAGE__->config( 'Plugin::Authentication' => { default_realm => 'members', members => { credential => { class => 'Password', password_field => 'password', password_type => 'clear' }, store => { class => 'DBIx::Class', user_model => 'MyApp::Users', role_column => 'roles', } } } ); The authentication system works behind the scenes to load your data from the new source. The rest of your application is completely unchanged. CONFIGURATION # example __PACKAGE__->config( 'Plugin::Authentication' => { default_realm => 'members', members => { credential => { class => 'Password', password_field => 'password', password_type => 'clear' }, store => { class => 'DBIx::Class', user_model => 'MyApp::Users', role_column => 'roles', } }, admins => { credential => { class => 'Password', password_field => 'password', password_type => 'clear' }, store => { class => '+MyApp::Authentication::Store::NetAuth', authserver => '192.168.10.17' } } } ); NOTE: Until version 0.10008 of this module, you would need to put all the realms inside a "realms" key in the configuration. Please see "COMPATIBILITY CONFIGURATION" for more information use_session Whether or not to store the user's logged in state in the session, if the application is also using Catalyst::Plugin::Session. This value is set to true per default. However, even if use_session is disabled, if any code touches $c->session, a session object will be auto-vivified and session Cookies will be sent in the headers. To prevent accidental session creation, check if a session already exists with if ($c->sessionid) { ... }. If the session doesn't exist, then don't place anything in the session to prevent an unecessary session from being created. default_realm This defines which realm should be used as when no realm is provided to methods that require a realm such as authenticate or find_user. realm refs The Plugin::Authentication config hash contains the series of realm configurations you want to use for your app. The only rule here is that there must be at least one. A realm consists of a name, which is used to reference the realm, a credential and a store. You may also put your realm configurations within a subelement called 'realms' if you desire to separate them from the remainder of your configuration. Note that if you use a 'realms' subelement, you must put ALL of your realms within it. You can also specify a realm class to instantiate instead of the default Catalyst::Authentication::Realm class using the 'class' element within the realm config. Each realm config contains two hashes, one called 'credential' and one called 'store', each of which provide configuration details to the respective modules. The contents of these hashes is specific to the module being used, with the exception of the 'class' element, which tells the core Authentication module the classname to instantiate. The 'class' element follows the standard Catalyst mechanism of class specification. If a class is prefixed with a +, it is assumed to be a complete class name. Otherwise it is considered to be a portion of the class name. For credentials, the classname 'Password', for example, is expanded to Catalyst::Authentication::Credential::Password. For stores, the classname 'storename' is expanded to: Catalyst::Authentication::Store::storename. METHODS $c->authenticate( $userinfo [, $realm ]) Attempts to authenticate the user using the information in the $userinfo hash reference using the realm $realm. $realm may be omitted, in which case the default realm is checked. $c->user( ) Returns the currently logged in user, or undef if there is none. Normally the user is re-retrieved from the store. For Catalyst::Authentication::Store::DBIx::Class the user is re-restored using the primary key of the user table. Thus user can throw an error even though user_exists returned true. $c->user_exists( ) Returns true if a user is logged in right now. The difference between user_exists and user is that user_exists will return true if a user is logged in, even if it has not been yet retrieved from the storage backend. If you only need to know if the user is logged in, depending on the storage mechanism this can be much more efficient. user_exists only looks into the session while user is trying to restore the user. $c->user_in_realm( $realm ) Works like user_exists, except that it only returns true if a user is both logged in right now and was retrieved from the realm provided. $c->logout( ) Logs the user out. Deletes the currently logged in user from "$c->user" and the session. It does not delete the session. $c->find_user( $userinfo, $realm ) Fetch a particular users details, matching the provided user info, from the realm specified in $realm. $user = $c->find_user({ id => $id }); $c->set_authenticated($user); # logs the user in and calls persist_user persist_user() Under normal circumstances the user data is only saved to the session during initial authentication. This call causes the auth system to save the currently authenticated user's data across requests. Useful if you have changed the user data and want to ensure that future requests reflect the most current data. Assumes that at the time of this call, $c->user contains the most current data. find_realm_for_persisted_user() Private method, do not call from user code! INTERNAL METHODS These methods are for Catalyst::Plugin::Authentication INTERNAL USE only. Please do not use them in your own code, whether application or credential / store modules. If you do, you will very likely get the nasty shock of having to fix / rewrite your code when things change. They are documented here only for reference. $c->set_authenticated( $user, $realmname ) Marks a user as authenticated. This is called from within the authenticate routine when a credential returns a user. $realmname defaults to 'default'. You can use find_user to get $user $c->auth_restore_user( $user, $realmname ) Used to restore a user from the session. In most cases this is called without arguments to restore the user via the session. Can be called with arguments when restoring a user from some other method. Currently not used in this way. $c->auth_realms( ) Returns a hashref containing realmname -> realm instance pairs. Realm instances contain an instantiated store and credential object as the 'store' and 'credential' elements, respectively $c->get_auth_realm( $realmname ) Retrieves the realm instance for the realmname provided. $c->update_user_in_session This was a short-lived method to update user information - you should use persist_user instead. $c->setup_auth_realm( ) OVERRIDDEN METHODS $c->setup( ) SEE ALSO This list might not be up to date. Below are modules known to work with the updated API of 0.10 and are therefore compatible with realms. Realms Catalyst::Authentication::Realm User Storage Backends Catalyst::Authentication::Store::Minimal Catalyst::Authentication::Store::DBIx::Class Catalyst::Authentication::Store::LDAP Catalyst::Authentication::Store::RDBO Catalyst::Authentication::Store::Model::KiokuDB Catalyst::Authentication::Store::Jifty::DBI Catalyst::Authentication::Store::Htpasswd Credential verification Catalyst::Authentication::Credential::Password Catalyst::Authentication::Credential::HTTP Catalyst::Authentication::Credential::OpenID Catalyst::Authentication::Credential::Authen::Simple Catalyst::Authentication::Credential::Flickr Catalyst::Authentication::Credential::Testing Catalyst::Authentication::Credential::AuthTkt Catalyst::Authentication::Credential::Kerberos Authorization Catalyst::Plugin::Authorization::ACL, Catalyst::Plugin::Authorization::Roles Internals Documentation Catalyst::Plugin::Authentication::Internals Misc Catalyst::Plugin::Session, Catalyst::Plugin::Session::PerUser DON'T SEE ALSO This module along with its sub plugins deprecate a great number of other modules. These include Catalyst::Plugin::Authentication::Simple, Catalyst::Plugin::Authentication::CDBI. INCOMPATABILITIES The realms-based configuration and functionality of the 0.10 update of Catalyst::Plugin::Authentication required a change in the API used by credentials and stores. It has a compatibility mode which allows use of modules that have not yet been updated. This, however, completely mimics the older api and disables the new realm-based features. In other words you cannot mix the older credential and store modules with realms, or realm-based configs. The changes required to update modules are relatively minor and are covered in Catalyst::Plugin::Authentication::Internals. We hope that most modules will move to the compatible list above very quickly. COMPATIBILITY CONFIGURATION Until version 0.10008 of this module, you needed to put all the realms inside a "realms" key in the configuration. # example __PACKAGE__->config( 'Plugin::Authentication' => { default_realm => 'members', realms => { members => { ... }, }, } ); If you use the old, deprecated "__PACKAGE__->config( 'authentication' )" configuration key, then the realms key is still required. COMPATIBILITY ROUTINES In version 0.10 of Catalyst::Plugin::Authentication, the API changed. For app developers, this change is fairly minor, but for Credential and Store authors, the changes are significant. Please see the documentation in version 0.09 of Catalyst::Plugin::Authentication for a better understanding of how the old API functioned. The items below are still present in the plugin, though using them is deprecated. They remain only as a transition tool, for those sites which can not yet be upgraded to use the new system due to local customizations or use of Credential / Store modules that have not yet been updated to work with the new API. These routines should not be used in any application using realms functionality or any of the methods described above. These are for reference purposes only. $c->login( ) This method is used to initiate authentication and user retrieval. Technically this is part of the old Password credential module and it still resides in the Password class. It is included here for reference only. $c->default_auth_store( ) Return the store whose name is 'default'. This is set to "$c->config( 'Plugin::Authentication' => { store => # Store} )" if that value exists, or by using a Store plugin: # load the Minimal authentication store. use Catalyst qw/Authentication Authentication::Store::Minimal/; Sets the default store to Catalyst::Plugin::Authentication::Store::Minimal. $c->get_auth_store( $name ) Return the store whose name is $name. $c->get_auth_store_name( $store ) Return the name of the store $store. $c->auth_stores( ) A hash keyed by name, with the stores registered in the app. $c->register_auth_stores( %stores_by_name ) Register stores into the application. $c->auth_store_names( ) $c->get_user( ) SUPPORT Please use the rt.cpan.org bug tracker, and git patches are wecome. Questions on usage should be directed to the Catalyst mailing list or the #catalyst irc channel. AUTHORS Yuval Kogman, "nothingmuch@woobling.org" - original author Jay Kuri, "jayk@cpan.org" - Large rewrite PRIMARY MAINTAINER Tomas Doran (t0m), "bobtfish@bobtfish.net" ADDITIONAL CONTRIBUTORS Jess Robinson David Kamholz kmx Nigel Metheringham Florian Ragwitz "rafl@debian.org" Stephan Jauernick "stephanj@cpan.org" Oskari Ojala (Okko), "perl@okko.net" John Napiorkowski (jnap) "jjnapiork@cpan.org" COPYRIGHT & LICENSE Copyright (c) 2005 - 2012 the Catalyst::Plugin::Authentication "AUTHORS", "PRIMARY MAINTAINER" and "ADDITIONAL CONTRIBUTORS" as listed above. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Catalyst-Plugin-Authentication-0.10023/t/000755 000765 000024 00000000000 12131606106 017756 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/t/04_authentication.t000644 000765 000024 00000000261 11641336536 023500 0ustar00t0mstaff000000 000000 use strict; use warnings; use Test::More 'no_plan'; my $m; BEGIN { use_ok($m = "Catalyst::Plugin::Authentication") } can_ok( $m, $_ ) for qw/user logout set_authenticated/; Catalyst-Plugin-Authentication-0.10023/t/05_password.t000644 000765 000024 00000004351 11641336536 022330 0ustar00t0mstaff000000 000000 use strict; use warnings; use Test::More tests => 11; use Test::Exception; use Class::MOP; use Class::MOP::Class; use Moose::Object; # 1,2 my $m; BEGIN { use_ok($m = "Catalyst::Authentication::Credential::Password") } can_ok($m, "authenticate"); my $app_meta = Class::MOP::Class->create_anon_class( superclasses => ['Moose::Object'] ); my $realm_meta = Class::MOP::Class->create_anon_class( superclasses => ['Moose::Object'] ); my $user_meta = Class::MOP::Class->create_anon_class( superclasses => ['Moose::Object'] ); our ($user_get_password_field_name, $user_password ); $user_meta->add_method('get' => sub { $user_get_password_field_name = $_[1]; return $user_password }); # 3-6 # Test clear passwords if you mess up the password_field { local $user_password = undef; # The user returns an undef password, local $user_get_password_field_name; # as there is no field named 'mistyped' my $config = { password_type => 'clear', password_field => 'mistyped' }; my $i; lives_ok { $i = $m->new($config, $app_meta->name->new, $realm_meta->name->new) } 'Construct instance'; ok($i, 'Have instance'); my $r = $i->check_password($user_meta->name->new, { username => 'someuser', password => 'password' }); is($user_get_password_field_name, 'mistyped', '(Incorrect) field name from config correctly passed to user'); ok(! $r, 'Authentication unsuccessful' ); } # 7-11 # Test clear passwords working, and not working { local $user_password = 'mypassword'; local $user_get_password_field_name; my $config = { password_type => 'clear', password_field => 'the_password_field' }; my $i; lives_ok { $i = $m->new($config, $app_meta->name->new, $realm_meta->name->new) } 'Construct instance'; ok($i, 'Have instance'); my $r = $i->check_password($user_meta->name->new, { username => 'someuser', the_password_field => 'mypassword' }); is($user_get_password_field_name, 'the_password_field', 'Correct field name from config correctly passed to user'); ok( $r, 'Authentication successful with correct password' ); $r = $i->check_password($user_meta->name->new, { username => 'someuser', the_password_field => 'adifferentpassword' }); ok( ! $r, 'Authentication ussuccessful with incorrect password' ); } Catalyst-Plugin-Authentication-0.10023/t/06_user.t000644 000765 000024 00000002077 11641336536 021450 0ustar00t0mstaff000000 000000 use strict; use warnings; use Test::More; use Test::Exception; my $m; BEGIN { use_ok($m = "Catalyst::Authentication::User") } { package SomeBaseUser; sub other_method { 'FNAR' }; } { package SomeUser; use base $m; sub new { bless {}, shift }; sub supported_features { { feature => { subfeature => 1, unsupported_subfeature => 0, }, top_level => 1, } } sub get_object { bless {}, 'SomeBaseUser'; } } my $o = SomeUser->new; can_ok( $m, "supports" ); ok( $o->supports("top_level"), "simple top level feature check"); ok( $o->supports(qw/feature subfeature/), "traversal"); ok( !$o->supports(qw/feature unsupported_subfeature/), "traversal terminating in false"); lives_ok { $o->supports("bad_key"); } "can check for non existent feature"; #dies_ok { # $o->supports(qw/bad_key subfeature/) #} "but can't traverse into one"; lives_ok { is $o->other_method, 'FNAR', 'Delegation onto user object works'; } 'Delegation lives'; done_testing; Catalyst-Plugin-Authentication-0.10023/t/author/000755 000765 000024 00000000000 12131606106 021260 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/t/lib/000755 000765 000024 00000000000 12131606106 020524 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/t/live_app.t000644 000765 000024 00000000402 11641336536 021752 0ustar00t0mstaff000000 000000 use strict; use warnings; use Test::More; BEGIN { plan skip_all => "Digest::SHA1 is required for this test" unless eval { require Digest::SHA1 }; plan "no_plan"; } use lib 't/lib'; use Catalyst::Test qw/AuthTestApp/; ok(get("/moose"), "get ok"); Catalyst-Plugin-Authentication-0.10023/t/live_app_realms.t000644 000765 000024 00000000244 11641336536 023321 0ustar00t0mstaff000000 000000 use strict; use warnings; use Test::More; BEGIN { plan "no_plan"; } use lib 't/lib'; use Catalyst::Test qw/AuthRealmTestApp/; ok(get("/moose"), "get ok"); Catalyst-Plugin-Authentication-0.10023/t/live_app_realms_compat.t000644 000765 000024 00000000251 11641336536 024662 0ustar00t0mstaff000000 000000 use strict; use warnings; use Test::More; BEGIN { plan "no_plan"; } use lib 't/lib'; use Catalyst::Test qw/AuthRealmTestAppCompat/; ok(get("/moose"), "get ok"); Catalyst-Plugin-Authentication-0.10023/t/live_app_realms_progressive.t000644 000765 000024 00000000245 11641336536 025752 0ustar00t0mstaff000000 000000 use strict; use warnings; use Test::More; use lib 't/lib'; use Catalyst::Test qw/AuthRealmTestAppProgressive/; ok(get("/progressive"), "get ok"); done_testing; Catalyst-Plugin-Authentication-0.10023/t/live_app_remote1.t000644 000765 000024 00000002140 11641336536 023407 0ustar00t0mstaff000000 000000 use strict; use warnings; use Test::More; use lib 't/lib'; use Catalyst::Test qw/RemoteTestApp1/; $RemoteTestEngine::REMOTE_USER = undef; ok( request('/public')->is_success, 'anonymous user (undef) - /public' ); ok( request('/')->is_error, 'anonymous user (undef) - /' ); $RemoteTestEngine::REMOTE_USER = ''; ok( request('/public')->is_success, 'anonymous user (empty) - /public' ); ok( request('/')->is_error, 'anonymous user (empty) - /' ); $RemoteTestEngine::REMOTE_USER = 'john'; ok( request('/')->is_success, 'valid user' ); $RemoteTestEngine::REMOTE_USER = 'nonexisting'; ok( request('/')->is_error, 'non-existing user' ); $RemoteTestEngine::REMOTE_USER = 'denieduser'; ok( request('/')->is_error, 'explicitly denied user' ); $RemoteTestEngine::REMOTE_USER = 'CN=namexyz/OU=Test/C=Company'; ok( request('/')->is_success, 'testing "cutname" option 1' ); is( request('/')->content, 'User:namexyz', 'testing "cutname" option 2' ); $RemoteTestEngine::REMOTE_USER = 'CN=/OU=Test/C=Company'; is( request('/')->content, 'User:CN=/OU=Test/C=Company', 'testing "cutname" option - empty $1 match' ); done_testing; Catalyst-Plugin-Authentication-0.10023/t/live_app_remote2.t000644 000765 000024 00000001275 11641336536 023420 0ustar00t0mstaff000000 000000 use strict; use warnings; use Test::More; use lib 't/lib'; use Catalyst::Test qw/RemoteTestApp2/; $RemoteTestEngine::REMOTE_USER = undef; # WARNING: this requires $c->engine->env to work properly # $c->engine->env was slightly broken in 5.8004 but this test should pass # as it uses Engine::CGI that works fine even in 5.80004 $RemoteTestEngine::SSL_CLIENT_S_DN = 'CN=anyuser/OU=Test/C=Company'; ok( request('/')->is_success, 'testing "source" option' ); $RemoteTestEngine::SSL_CLIENT_S_DN = 'CN=namexyz/OU=Test/C=Company'; ok( request('/')->is_success, 'testing "source" + "cutname" 1' ); is( request('/')->content, "my_user_name:namexyz", 'testing "source" + "cutname" 2' ); done_testing; Catalyst-Plugin-Authentication-0.10023/t/live_app_session.t000644 000765 000024 00000002016 11641336536 023520 0ustar00t0mstaff000000 000000 use strict; use warnings; use Test::More; BEGIN { eval { require Test::WWW::Mechanize::Catalyst; require Catalyst::Plugin::Session; require Catalyst::Plugin::Session::State::Cookie }; plan skip_all => "This test needs Test::WWW::Mechanize::Catalyst, Catalyst::Plugin::Session and Catalyst::Plugin::Session::State::Cookie installed" if $@; plan skip_all => "This test needs Test::WWW::Mechanize::Catalyst >= 0.50, you have only $Test::WWW::Mechanize::Catalyst::VERSION" unless $Test::WWW::Mechanize::Catalyst::VERSION >= 0.50; } use lib 't/lib'; use Test::WWW::Mechanize::Catalyst qw/AuthSessionTestApp/; # for the cookie support my $m = Test::WWW::Mechanize::Catalyst->new; $m->get_ok("http://localhost/moose", "get ok"); $m->get_ok("http://localhost/elk", "get ok"); $m->get("http://localhost/yak"); ok(!$m->success, 'Not ok, user unable to be resotred == nasal demons'); foreach my $type (qw/ goat fluffy_bunny possum butterfly /) { $m->get_ok("http://localhost/$type", "get $type ok"); } done_testing; Catalyst-Plugin-Authentication-0.10023/t/store_nopassord.t000644 000765 000024 00000000267 12073067276 023412 0ustar00t0mstaff000000 000000 use strict; use warnings; use Test::More tests => 1; use_ok 'Catalyst::Authentication::Credential::NoPassword', "Catalyst::Authentication::Credential::NoPassword at right spot"; Catalyst-Plugin-Authentication-0.10023/t/lib/AuthRealmTestApp/000755 000765 000024 00000000000 12131606106 023707 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/t/lib/AuthRealmTestApp.pm000644 000765 000024 00000002112 11641336536 024255 0ustar00t0mstaff000000 000000 package AuthRealmTestApp; use warnings; use strict; use Catalyst qw/ Authentication Authentication::Store::Minimal /; use Test::More; use Test::Exception; our $members = { bob => { password => "s00p3r" }, william => { password => "s3cr3t" } }; our $admins = { joe => { password => "31337" } }; __PACKAGE__->config('Plugin::Authentication' => { default_realm => 'members', realms => { members => { credential => { class => 'Password', password_field => 'password', password_type => 'clear' }, store => { class => 'Minimal', users => $members } }, admins => { credential => { class => 'Password', password_field => 'password', password_type => 'clear' }, store => { class => 'Minimal', users => $admins } } } }); __PACKAGE__->setup; 1; Catalyst-Plugin-Authentication-0.10023/t/lib/AuthRealmTestAppCompat/000755 000765 000024 00000000000 12131606106 025053 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/t/lib/AuthRealmTestAppCompat.pm000644 000765 000024 00000001662 11641336536 025432 0ustar00t0mstaff000000 000000 package AuthRealmTestAppCompat; use warnings; use strict; use base qw/Catalyst/; ### using A::Store::minimal with new style realms ### makes the app blow up, since c::p::a::s::minimal ### isa c:a::s::minimal, and it's compat setup() gets ### run, with an unexpected config has (realms on top, ### not users). This tests makes sure the app no longer ### blows up when this happens. use Catalyst qw/ Authentication Authentication::Store::Minimal /; our $members = { bob => { password => "s00p3r" }, }; __PACKAGE__->config('Plugin::Authentication' => { default_realm => 'members', members => { credential => { class => 'Password', password_field => 'password', password_type => 'clear' }, store => { class => 'Minimal', users => $members, } }, }); __PACKAGE__->setup; 1; Catalyst-Plugin-Authentication-0.10023/t/lib/AuthRealmTestAppProgressive/000755 000765 000024 00000000000 12131606106 026140 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/t/lib/AuthRealmTestAppProgressive.pm000644 000765 000024 00000002537 11743264211 026512 0ustar00t0mstaff000000 000000 package AuthRealmTestAppProgressive; use warnings; use strict; use base qw/Catalyst/; ### using A::Store::minimal with new style realms ### makes the app blow up, since c::p::a::s::minimal ### isa c:a::s::minimal, and it's compat setup() gets ### run, with an unexpected config has (realms on top, ### not users). This tests makes sure the app no longer ### blows up when this happens. use Catalyst qw/ Authentication Authentication::Store::Minimal /; our %members = ( 'members' => { bob => { password => "s00p3r" } }, 'other' => { sally => { password => "s00p3r" } }, ); __PACKAGE__->config('Plugin::Authentication' => { default_realm => 'progressive', progressive => { class => 'Progressive', realms => [ 'other', 'members' ], }, other => { credential => { class => 'Password', password_field => 'password', password_type => 'clear' }, store => { class => 'Minimal', users => $members{other}, } }, members => { credential => { class => 'Password', password_field => 'password', password_type => 'clear' }, store => { class => 'Minimal', users => $members{members}, } }, }); __PACKAGE__->setup; 1; Catalyst-Plugin-Authentication-0.10023/t/lib/AuthSessionTestApp/000755 000765 000024 00000000000 12131606106 024272 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/t/lib/AuthSessionTestApp.pm000644 000765 000024 00000001226 11641336536 024645 0ustar00t0mstaff000000 000000 package User::SessionRestoring; use base qw/Catalyst::Authentication::User::Hash/; sub for_session { $_[0]->id } sub store { $_[0]->{store} } package AuthSessionTestApp; use strict; use warnings; use base qw/Catalyst/; use Catalyst qw/ Session Session::Store::Dummy Session::State::Cookie Authentication Authentication::Store::Minimal Authentication::Credential::Password /; our $users = { foo => User::SessionRestoring->new( id => 'foo', password => "s3cr3t", ), }; __PACKAGE__->config(authentication => {users => $users}); __PACKAGE__->setup; $users->{foo}{store} = __PACKAGE__->default_auth_store; 1; Catalyst-Plugin-Authentication-0.10023/t/lib/AuthTestApp/000755 000765 000024 00000000000 12131606106 022726 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/t/lib/AuthTestApp.pm000644 000765 000024 00000001451 11641336536 023301 0ustar00t0mstaff000000 000000 package AuthTestApp; use strict; use warnings; use base qw/Catalyst/; use Catalyst qw/ Authentication Authentication::Store::Minimal Authentication::Credential::Password /; use Digest::MD5 qw/md5/; use Digest::SHA1 qw/sha1_base64/; our $users = { foo => { password => "s3cr3t", }, bar => { crypted_password => crypt("s3cr3t", "x8"), }, gorch => { hashed_password => md5("s3cr3t"), hash_algorithm => "MD5", }, shabaz => { hashed_password => sha1_base64("s3cr3t"), hash_algorithm => "SHA-1" }, sadeek => { hashed_password => sha1_base64("s3cr3t").'=', hash_algorithm => "SHA-1" }, baz => {}, }; __PACKAGE__->config('Plugin::Authentication' =>{users => $users}); __PACKAGE__->setup; 1; Catalyst-Plugin-Authentication-0.10023/t/lib/RemoteTestApp1/000755 000765 000024 00000000000 12131606106 023341 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/t/lib/RemoteTestApp1.pm000644 000765 000024 00000001541 11743734753 023722 0ustar00t0mstaff000000 000000 package RemoteTestApp1; use strict; use warnings; use Catalyst qw/ Authentication /; use base qw/Catalyst/; unless ($Catalyst::VERSION >= 5.89000) { __PACKAGE__->engine_class('RemoteTestEngine'); } __PACKAGE__->config( 'Plugin::Authentication' => { default_realm => 'remote', realms => { remote => { credential => { class => 'Remote', allow_regexp => '^(bob|john|CN=.*)$', deny_regexp=> 'denied', cutname_regexp=> 'CN=(.*)/OU=Test', }, store => { class => 'Null', }, }, }, }, ); __PACKAGE__->setup; if ($Catalyst::VERSION >= 5.89000) { require RemoteTestEngineRole; RemoteTestEngineRole->meta->apply(__PACKAGE__->engine); } 1; Catalyst-Plugin-Authentication-0.10023/t/lib/RemoteTestApp2/000755 000765 000024 00000000000 12131606106 023342 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/t/lib/RemoteTestApp2.pm000644 000765 000024 00000001711 11743734753 023722 0ustar00t0mstaff000000 000000 package RemoteTestApp2; use strict; use warnings; use Catalyst qw/ Authentication /; use base qw/Catalyst/; unless ($Catalyst::VERSION >= 5.89000) { __PACKAGE__->engine_class('RemoteTestEngine'); } __PACKAGE__->config( 'Plugin::Authentication' => { default_realm => 'remote', realms => { remote => { credential => { class => 'Remote', allow_regexp => '^(bob|john|CN=.*)$', deny_regexp=> 'denied', cutname_regexp=> 'CN=(.*)/OU=Test', source => 'SSL_CLIENT_S_DN', username_field => 'my_user_name', }, store => { class => 'Null', }, }, }, }, ); __PACKAGE__->setup; if ($Catalyst::VERSION >= 5.89000) { require RemoteTestEngineRole; RemoteTestEngineRole->meta->apply(__PACKAGE__->engine); } 1; Catalyst-Plugin-Authentication-0.10023/t/lib/RemoteTestEngine.pm000644 000765 000024 00000001051 11641336536 024314 0ustar00t0mstaff000000 000000 package RemoteTestEngine; BEGIN { require Catalyst; if ($Catalyst::VERSION >= 5.89000) { require Catalyst::Engine; @ISA = qw(Catalyst::Engine); } else { require Catalyst::Engine::CGI; @ISA = qw(Catalyst::Engine::CGI); } } our $REMOTE_USER; our $SSL_CLIENT_S_DN; sub env { my $self = shift; my %e; if ($Catalyst::VERSION >= 5.89000) { %e = %{ $self->SUPER::env() }; } else { %e = %ENV; } $e{REMOTE_USER} = $REMOTE_USER; $e{SSL_CLIENT_S_DN} = $SSL_CLIENT_S_DN; return \%e; }; 1; Catalyst-Plugin-Authentication-0.10023/t/lib/RemoteTestEngineRole.pm000644 000765 000024 00000000452 11743734753 025150 0ustar00t0mstaff000000 000000 package RemoteTestEngineRole; use Moose::Role; require Catalyst; around env => sub { my ($orig, $self, @args) = @_; my $e = $self->$orig(@args); $e->{REMOTE_USER} = $RemoteTestEngine::REMOTE_USER; $e->{SSL_CLIENT_S_DN} = $RemoteTestEngine::SSL_CLIENT_S_DN; return $e; }; 1; Catalyst-Plugin-Authentication-0.10023/t/lib/RemoteTestApp2/Controller/000755 000765 000024 00000000000 12131606106 025465 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/t/lib/RemoteTestApp2/Controller/Root.pm000644 000765 000024 00000000754 11641336536 026770 0ustar00t0mstaff000000 000000 package RemoteTestApp2::Controller::Root; use strict; use warnings; use base 'Catalyst::Controller'; __PACKAGE__->config(namespace => ''); sub default : Local { my ( $self, $c ) = @_; if ($c->authenticate()) { $c->res->body( 'my_user_name:' . $c->user->{my_user_name} ); } else { $c->res->body('FAIL'); $c->res->status(403); } } sub public : Local { my ( $self, $c ) = @_; $c->res->body('OK'); } 1; Catalyst-Plugin-Authentication-0.10023/t/lib/RemoteTestApp1/Controller/000755 000765 000024 00000000000 12131606106 025464 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/t/lib/RemoteTestApp1/Controller/Root.pm000644 000765 000024 00000000674 11641336536 026770 0ustar00t0mstaff000000 000000 package RemoteTestApp1::Controller::Root; use strict; use warnings; use base qw/Catalyst::Controller/; __PACKAGE__->config(namespace => ''); sub default : Local { my ( $self, $c ) = @_; if ($c->authenticate()) { $c->res->body('User:' . $c->user->{username}); } else { $c->res->body('FAIL'); $c->res->status(403); } } sub public : Local { my ( $self, $c ) = @_; $c->res->body('OK'); } 1; Catalyst-Plugin-Authentication-0.10023/t/lib/AuthTestApp/Controller/000755 000765 000024 00000000000 12131606106 025051 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/t/lib/AuthTestApp/Controller/Root.pm000644 000765 000024 00000003366 11641336536 026356 0ustar00t0mstaff000000 000000 package AuthTestApp::Controller::Root; use strict; use warnings; use base qw/ Catalyst::Controller /; __PACKAGE__->config( namespace => '' ); use Test::More; use Test::Exception; use Digest::MD5 qw/md5/; use Digest::SHA1 qw/sha1_base64/; sub number_of_elements { return scalar @_ } sub moose : Local { my ( $self, $c ) = @_; is(number_of_elements($c->user), 1, "Array undef"); is($c->user, undef, "no user, returns undef"); ok(!$c->user, "no user"); ok($c->login( "foo", "s3cr3t" ), "can login with clear"); is( $c->user, $AuthTestApp::users->{foo}, "user object is in proper place"); ok( !$c->user->roles, "no roles for foo" ); my @new = qw/foo bar gorch/; $c->user->roles( @new ); is_deeply( [ $c->user->roles ], \@new, "roles set as array"); $c->logout; ok(!$c->user, "no more user, after logout"); ok($c->login( "bar", "s3cr3t" ), "can login with crypted"); is( $c->user, $AuthTestApp::users->{bar}, "user object is in proper place"); $c->logout; ok($c->login("gorch", "s3cr3t"), "can login with hashed"); is( $c->user, $AuthTestApp::users->{gorch}, "user object is in proper place"); $c->logout; ok($c->login("shabaz", "s3cr3t"), "can login with base64 hashed"); is( $c->user, $AuthTestApp::users->{shabaz}, "user object is in proper place"); $c->logout; ok($c->login("sadeek", "s3cr3t"), "can login with padded base64 hashed"); is( $c->user, $AuthTestApp::users->{sadeek}, "user object is in proper place"); $c->logout; ok(!$c->login( "bar", "bad pass" ), "can't login with bad password"); ok(!$c->user, "no user"); throws_ok { $c->login( "baz", "foo" ) } qr/support.*mechanism/, "can't login without any supported mech"; $c->res->body( "ok" ); } Catalyst-Plugin-Authentication-0.10023/t/lib/AuthSessionTestApp/Controller/000755 000765 000024 00000000000 12131606106 026415 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/t/lib/AuthSessionTestApp/Controller/Root.pm000644 000765 000024 00000004104 11641336536 027711 0ustar00t0mstaff000000 000000 package AuthSessionTestApp::Controller::Root; use strict; use warnings; use base qw/Catalyst::Controller/; __PACKAGE__->config(namespace => ''); use Test::More; use Test::Exception; use Digest::MD5 qw/md5/; sub moose : Local { my ( $self, $c ) = @_; ok(!$c->sessionid, "no session id yet"); ok(!$c->user_exists, "no user exists"); ok(!$c->user, "no user yet"); ok($c->login( "foo", "s3cr3t" ), "can login with clear"); is( $c->user, $AuthSessionTestApp::users->{foo}, "user object is in proper place"); } sub elk : Local { my ( $self, $c ) = @_; ok( $c->sessionid, "session ID was restored" ); ok( $c->user_exists, "user exists" ); ok( $c->user, "a user was also restored"); is_deeply( $c->user, $AuthSessionTestApp::users->{foo}, "restored user is the right one (deep test - store might change identity)" ); # Rename the user! $AuthSessionTestApp::users->{bar} = delete $AuthSessionTestApp::users->{foo}; } sub yak : Local { my ( $self, $c ) = @_; ok( $c->sessionid, "session ID was restored after user renamed" ); ok( $c->user_exists, "user appears to exist" ); ok( !$c->user, "user was not restored"); ok(scalar(@{ $c->error }), 'Error recorded'); ok( !$c->user_exists, "user no longer appears to exist" ); } sub goat : Local { my ( $self, $c ) = @_; ok($c->login( "bar", "s3cr3t" ), "can login with clear (new username)"); is( $c->user, $AuthSessionTestApp::users->{bar}, "user object is in proper place"); $c->logout; } sub fluffy_bunny : Local { my ( $self, $c ) = @_; ok( $c->session_is_valid, "session ID is restored after logout"); ok( !$c->user, "no user was restored after logout"); $c->delete_session("bah"); } sub possum : Local { my ( $self, $c ) = @_; ok( !$c->session_is_valid, "no session ID was restored"); $c->session->{definitely_not_a_user} = "moose"; } sub butterfly : Local { my ( $self, $c ) = @_; ok( $c->session_is_valid, "valid session" ); ok( !$c->user_exists, "but no user exists" ); ok( !$c->user, "no user object either" ); } 1; Catalyst-Plugin-Authentication-0.10023/t/lib/AuthRealmTestAppProgressive/Controller/000755 000765 000024 00000000000 12131606106 030263 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/t/lib/AuthRealmTestAppProgressive/Controller/Root.pm000644 000765 000024 00000001437 11743264211 031556 0ustar00t0mstaff000000 000000 package AuthRealmTestAppProgressive::Controller::Root; use warnings; use strict; use base qw/Catalyst::Controller/; __PACKAGE__->config(namespace => ''); use Test::More; use Test::Exception; sub progressive : Local { my ( $self, $c ) = @_; foreach my $realm ( keys %AuthRealmTestAppProgressive::members ) { while ( my ( $user, $info ) = each %{$AuthRealmTestAppProgressive::members{$realm}} ) { my $ok = eval { $c->authenticate( { username => $user, password => $info->{password} }, ); }; ok( !$@, "authentication passed." ); ok( $ok, "user authenticated" ); ok( $c->user_in_realm($realm), "user in proper realm" ); } } $c->res->body( "ok" ); } 1; Catalyst-Plugin-Authentication-0.10023/t/lib/AuthRealmTestAppCompat/Controller/000755 000765 000024 00000000000 12131606106 027176 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/t/lib/AuthRealmTestAppCompat/Controller/Root.pm000644 000765 000024 00000001216 11641336536 030473 0ustar00t0mstaff000000 000000 package AuthRealmTestAppCompat::Controller::Root; use warnings; use strict; use base qw/Catalyst::Controller/; __PACKAGE__->config( namespace => '' ); use Test::More; use Test::Exception; sub moose : Local { my ( $self, $c ) = @_; while ( my ($user, $info) = each %$AuthRealmTestAppCompat::members ) { my $ok = eval { $c->authenticate( { username => $user, password => $info->{password} }, 'members' ), }; ok( !$@, "Test did not die: $@" ); ok( $ok, "user $user authentication" ); } $c->res->body( "ok" ); } 1; Catalyst-Plugin-Authentication-0.10023/t/lib/AuthRealmTestApp/Controller/000755 000765 000024 00000000000 12131606106 026032 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/t/lib/AuthRealmTestApp/Controller/Root.pm000644 000765 000024 00000003436 11641336536 027335 0ustar00t0mstaff000000 000000 package AuthRealmTestApp::Controller::Root; use warnings; use strict; use base qw/Catalyst::Controller/; __PACKAGE__->config(namespace => ''); use Test::More; use Test::Exception; sub moose : Local { my ( $self, $c ) = @_; ok(!$c->user, "no user"); while ( my ($user, $info) = each %$AuthRealmTestApp::members ) { ok( $c->authenticate( { username => $user, password => $info->{password} }, 'members' ), "user $user authentication" ); # check existing realms ok( $c->user_in_realm('members'), "user in members realm"); ok(!$c->user_in_realm('admins'), "user not in admins realm"); # check an invalid realm ok(!$c->user_in_realm('foobar'), "user not in foobar realm"); # check if we've got the right user is( $c->user, $info, "user object is in proper place"); $c->logout; # sanity check ok(!$c->user, "no more user after logout"); } while ( my ($user, $info) = each %$AuthRealmTestApp::admins ) { ok( $c->authenticate( { username => $user, password => $info->{password} }, 'admins' ), "user $user authentication" ); # check existing realms ok(!$c->user_in_realm('members'), "user not in members realm"); ok( $c->user_in_realm('admins'), "user in admins realm"); # check an invalid realm ok(!$c->user_in_realm('foobar'), "user not in foobar realm"); # check if we've got the right user is( $c->user, $info, "user object is in proper place"); $c->logout; # sanity check ok(!$c->user, "no more user after logout"); } $c->res->body( "ok" ); } 1; Catalyst-Plugin-Authentication-0.10023/t/author/eol.t000644 000765 000024 00000000312 11773550547 022242 0ustar00t0mstaff000000 000000 #!/usr/bin/env perl use Test::More; eval {require Test::EOL; }; if ($@) { plan skip_all => 'Need Test::EOL installed for line ending tests'; exit 0; } Test::EOL->import; all_perl_files_ok(); Catalyst-Plugin-Authentication-0.10023/t/author/notabs.t000644 000765 000024 00000000173 11773550460 022750 0ustar00t0mstaff000000 000000 use strict; use warnings; use File::Spec; use FindBin (); use Test::More; use Test::NoTabs; all_perl_files_ok(qw/lib/); Catalyst-Plugin-Authentication-0.10023/t/author/pod.t000644 000765 000024 00000000072 11751225134 022233 0ustar00t0mstaff000000 000000 use Test::More; use Test::Pod 1.14; all_pod_files_ok(); Catalyst-Plugin-Authentication-0.10023/t/author/pod_coverage.t000644 000765 000024 00000000107 11751225134 024105 0ustar00t0mstaff000000 000000 use Test::More; use Test::Pod::Coverage 1.04; all_pod_coverage_ok(); Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/000755 000765 000024 00000000000 12131606106 022045 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Authentication/000755 000765 000024 00000000000 12131606106 025024 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Plugin/000755 000765 000024 00000000000 12131606106 023303 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Plugin/Authentication/000755 000765 000024 00000000000 12131606106 026262 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Plugin/Authentication.pm000644 000765 000024 00000114174 12131606023 026626 0ustar00t0mstaff000000 000000 package Catalyst::Plugin::Authentication; use Moose; use namespace::clean -except => 'meta'; use MRO::Compat; use Tie::RefHash; use Class::Inspector; use Catalyst::Authentication::Realm; with 'MooseX::Emulate::Class::Accessor::Fast'; __PACKAGE__->mk_accessors(qw/_user/); our $VERSION = "0.10023"; sub set_authenticated { my ( $c, $user, $realmname ) = @_; $c->user($user); $c->request->{user} = $user; # compatibility kludge if (!$realmname) { $realmname = 'default'; } my $realm = $c->get_auth_realm($realmname); if (!$realm) { Catalyst::Exception->throw( "set_authenticated called with nonexistant realm: '$realmname'."); } $user->auth_realm($realm->name); $c->persist_user(); $c->maybe::next::method($user, $realmname); } sub user { my $c = shift; if (@_) { return $c->_user(@_); } if ( defined($c->_user) ) { return $c->_user; } else { return $c->auth_restore_user; } } # change this to allow specification of a realm - to verify the user is part of that realm # in addition to verifying that they exist. sub user_exists { my $c = shift; return defined($c->_user) || defined($c->find_realm_for_persisted_user); } # works like user_exists - except only returns true if user # exists AND is in the realm requested. sub user_in_realm { my ($c, $realmname) = @_; if (defined($c->_user)) { return ($c->_user->auth_realm eq $realmname); } else { my $realm = $c->find_realm_for_persisted_user; if ($realm) { return ($realm->name eq $realmname); } else { return undef; } } } sub __old_save_user_in_session { my ( $c, $user, $realmname ) = @_; $c->session->{__user_realm} = $realmname; # we want to ask the store for a user prepared for the session. # but older modules split this functionality between the user and the # store. We try the store first. If not, we use the old method. my $realm = $c->get_auth_realm($realmname); if ($realm->{'store'}->can('for_session')) { $c->session->{__user} = $realm->{'store'}->for_session($c, $user); } else { $c->session->{__user} = $user->for_session; } } sub persist_user { my $c = shift; if ($c->user_exists) { ## if we have a valid session handler - we store the ## realm in the session. If not - we have to hope that ## the realm can recognize its frozen user somehow. if ($c->can('session') && $c->config->{'Plugin::Authentication'}{'use_session'} && $c->session_is_valid) { $c->session->{'__user_realm'} = $c->_user->auth_realm; } my $realm = $c->get_auth_realm($c->_user->auth_realm); # used to call $realm->save_user_in_session $realm->persist_user($c, $c->user); } } ## this was a short lived method to update user information - ## you should use persist_user instead. sub update_user_in_session { my $c = shift; return $c->persist_user; } sub logout { my $c = shift; $c->user(undef); my $realm = $c->find_realm_for_persisted_user; if ($realm) { $realm->remove_persisted_user($c); } $c->maybe::next::method(@_); } sub find_user { my ( $c, $userinfo, $realmname ) = @_; $realmname ||= 'default'; my $realm = $c->get_auth_realm($realmname); if (!$realm) { Catalyst::Exception->throw( "find_user called with nonexistant realm: '$realmname'."); } return $realm->find_user($userinfo, $c); } ## Consider making this a public method. - would make certain things easier when ## dealing with things pre-auth restore. sub find_realm_for_persisted_user { my $c = shift; my $realm; if ($c->can('session') and $c->config->{'Plugin::Authentication'}{'use_session'} and $c->session_is_valid and exists($c->session->{'__user_realm'})) { $realm = $c->auth_realms->{$c->session->{'__user_realm'}}; if ($realm->user_is_restorable($c)) { return $realm; } } else { ## we have no choice but to ask each realm whether it has a persisted user. foreach my $realmname (@{$c->_auth_realm_restore_order}) { my $realm = $c->auth_realms->{$realmname} || Catalyst::Exception->throw("Could not find authentication realm '$realmname'"); return $realm if $realm->user_is_restorable($c); } } return undef; } sub auth_restore_user { my ( $c, $frozen_user, $realmname ) = @_; my $realm; if (defined($realmname)) { $realm = $c->get_auth_realm($realmname); } else { $realm = $c->find_realm_for_persisted_user; } return undef unless $realm; # FIXME die unless? This is an internal inconsistency $c->_user( my $user = $realm->restore_user( $c, $frozen_user ) ); # this sets the realm the user originated in. $user->auth_realm($realm->name) if $user; return $user; } # we can't actually do our setup in setup because the model has not yet been loaded. # So we have to trigger off of setup_finished. :-( sub setup { my $app = shift; $app->_authentication_initialize(); $app->next::method(@_); } ## the actual initialization routine. whee. sub _authentication_initialize { my $app = shift; ## let's avoid recreating / configuring everything if we have already done it, eh? if ($app->can('_auth_realms')) { return }; ## make classdata where it is used. $app->mk_classdata( '_auth_realms' => {}); ## the order to attempt restore in - If we don't have session - we have ## no way to be sure where a frozen user came from - so we have to ## ask each realm if it can restore the user. Unfortunately it is possible ## that multiple realms could restore the user from the data we have - ## So we have to determine at setup time what order to ask the realms in. ## The default is to use the user_restore_priority values defined in the realm ## config. if they are not defined - we go by alphabetical order. Note that ## the 'default' realm always gets first chance at it unless it is explicitly ## placed elsewhere by user_restore_priority. Remember this only comes ## into play if session is disabled. $app->mk_classdata( '_auth_realm_restore_order' => []); my $cfg = $app->config->{'Plugin::Authentication'}; my $realmshash; if (!defined($cfg)) { if (exists($app->config->{'authentication'})) { $cfg = $app->config->{'authentication'}; $app->config->{'Plugin::Authentication'} = $app->config->{'authentication'}; } else { $cfg = {}; } } else { # the realmshash contains the various configured realms. By default this is # the main $app->config->{'Plugin::Authentication'} hash - but if that is # not defined, or there is a subkey {'realms'} then we use that. $realmshash = $cfg; } ## If we have a sub-key of {'realms'} then we use that for realm configuration if (exists($cfg->{'realms'})) { $realmshash = $cfg->{'realms'}; } # old default was to force use_session on. This must remain for that # reason - but if use_session is already in the config, we respect its setting. if (!exists($cfg->{'use_session'})) { $cfg->{'use_session'} = 1; } ## if we have a realms hash if (ref($realmshash) eq 'HASH') { my %auth_restore_order; my $authcount = 2; my $defaultrealm = 'default'; foreach my $realm (sort keys %{$realmshash}) { if (ref($realmshash->{$realm}) eq 'HASH' && (exists($realmshash->{$realm}{credential}) || exists($realmshash->{$realm}{class}))) { $app->setup_auth_realm($realm, $realmshash->{$realm}); if (exists($realmshash->{$realm}{'user_restore_priority'})) { $auth_restore_order{$realm} = $realmshash->{$realm}{'user_restore_priority'}; } else { $auth_restore_order{$realm} = $authcount++; } } } # if we have a 'default_realm' in the config hash and we don't already # have a realm called 'default', we point default at the realm specified if (exists($cfg->{'default_realm'}) && !$app->get_auth_realm('default')) { if ($app->_set_default_auth_realm($cfg->{'default_realm'})) { $defaultrealm = $cfg->{'default_realm'}; $auth_restore_order{'default'} = $auth_restore_order{$cfg->{'default_realm'}}; delete($auth_restore_order{$cfg->{'default_realm'}}); } } ## if the default realm did not have a defined priority in its config - we put it at the front. if (!exists($realmshash->{$defaultrealm}{'user_restore_priority'})) { $auth_restore_order{'default'} = 1; } @{$app->_auth_realm_restore_order} = sort { $auth_restore_order{$a} <=> $auth_restore_order{$b} } keys %auth_restore_order; } else { ## BACKWARDS COMPATIBILITY - if realms is not defined - then we are probably dealing ## with an old-school config. The only caveat here is that we must add a classname ## also - we have to treat {store} as {stores}{default} - because ## while it is not a clear as a valid config in the docs, it ## is functional with the old api. Whee! if (exists($cfg->{'store'}) && !exists($cfg->{'stores'}{'default'})) { $cfg->{'stores'}{'default'} = $cfg->{'store'}; } push @{$app->_auth_realm_restore_order}, 'default'; foreach my $storename (keys %{$cfg->{'stores'}}) { my $realmcfg = { store => { class => $cfg->{'stores'}{$storename} }, }; $app->setup_auth_realm($storename, $realmcfg); } } } # set up realmname. sub setup_auth_realm { my ($app, $realmname, $config) = @_; my $realmclass = $config->{class}; if( !$realmclass ) { $realmclass = 'Catalyst::Authentication::Realm'; } elsif ($realmclass !~ /^\+(.*)$/ ) { $realmclass = "Catalyst::Authentication::Realm::${realmclass}"; } else { $realmclass = $1; } Catalyst::Utils::ensure_class_loaded( $realmclass ); my $realm = $realmclass->new($realmname, $config, $app); if ($realm) { $app->auth_realms->{$realmname} = $realm; } else { $app->log->debug("realm initialization for '$realmname' failed."); } return $realm; } sub auth_realms { my $self = shift; $self->_authentication_initialize(); # Ensure _auth_realms created! return($self->_auth_realms); } sub get_auth_realm { my ($app, $realmname) = @_; return $app->auth_realms->{$realmname}; } # Very internal method. Vital Valuable Urgent, Do not touch on pain of death. # Using this method just assigns the default realm to be the value associated # with the realmname provided. It WILL overwrite any real realm called 'default' # so can be very confusing if used improperly. It's used properly already. # Translation: don't use it. sub _set_default_auth_realm { my ($app, $realmname) = @_; if (exists($app->auth_realms->{$realmname})) { $app->auth_realms->{'default'} = $app->auth_realms->{$realmname}; } return $app->get_auth_realm('default'); } sub authenticate { my ($app, $userinfo, $realmname) = @_; if (!$realmname) { $realmname = 'default'; } my $realm = $app->get_auth_realm($realmname); ## note to self - make authenticate throw an exception if realm is invalid. if ($realm) { return $realm->authenticate($app, $userinfo); } else { Catalyst::Exception->throw( "authenticate called with nonexistant realm: '$realmname'."); } return undef; } ## BACKWARDS COMPATIBILITY -- Warning: Here be monsters! # # What follows are backwards compatibility routines - for use with Stores and Credentials # that have not been updated to work with C::P::Authentication v0.10. # These are here so as to not break people's existing installations, but will go away # in a future version. # # The old style of configuration only supports a single store, as each store module # sets itself as the default store upon being loaded. This is the only supported # 'compatibility' mode. # sub get_user { my ( $c, $uid, @rest ) = @_; return $c->find_user( {'id' => $uid, 'rest'=>\@rest }, 'default' ); } ## this should only be called when using old-style authentication plugins. IF this gets ## called in a new-style config - it will OVERWRITE the store of your default realm. Don't do it. ## also - this is a partial setup - because no credential is instantiated... in other words it ONLY ## works with old-style auth plugins and C::P::Authentication in compatibility mode. Trying to combine ## this with a realm-type config will probably crash your app. sub default_auth_store { my $self = shift; my $realm = $self->get_auth_realm('default'); if (!$realm) { $realm = $self->setup_auth_realm('default', { class => 'Compatibility' }); } if ( my $new = shift ) { $realm->store($new); my $storeclass; if (ref($new)) { $storeclass = ref($new); } else { $storeclass = $new; } # BACKWARDS COMPATIBILITY - if the store class does not define find_user, we define it in terms # of get_user and add it to the class. this is because the auth routines use find_user, # and rely on it being present. (this avoids per-call checks) if (!$storeclass->can('find_user')) { no strict 'refs'; *{"${storeclass}::find_user"} = sub { my ($self, $info) = @_; my @rest = @{$info->{rest}} if exists($info->{rest}); $self->get_user($info->{id}, @rest); }; } } return $self->get_auth_realm('default')->store; } ## BACKWARDS COMPATIBILITY ## this only ever returns a hash containing 'default' - as that is the only ## supported mode of calling this. sub auth_store_names { my $self = shift; my %hash = ( $self->get_auth_realm('default')->store => 'default' ); } sub get_auth_store { my ( $self, $name ) = @_; if ($name ne 'default') { Carp::croak "get_auth_store called on non-default realm '$name'. Only default supported in compatibility mode"; } else { $self->default_auth_store(); } } sub get_auth_store_name { my ( $self, $store ) = @_; return 'default'; } # sub auth_stores is only used internally - here for completeness sub auth_stores { my $self = shift; my %hash = ( 'default' => $self->get_auth_realm('default')->store); } __PACKAGE__->meta->make_immutable; __PACKAGE__; __END__ =pod =head1 NAME Catalyst::Plugin::Authentication - Infrastructure plugin for the Catalyst authentication framework. =head1 SYNOPSIS use Catalyst qw/ Authentication /; # later on ... $c->authenticate({ username => 'myusername', password => 'mypassword' }); my $age = $c->user->get('age'); $c->logout; =head1 DESCRIPTION The authentication plugin provides generic user support for Catalyst apps. It is the basis for both authentication (checking the user is who they claim to be), and authorization (allowing the user to do what the system authorises them to do). Using authentication is split into two parts. A Store is used to actually store the user information, and can store any amount of data related to the user. Credentials are used to verify users, using information from the store, given data from the frontend. A Credential and a Store are paired to form a 'Realm'. A Catalyst application using the authentication framework must have at least one realm, and may have several. To implement authentication in a Catalyst application you need to add this module, and specify at least one realm in the configuration. Authentication data can also be stored in a session, if the application is using the L module. B in version 0.10 of this module, the interface to this module changed. Please see L for more information. =head1 INTRODUCTION =head2 The Authentication/Authorization Process Web applications typically need to identify a user - to tell the user apart from other users. This is usually done in order to display private information that is only that user's business, or to limit access to the application so that only certain entities can access certain parts. This process is split up into several steps. First you ask the user to identify themselves. At this point you can't be sure that the user is really who they claim to be. Then the user tells you who they are, and backs this claim with some piece of information that only the real user could give you. For example, a password is a secret that is known to both the user and you. When the user tells you this password you can assume they're in on the secret and can be trusted (ignore identity theft for now). Checking the password, or any other proof is called B. By this time you know exactly who the user is - the user's identity is B. This is where this module's job stops, and your application or other plugins step in. The next logical step is B, the process of deciding what a user is (or isn't) allowed to do. For example, say your users are split into two main groups - regular users and administrators. You want to verify that the currently logged in user is indeed an administrator before performing the actions in an administrative part of your application. These decisions may be made within your application code using just the information available after authentication, or it may be facilitated by a number of plugins. =head2 The Components In This Framework =head3 Realms Configuration of the Catalyst::Plugin::Authentication framework is done in terms of realms. In simplest terms, a realm is a pairing of a Credential verifier and a User storage (Store) backend. As of version 0.10003, realms are now objects that you can create and customize. An application can have any number of Realms, each of which operates independent of the others. Each realm has a name, which is used to identify it as the target of an authentication request. This name can be anything, such as 'users' or 'members'. One realm must be defined as the default_realm, which is used when no realm name is specified. More information about configuring realms is available in the configuration section. =head3 Credential Verifiers When user input is transferred to the L application (typically via form inputs) the application may pass this information into the authentication system through the C<< $c->authenticate() >> method. From there, it is passed to the appropriate Credential verifier. These plugins check the data, and ensure that it really proves the user is who they claim to be. Credential verifiers compatible with versions of this module 0.10x and upwards should be in the namespace C. =head3 Storage Backends The authentication data also identifies a user, and the Storage backend modules use this data to locate and return a standardized object-oriented representation of a user. When a user is retrieved from a store it is not necessarily authenticated. Credential verifiers accept a set of authentication data and use this information to retrieve the user from the store they are paired with. Storage backends compatible with versions of this module 0.10x and upwards should be in the namespace C. =head3 The Core Plugin This plugin on its own is the glue, providing realm configuration, session integration, and other goodness for the other plugins. =head3 Other Plugins More layers of plugins can be stacked on top of the authentication code. For example, L provides an abstraction of browser sessions that is more persistent per user. L provides an accepted way to separate and group users into categories, and then check which categories the current user belongs to. =head1 EXAMPLE Let's say we were storing users in a simple Perl hash. Users are verified by supplying a password which is matched within the hash. This means that our application will begin like this: package MyApp; use Catalyst qw/ Authentication /; __PACKAGE__->config( 'Plugin::Authentication' => { default => { credential => { class => 'Password', password_field => 'password', password_type => 'clear' }, store => { class => 'Minimal', users => { bob => { password => "s00p3r", editor => 'yes', roles => [qw/edit delete/], }, william => { password => "s3cr3t", roles => [qw/comment/], } } } } } ); This tells the authentication plugin what realms are available, which credential and store modules are used, and the configuration of each. With this code loaded, we can now attempt to authenticate users. To show an example of this, let's create an authentication controller: package MyApp::Controller::Auth; sub login : Local { my ( $self, $c ) = @_; if ( my $user = $c->req->params->{user} and my $password = $c->req->params->{password} ) { if ( $c->authenticate( { username => $user, password => $password } ) ) { $c->res->body( "hello " . $c->user->get("name") ); } else { # login incorrect } } else { # invalid form input } } This code should be self-explanatory. If all the necessary fields are supplied, call the C method on the context object. If it succeeds the user is logged in. The credential verifier will attempt to retrieve the user whose details match the authentication information provided to C<< $c->authenticate() >>. Once it fetches the user the password is checked and if it matches the user will be B and C<< $c->user >> will contain the user object retrieved from the store. In the above case, the default realm is checked, but we could just as easily check an alternate realm. If this were an admin login, for example, we could authenticate on the admin realm by simply changing the C<< $c->authenticate() >> call: if ( $c->authenticate( { username => $user, password => $password }, 'admin' ) ) { $c->res->body( "hello " . $c->user->get("name") ); } ... Now suppose we want to restrict the ability to edit to a user with an 'editor' value of yes. The restricted action might look like this: sub edit : Local { my ( $self, $c ) = @_; $c->detach("unauthorized") unless $c->user_exists and $c->user->get('editor') eq 'yes'; # do something restricted here } (Note that if you have multiple realms, you can use C<< $c->user_in_realm('realmname') >> in place of C<< $c->user_exists(); >> This will essentially perform the same verification as user_exists, with the added requirement that if there is a user, it must have come from the realm specified.) The above example is somewhat similar to role based access control. L treats the roles field as an array of role names. Let's leverage this. Add the role authorization plugin: use Catalyst qw/ ... Authorization::Roles /; sub edit : Local { my ( $self, $c ) = @_; $c->detach("unauthorized") unless $c->check_user_roles("edit"); # do something restricted here } This is somewhat simpler and will work if you change your store, too, since the role interface is consistent. Let's say your app grows, and you now have 10,000 users. It's no longer efficient to maintain a hash of users, so you move this data to a database. You can accomplish this simply by installing the L Store and changing your config: __PACKAGE__->config( 'Plugin::Authentication' => { default_realm => 'members', members => { credential => { class => 'Password', password_field => 'password', password_type => 'clear' }, store => { class => 'DBIx::Class', user_model => 'MyApp::Users', role_column => 'roles', } } } ); The authentication system works behind the scenes to load your data from the new source. The rest of your application is completely unchanged. =head1 CONFIGURATION # example __PACKAGE__->config( 'Plugin::Authentication' => { default_realm => 'members', members => { credential => { class => 'Password', password_field => 'password', password_type => 'clear' }, store => { class => 'DBIx::Class', user_model => 'MyApp::Users', role_column => 'roles', } }, admins => { credential => { class => 'Password', password_field => 'password', password_type => 'clear' }, store => { class => '+MyApp::Authentication::Store::NetAuth', authserver => '192.168.10.17' } } } ); NOTE: Until version 0.10008 of this module, you would need to put all the realms inside a "realms" key in the configuration. Please see L for more information =over 4 =item use_session Whether or not to store the user's logged in state in the session, if the application is also using L. This value is set to true per default. However, even if use_session is disabled, if any code touches $c->session, a session object will be auto-vivified and session Cookies will be sent in the headers. To prevent accidental session creation, check if a session already exists with if ($c->sessionid) { ... }. If the session doesn't exist, then don't place anything in the session to prevent an unecessary session from being created. =item default_realm This defines which realm should be used as when no realm is provided to methods that require a realm such as authenticate or find_user. =item realm refs The Plugin::Authentication config hash contains the series of realm configurations you want to use for your app. The only rule here is that there must be at least one. A realm consists of a name, which is used to reference the realm, a credential and a store. You may also put your realm configurations within a subelement called 'realms' if you desire to separate them from the remainder of your configuration. Note that if you use a 'realms' subelement, you must put ALL of your realms within it. You can also specify a realm class to instantiate instead of the default L class using the 'class' element within the realm config. Each realm config contains two hashes, one called 'credential' and one called 'store', each of which provide configuration details to the respective modules. The contents of these hashes is specific to the module being used, with the exception of the 'class' element, which tells the core Authentication module the classname to instantiate. The 'class' element follows the standard Catalyst mechanism of class specification. If a class is prefixed with a +, it is assumed to be a complete class name. Otherwise it is considered to be a portion of the class name. For credentials, the classname 'B', for example, is expanded to Catalyst::Authentication::Credential::B. For stores, the classname 'B' is expanded to: Catalyst::Authentication::Store::B. =back =head1 METHODS =head2 $c->authenticate( $userinfo [, $realm ]) Attempts to authenticate the user using the information in the $userinfo hash reference using the realm $realm. $realm may be omitted, in which case the default realm is checked. =head2 $c->user( ) Returns the currently logged in user, or undef if there is none. Normally the user is re-retrieved from the store. For L the user is re-restored using the primary key of the user table. Thus B can throw an error even though B returned true. =head2 $c->user_exists( ) Returns true if a user is logged in right now. The difference between B and B is that user_exists will return true if a user is logged in, even if it has not been yet retrieved from the storage backend. If you only need to know if the user is logged in, depending on the storage mechanism this can be much more efficient. B only looks into the session while B is trying to restore the user. =head2 $c->user_in_realm( $realm ) Works like user_exists, except that it only returns true if a user is both logged in right now and was retrieved from the realm provided. =head2 $c->logout( ) Logs the user out. Deletes the currently logged in user from C<< $c->user >> and the session. It does not delete the session. =head2 $c->find_user( $userinfo, $realm ) Fetch a particular users details, matching the provided user info, from the realm specified in $realm. $user = $c->find_user({ id => $id }); $c->set_authenticated($user); # logs the user in and calls persist_user =head2 persist_user() Under normal circumstances the user data is only saved to the session during initial authentication. This call causes the auth system to save the currently authenticated user's data across requests. Useful if you have changed the user data and want to ensure that future requests reflect the most current data. Assumes that at the time of this call, $c->user contains the most current data. =head2 find_realm_for_persisted_user() Private method, do not call from user code! =head1 INTERNAL METHODS These methods are for Catalyst::Plugin::Authentication B only. Please do not use them in your own code, whether application or credential / store modules. If you do, you will very likely get the nasty shock of having to fix / rewrite your code when things change. They are documented here only for reference. =head2 $c->set_authenticated( $user, $realmname ) Marks a user as authenticated. This is called from within the authenticate routine when a credential returns a user. $realmname defaults to 'default'. You can use find_user to get $user =head2 $c->auth_restore_user( $user, $realmname ) Used to restore a user from the session. In most cases this is called without arguments to restore the user via the session. Can be called with arguments when restoring a user from some other method. Currently not used in this way. =head2 $c->auth_realms( ) Returns a hashref containing realmname -> realm instance pairs. Realm instances contain an instantiated store and credential object as the 'store' and 'credential' elements, respectively =head2 $c->get_auth_realm( $realmname ) Retrieves the realm instance for the realmname provided. =head2 $c->update_user_in_session This was a short-lived method to update user information - you should use persist_user instead. =head2 $c->setup_auth_realm( ) =head1 OVERRIDDEN METHODS =head2 $c->setup( ) =head1 SEE ALSO This list might not be up to date. Below are modules known to work with the updated API of 0.10 and are therefore compatible with realms. =head2 Realms L =head2 User Storage Backends =over =item L =item L =item L =item L =item L =item L =item L =back =head2 Credential verification =over =item L =item L =item L =item L =item L =item L =item L =item L =back =head2 Authorization L, L =head2 Internals Documentation L =head2 Misc L, L =head1 DON'T SEE ALSO This module along with its sub plugins deprecate a great number of other modules. These include L, L. =head1 INCOMPATABILITIES The realms-based configuration and functionality of the 0.10 update of L required a change in the API used by credentials and stores. It has a compatibility mode which allows use of modules that have not yet been updated. This, however, completely mimics the older api and disables the new realm-based features. In other words you cannot mix the older credential and store modules with realms, or realm-based configs. The changes required to update modules are relatively minor and are covered in L. We hope that most modules will move to the compatible list above very quickly. =head1 COMPATIBILITY CONFIGURATION Until version 0.10008 of this module, you needed to put all the realms inside a "realms" key in the configuration. # example __PACKAGE__->config( 'Plugin::Authentication' => { default_realm => 'members', realms => { members => { ... }, }, } ); If you use the old, deprecated C<< __PACKAGE__->config( 'authentication' ) >> configuration key, then the realms key is still required. =head1 COMPATIBILITY ROUTINES In version 0.10 of L, the API changed. For app developers, this change is fairly minor, but for Credential and Store authors, the changes are significant. Please see the documentation in version 0.09 of Catalyst::Plugin::Authentication for a better understanding of how the old API functioned. The items below are still present in the plugin, though using them is deprecated. They remain only as a transition tool, for those sites which can not yet be upgraded to use the new system due to local customizations or use of Credential / Store modules that have not yet been updated to work with the new API. These routines should not be used in any application using realms functionality or any of the methods described above. These are for reference purposes only. =head2 $c->login( ) This method is used to initiate authentication and user retrieval. Technically this is part of the old Password credential module and it still resides in the L class. It is included here for reference only. =head2 $c->default_auth_store( ) Return the store whose name is 'default'. This is set to C<< $c->config( 'Plugin::Authentication' => { store => # Store} ) >> if that value exists, or by using a Store plugin: # load the Minimal authentication store. use Catalyst qw/Authentication Authentication::Store::Minimal/; Sets the default store to L. =head2 $c->get_auth_store( $name ) Return the store whose name is $name. =head2 $c->get_auth_store_name( $store ) Return the name of the store $store. =head2 $c->auth_stores( ) A hash keyed by name, with the stores registered in the app. =head2 $c->register_auth_stores( %stores_by_name ) Register stores into the application. =head2 $c->auth_store_names( ) =head2 $c->get_user( ) =head1 SUPPORT Please use the rt.cpan.org bug tracker, and git patches are wecome. Questions on usage should be directed to the Catalyst mailing list or the #catalyst irc channel. =head1 AUTHORS Yuval Kogman, C - original author Jay Kuri, C - Large rewrite =head1 PRIMARY MAINTAINER Tomas Doran (t0m), C =head1 ADDITIONAL CONTRIBUTORS =over =item Jess Robinson =item David Kamholz =item kmx =item Nigel Metheringham =item Florian Ragwitz C =item Stephan Jauernick C =item Oskari Ojala (Okko), C =item John Napiorkowski (jnap) C =back =head1 COPYRIGHT & LICENSE Copyright (c) 2005 - 2012 the Catalyst::Plugin::Authentication L, L and L as listed above. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Plugin/Authentication/Credential/000755 000765 000024 00000000000 12131606106 030334 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Plugin/Authentication/Internals.pod000644 000765 000024 00000046105 11773553721 030752 0ustar00t0mstaff000000 000000 =head1 NAME Catalyst::Plugin::Authentication::Internals - All about authentication Stores and Credentials =head1 INTRODUCTION L provides a standard authentication interface to application developers using the Catalyst framework. It is designed to allow application developers to use various methods of user storage and credential verification. It is also designed to provide for minimal change to the application when switching between different storage and credential verification methods. While L provides the interface to the application developer, the actual work of verifying the credentials and retrieving users is delegated to separate modules. These modules are called B and storage backends, or B, respectively. For authentication to function there must be at least one credential and one store. A pairing of a store and a credential is referred to as a B. There may be any number of realms defined for an application, though most applications will not require more than one or two. The details of using this module can be found in the L documentation. What follows is an explanation of how the module functions internally and what is required to implement a credential or a store. =head1 OVERVIEW There are two main entry points you need to be aware of when writing a store or credential module. The first is initialization and the second is during the actual call to the Catalyst application's authenticate method. A simplified description of the authentication process follows: B =over 4 B - for each realm: =over 4 1) The Realm is instantiated using new() method 2) The Store is instantiated using new() method 3) The Credential Instantiated using new() method 4) Credential and Store objects tied to realm for use during requests =back =back B =over 4 C<< $c->authenticate( $userinfo, $realm ) >> called =over 4 1) Credential object retrieved for realm provided 2) Credential's authenticate() method called with authinfo and realm object for current realm =over 4 The realm object and the authinfo hash are provided to the credential object's authenticate call. In most cases the credential object will attempt to retrieve a user using the realm's find_user() method, which by default relays the call directly to the Store's find_user() method. It will then usually compare the retrieved user's information with the information provided in the $authinfo hash. This is how the default 'Password' credential functions. If the credentials match, the authenticate() method should return a user object. =back 3) User object stored in session =over 4 If the user object supports session storage, the successfully authenticated user will be placed in session storage. This is done by calling the realm object's persist_user() method. The persist_user() routine by default calls the Store's for_session() method, which should return serialized data (IE a scalar). This serialized data is passed back to the store via the from_session() method, so the data should contain enough information for the store to recreate / reload the user. =back =back =back B - Per-Request operations =over 4 When any user-related activity occurs, and $c->authenticate has not yet been called, the Catalyst::Plugin::Authentication module will attempt to restore the persisted user (normally from the session if one is available). There is only one step in this process: =over 4 1) Store object's from_session() is called =back The serialized data previously returned by the store's for_session() method is provided to the from_session() method. The from_session() method should return a valid user object. Note that the for_session() is only called during the original $c->authenticate() call, so if changes are made to the user that need to be reflected in your session data, you will want to call the $c->persist_user() method - which will perform the session storage process again (complete with call to for_session()). =back More detailed information about these processes is below. =head2 INITIALIZATION When the authentication module is loaded, it reads it's configuration to determine the realms to set up for the application and which realm is to be the default. For each realm defined in the application's config, L instantiates both a new credential object and a new store object. See below for the details of how credentials and stores are instantiated. B: The instances created will remain active throughout the entire lifetime of the application, and so should be relatively lightweight. Care should be taken to ensure that they do not grow, or retain information per request, because they will be involved in each authentication request and could therefore substantially hurt memory consumption over time. =head2 AUTHENTICATION When C<$c-Eauthenticate()> is called from within an application, the objects created in the initialization process come into play. C<$c-Eauthenticate()> takes two arguments. The first is a hash reference containing all the information available about the user. This will be used to locate the user in the store and verify the user's credentials. The second argument is the realm to authenticate against. If the second argument is omitted, the default realm is assumed. The main authentication module then locates the credential and store objects for the realm specified and calls the credential object's C method. It provides three arguments, first the application object, or C<$c>, then a reference to the store object, and finally the hashref provided in the C<$c-Eauthenticate> call. The main authentication module expects the return value to be a reference to a user object upon successful authentication. If it receives anything aside from a reference, it is considered to be an authentication failure. Upon success, the returned user is marked as authenticated and the application can act accordingly, using C<$c-Euser> to access the authenticated user, etc. Astute readers will note that the main L module does not interact with the store in any way, save for passing a reference to it to the credential. This is correct. The credential object is responsible for obtaining the user from the provided store using information from the userinfo hashref and/or data obtained during the credential verification process. =head1 WRITING A STORE There are two parts to an authentication store, the store object and the user object. =head2 STORAGE BACKEND Writing a store is actually quite simple. There are only five methods that must be implemented. They are: new() - instantiates the store object find_user() - locates a user using data contained in the hashref for_session() - prepares a user to be stored in the session from_session() - does any restoration required when obtaining a user from the session user_supports() - provides information about what the user object supports =head3 STORE METHODS =over 4 =item new( $config, $app, $realm ) The C method is called only once, during the setup process of L. The first argument, C<$config>, is a hash reference containing the configuration information for the store module. The second argument is a reference to the Catalyst application. Note that when new() is called, Catalyst has not yet loaded the various controller and model classes, nor is it definite that other plugins have been loaded, so your new() method must not rely on any of those being present. If any of this is required for your store to function, you should defer that part of initialization until the first method call. The C method should return a blessed reference to your store object. =item find_user( $authinfo, $c ) This is the workhorse of any authentication store. It's job is to take the information provided to it via the C<$authinfo> hashref and locate the user that matches it. It should return a reference to a user object. A return value of anything else is considered to mean no user was found that matched the information provided. How C accomplishes it's job is entirely up to you, the author, as is what $authinfo is required to contain. Many stores will simply use a username element in $authinfo to locate the user, but more advanced functionality is possible and you may bend the $authinfo to your needs. Be aware, however, that both Credentials and Stores usually work with the same $authinfo hash, so take care to avoid overlapping element names. Please note that this routine may be called numerous times in various circumstances, and that a successful match for a user here does B necessarily constitute successful authentication. Your store class should never assume this and in most cases C<$c> B by your store object. =item for_session( $c, $user ) This method is responsible for preparing a user object for storage in the session. It should return information that can be placed in the session and later used to restore a user object (using the C method). It should therefore ensure that whatever information provided can be used by the C method to locate the unique user being saved. Note that there is no guarantee that the same Catalyst instance will receive both the C and C calls. You should take care to provide information that can be used to restore a user, regardless of the current state of the application. A good rule of thumb is that if C can revive the user with the given information even if the Catalyst application has just started up, you are in good shape. =item from_session( $c, $frozenuser ) This method is called whenever a user is being restored from the session. C<$frozenuser> contains the information that was stored in the session for the user. This will under normal circumstances be the exact data your store returned from the previous call to C. C should return a valid user object. =item user_supports( $feature, ... ) This method allows credentials and other objects to inquire as to what the underlying user object is capable of. This is pretty-well free-form and the main purpose is to allow graceful integration with credentials and applications that may provide advanced functionality based on whether the underlying user object can do certain things. In most cases you will want to pass this directly to the underlying user class' C method. Note that this is used as a B method against the user class and therefore must be able to function without an instantiated user object. =back =head3 OPTIONAL STORE METHODS If you want your store to be able to auto- create users, then you can implement these methods: =head4 auto_update_user( $authinfo, $c, $res ) This method is called if the realm's auto_update_user setting is true. =head4 auto_create_user( $authinfo, $c ) This method is called if the realm's auto_create_user setting is true. =head2 USER OBJECT The user object is an important piece of your store module. It will be the part of the system that the application developer will interact with most. As such, the API for the user object is very rigid. All user objects B inherit from L. =head3 USER METHODS The routines required by the L plugin are below. Note that of these, only get_object is strictly required, as the L base class contains reasonable implementations of the rest. If you do choose to implement only the C routine, please read the base class code and documentation so that you fully understand how the other routines will be implemented for you. Also, your user object can implement whatever additional methods you require to provide the functionality you need. So long as the below are implemented, and you don't overlap the base class' methods with incompatible routines, you should experience no problems. =over 4 =item id( ) The C method should return a unique id (scalar) that can be used to retreive this user from the store. Often this will be provided to the store's C routine as C $user-Eid> so you should ensure that your store's C can cope with that. =item supports( $feature, $subfeature ... ) This method checks to see if the user class supports a particular feature. It is implemented such that each argument provides a subfeature of the previous argument. In other words, passing 'foo', 'bar' would return true if the user supported the 'foo' feature, and the 'bar' feature of 'foo'. This is implemented in Catalyst::Authentication::User, so if your class inherits from that, you do not need to implement this and can instead implement supported_features(). B If you want the authentication module to be able to save your user in the session you must return true when presented with the feature 'session'. =item supported_features( ) This method should return a hashref of features supported by the user class. This is for more flexible integration with some Credentials / applications. It is not required that you support anything, and returning C is perfectly acceptable and in most cases what you will do. =item get( $fieldname ) This method should return the value of the field matching fieldname provided, or undef if there is no field matching that fieldname. In most cases this will access the underlying storage mechanism for the user data and return the information. This is used as a standard method of accessing an authenticated user's data, and MUST be implemented by all user objects. B: There is no equivalent 'set' method. Each user class is likely to vary greatly in how data must be saved and it is therefore impractical to try to provide a standard way of accomplishing it. When an application developer needs to save data, they should obtain the underlying object / data by calling get_object, and work with it directly. =item get_object( ) This method returns the underlying user object. If your user object is backed by another object class, this method should return that underlying object. This allows the application developer to obtain an editable object. Generally speaking this will only be done by developers who know what they are doing and require advanced functionality which is either unforeseen or inconsistent across user classes. If your object is not backed by another class, or you need to provide additional intermediate functionality, it is perfectly reasonable to return C<$self>. =back =head1 WRITING A CREDENTIAL Compared to writing a store, writing a credential is very simple. There is only one class to implement, and it consists of only two required routines. They are: new() - instantiates the credential object authenticate() - performs the authentication and returns a user object =head2 CREDENTIAL METHODS =over 4 =item new( $config, $app, $realm ) Like the Store method of the same name, the C method is called only once, during the setup process of L. The first argument, C<$config>, is a hash reference containing the configuration information for the credential module. The second argument is a reference to the Catalyst application. $realm is the instantiated Realm object, which you may use to access realm routines - such as find_user. Again, when the credential's new() method is called, Catalyst has not yet loaded the various controller and model classes. The new method should perform any necessary setup required and instantiate your credential object. It should return your instantiated credential. =item authenticate( $c, $realm, $authinfo ) This is the workhorse of your credential. When $c->authenticate() is called the L module retrieves the realm object and passes it, along with the $authinfo hash to your credential's authenticate method. Your module should use the $authinfo hash to obtain the user from the realm passed, and then perform any credential verification steps necessary to authenticate the user. This method should return the user object returned by the authentication store if credential verification succeeded. It should return undef on failure. How your credential module performs the credential verification is entirely up to you. In most cases, the credential will retrieve a user from the store first (using the stores find_user() method), and then validate the user's information. However, this does not have to be the case. It is perfectly acceptable for your credential to perform other tasks prior to attempting to retrieve the user from the store. It may also make sense for your credential to perform activities which help to locate the user in question, for example, finding a user id based on an encrypted token. In these scenarios, the $authinfo hash passed to find_user() can be different than that which is passed in to $c->authenticate(). Once again this is perfectly acceptable if it makes sense for your credential, though you are strongly advised to note this behavior clearly in your credential's documentation - as application authors are almost certainly expecting the user to be found using the information provided to $c->authenticate(). Look at the L module source to see this in action. In order to avoid possible mismatches between the encrypted and unencrypted passwords, the password credential actually removes the provided password from the authinfo array. It does this because, in many cases, the store's password field will be encrypted in some way, and the password passed to $c->authenticate is almost certainly in plaintext. NOTE: You should always assume that a store is going to use all the information passed to it to locate the user in question. If there are fields in the $authinfo hash that you are sure are specific to your credential, you may want to consider removing them before user retrieval. A better solution is to place those arguments that are specific to your credential within their own subhash named after your module. The L module does this in order to encapsulate arguments intended specifically for that module. See the L source for details. =back =head1 AUTHORS Jay Kuri, C =head1 COPYRIGHT & LICENSE Copyright (c) 2005 the aforementioned authors. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Plugin/Authentication/Store/000755 000765 000024 00000000000 12131606106 027356 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Plugin/Authentication/User/000755 000765 000024 00000000000 12131606106 027200 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Plugin/Authentication/User.pm000644 000765 000024 00000000723 11773550351 027553 0ustar00t0mstaff000000 000000 package Catalyst::Plugin::Authentication::User; use strict; use warnings; use base qw/Catalyst::Authentication::User/; __PACKAGE__; __END__ =pod =head1 NAME Catalyst::Plugin::Authentication::User - Compatibility shim =head1 DESCRIPTION THIS IS A COMPATIBILITY SHIM. It allows old configurations of Catalyst Authentication to work without code changes. B Please see L for more information. Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Plugin/Authentication/User/Hash.pm000644 000765 000024 00000000753 11773550351 030441 0ustar00t0mstaff000000 000000 package Catalyst::Plugin::Authentication::User::Hash; use strict; use warnings; use base qw/Catalyst::Authentication::User::Hash/; __PACKAGE__; __END__ =pod =head1 NAME Catalyst::Plugin::Authentication::User::Hash - Compatibility shim =head1 DESCRIPTION THIS IS A COMPATIBILITY SHIM. It allows old configurations of Catalyst Authentication to work without code changes. B Please see L for more information. Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Plugin/Authentication/Store/Minimal.pm000644 000765 000024 00000004044 11773550351 031317 0ustar00t0mstaff000000 000000 package Catalyst::Plugin::Authentication::Store::Minimal; use strict; use warnings; use MRO::Compat; use Catalyst::Authentication::Store::Minimal (); ## backwards compatibility sub setup { my $c = shift; ### If a user does 'use Catalyst qw/Authentication::Store::Minimal/' ### he will be proxied on to this setup routine (and only then -- ### non plugins should NOT have their setup routine invoked!) ### Beware what we pass to the 'new' routine; it wants ### a config has with a top level key 'users'. New style ### configs do not have this, and split by realms. If we ### blindly pass this to new, we will 1) overwrite what we ### already passed and 2) make ->userhash undefined, which ### leads to: ### Can't use an undefined value as a HASH reference at ### lib/Catalyst/Authentication/Store/Minimal.pm line 38. ### ### So only do this compatibility call if: ### 1) we have a {users} config directive ### ### Ideally we could also check for: ### 2) we don't already have a ->userhash ### however, that's an attribute of an object we can't ### access =/ --kane my $cfg = $c->config->{'Plugin::Authentication'}->{users} ? $c->config->{'Plugin::Authentication'} : undef; $c->default_auth_store( Catalyst::Authentication::Store::Minimal->new( $cfg, $c ) ) if $cfg; $c->next::method(@_); } foreach my $method (qw/ get_user user_supports find_user from_session /) { no strict 'refs'; *{$method} = sub { __PACKAGE__->default_auth_store->$method( @_ ) }; } __PACKAGE__; __END__ =pod =head1 NAME Catalyst::Plugin::Authentication::Store::Minimal - Compatibility shim =head1 DESCRIPTION THIS IS A COMPATIBILITY SHIM. It allows old configurations of Catalyst Authentication to work without code changes. B Please see L for more information. =head1 METHODS =over =item find_user =item from_session =item get_user =item setup =item user_supports =back =cut Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Plugin/Authentication/Credential/Password.pm000644 000765 000024 00000010134 11773550351 032506 0ustar00t0mstaff000000 000000 package Catalyst::Plugin::Authentication::Credential::Password; use strict; use warnings; use Catalyst::Authentication::Credential::Password (); ## BACKWARDS COMPATIBILITY - all subs below here are deprecated ## They are here for compatibility with older modules that use / inherit from C::P::A::Password ## login()'s existance relies rather heavily on the fact that only Credential::Password ## is being used as a credential. This may not be the case. This is only here ## for backward compatibility. It will go away in a future version ## login should not be used in new applications. sub login { my ( $c, $user, $password, @rest ) = @_; unless ( defined($user) or $user = $c->request->param("login") || $c->request->param("user") || $c->request->param("username") ) { $c->log->debug( "Can't login a user without a user object or user ID param") if $c->debug; return; } unless ( defined($password) or $password = $c->request->param("password") || $c->request->param("passwd") || $c->request->param("pass") ) { $c->log->debug("Can't login a user without a password") if $c->debug; return; } unless ( Scalar::Util::blessed($user) and $user->isa("Catalyst::Authentication::User") ) { if ( my $user_obj = $c->get_user( $user, $password, @rest ) ) { $user = $user_obj; } else { $c->log->debug("User '$user' doesn't exist in the default store") if $c->debug; return; } } if ( $c->_check_password( $user, $password ) ) { $c->set_authenticated($user); $c->log->debug("Successfully authenticated user '$user'.") if $c->debug; return 1; } else { $c->log->debug( "Failed to authenticate user '$user'. Reason: 'Incorrect password'") if $c->debug; return; } } ## also deprecated. Here for compatibility with older credentials which do not inherit from C::P::A::Password sub _check_password { my ( $c, $user, $password ) = @_; if ( $user->supports(qw/password clear/) ) { return $user->password eq $password; } elsif ( $user->supports(qw/password crypted/) ) { my $crypted = $user->crypted_password; return $crypted eq crypt( $password, $crypted ); } elsif ( $user->supports(qw/password hashed/) ) { my $d = Digest->new( $user->hash_algorithm ); $d->add( $user->password_pre_salt || '' ); $d->add($password); $d->add( $user->password_post_salt || '' ); my $stored = $user->hashed_password; my $computed = $d->clone()->digest; my $b64computed = $d->clone()->b64digest; return ( ( $computed eq $stored ) || ( unpack( "H*", $computed ) eq $stored ) || ( $b64computed eq $stored) || ( $b64computed.'=' eq $stored) ); } elsif ( $user->supports(qw/password salted_hash/) ) { require Crypt::SaltedHash; my $salt_len = $user->can("password_salt_len") ? $user->password_salt_len : 0; return Crypt::SaltedHash->validate( $user->hashed_password, $password, $salt_len ); } elsif ( $user->supports(qw/password self_check/) ) { # while somewhat silly, this is to prevent code duplication return $user->check_password($password); } else { Catalyst::Exception->throw( "The user object $user does not support any " . "known password authentication mechanism." ); } } __PACKAGE__; __END__ =pod =head1 NAME Catalyst::Plugin::Authentication::Credential::Password - Compatibility shim =head1 DESCRIPTION THIS IS A COMPATIBILITY SHIM. It allows old configurations of Catalyst Authentication to work without code changes. B Please see L for more information. =head1 METHODS =head2 login( ) =cut Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Authentication/Credential/000755 000765 000024 00000000000 12131606106 027076 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Authentication/Realm/000755 000765 000024 00000000000 12131606106 026064 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Authentication/Realm.pm000644 000765 000024 00000030764 11773554550 026454 0ustar00t0mstaff000000 000000 package Catalyst::Authentication::Realm; use Moose; use namespace::autoclean; with 'MooseX::Emulate::Class::Accessor::Fast'; use String::RewritePrefix; use Try::Tiny qw/ try catch /; __PACKAGE__->mk_accessors(qw/store credential name config/); ## Add use_session config item to realm. sub new { my ($class, $realmname, $config, $app) = @_; my $self = { config => $config }; bless $self, $class; $self->name($realmname); if (!exists($self->config->{'use_session'})) { if (exists($app->config->{'Plugin::Authentication'}{'use_session'})) { $self->config->{'use_session'} = $app->config->{'Plugin::Authentication'}{'use_session'}; } else { $self->config->{'use_session'} = 1; } } $app->log->debug("Setting up auth realm $realmname") if $app->debug; # use the Null store as a default - Don't complain if the realm class is being overridden, # as the new realm may behave differently. if( ! exists($config->{store}{class}) ) { $config->{store}{class} = '+Catalyst::Authentication::Store::Null'; if (! exists($config->{class})) { $app->log->debug( qq(No Store specified for realm "$realmname", using the Null store.) ); } } my $storeclass = $config->{'store'}{'class'}; ## follow catalyst class naming - a + prefix means a fully qualified class, otherwise it's ## taken to mean C::P::A::Store::(specifiedclass) $storeclass = String::RewritePrefix->rewrite({ '' => 'Catalyst::Authentication::Store::', '+' => '', }, $storeclass); # a little niceness - since most systems seem to use the password credential class, # if no credential class is specified we use password. $config->{credential}{class} ||= '+Catalyst::Authentication::Credential::Password'; my $credentialclass = $config->{'credential'}{'class'}; ## follow catalyst class naming - a + prefix means a fully qualified class, otherwise it's ## taken to mean C::A::Credential::(specifiedclass) $credentialclass = String::RewritePrefix->rewrite({ '' => 'Catalyst::Authentication::Credential::', '+' => '', }, $credentialclass); # if we made it here - we have what we need to load the classes ### BACKWARDS COMPATIBILITY - DEPRECATION WARNING: ### we must eval the ensure_class_loaded - because we might need to try the old-style ### ::Plugin:: module naming if the standard method fails. ## Note to self - catch second exception and bitch in detail? try { Catalyst::Utils::ensure_class_loaded( $credentialclass ); } catch { # If the file is missing, then try the old-style fallback, # but re-throw anything else for the user to deal with. die $_ unless /^Can't locate/; $app->log->warn( qq(Credential class "$credentialclass" not found, trying deprecated ::Plugin:: style naming. ) ); my $origcredentialclass = $credentialclass; $credentialclass =~ s/Catalyst::Authentication/Catalyst::Plugin::Authentication/; try { Catalyst::Utils::ensure_class_loaded( $credentialclass ); } catch { # Likewise this croak is useful if the second exception is also "not found", # but would be confusing if it's anything else. die $_ unless /^Can't locate/; Carp::croak "Unable to load credential class, " . $origcredentialclass . " OR " . $credentialclass . " in realm " . $self->name; }; }; try { Catalyst::Utils::ensure_class_loaded( $storeclass ); } catch { # If the file is missing, then try the old-style fallback, # but re-throw anything else for the user to deal with. die $_ unless /^Can't locate/; $app->log->warn( qq(Store class "$storeclass" not found, trying deprecated ::Plugin:: style naming. ) ); my $origstoreclass = $storeclass; $storeclass =~ s/Catalyst::Authentication/Catalyst::Plugin::Authentication/; try { Catalyst::Utils::ensure_class_loaded( $storeclass ); } catch { # Likewise this croak is useful if the second exception is also "not found", # but would be confusing if it's anything else. die $_ unless /^Can't locate/; Carp::croak "Unable to load store class, " . $origstoreclass . " OR " . $storeclass . " in realm " . $self->name; }; }; # BACKWARDS COMPATIBILITY - if the store class does not define find_user, we define it in terms # of get_user and add it to the class. this is because the auth routines use find_user, # and rely on it being present. (this avoids per-call checks) if (!$storeclass->can('find_user')) { no strict 'refs'; *{"${storeclass}::find_user"} = sub { my ($self, $info) = @_; my @rest = @{$info->{rest}} if exists($info->{rest}); $self->get_user($info->{id}, @rest); }; } ## a little cruft to stay compatible with some poorly written stores / credentials ## we'll remove this soon. if ($storeclass->can('new')) { $self->store($storeclass->new($config->{'store'}, $app, $self)); } else { $app->log->error("THIS IS DEPRECATED: $storeclass has no new() method - Attempting to use uninstantiated"); $self->store($storeclass); } if ($credentialclass->can('new')) { $self->credential($credentialclass->new($config->{'credential'}, $app, $self)); } else { $app->log->error("THIS IS DEPRECATED: $credentialclass has no new() method - Attempting to use uninstantiated"); $self->credential($credentialclass); } return $self; } sub find_user { my ( $self, $authinfo, $c ) = @_; my $res = $self->store->find_user($authinfo, $c); if (!$res) { if ($self->config->{'auto_create_user'} && $self->store->can('auto_create_user') ) { $res = $self->store->auto_create_user($authinfo, $c); } } elsif ($self->config->{'auto_update_user'} && $self->store->can('auto_update_user')) { $res = $self->store->auto_update_user($authinfo, $c, $res); } return $res; } sub authenticate { my ($self, $c, $authinfo) = @_; my $user = $self->credential->authenticate($c, $self, $authinfo); if (ref($user)) { $c->set_authenticated($user, $self->name); return $user; } else { return undef; } } sub user_is_restorable { my ($self, $c) = @_; return unless $c->can('session') and $self->config->{'use_session'} and $c->session_is_valid; return $c->session->{__user}; } sub restore_user { my ($self, $c, $frozen_user) = @_; $frozen_user ||= $self->user_is_restorable($c); return unless defined($frozen_user); my $user = $self->from_session( $c, $frozen_user ); if ($user) { $c->_user( $user ); # this sets the realm the user originated in. $user->auth_realm($self->name); } else { $self->failed_user_restore($c) || $c->error("Store claimed to have a restorable user, but restoration failed. Did you change the user's id_field?"); } return $user; } ## this occurs if there is a session but the thing the session refers to ## can not be found. Do what you must do here. ## Return true if you can fix the situation and find a user, false otherwise sub failed_user_restore { my ($self, $c) = @_; $self->remove_persisted_user($c); return; } sub persist_user { my ($self, $c, $user) = @_; if ( $c->can('session') and $self->config->{'use_session'} and $user->supports("session") ) { $c->session->{__user_realm} = $self->name; # we want to ask the store for a user prepared for the session. # but older modules split this functionality between the user and the # store. We try the store first. If not, we use the old method. if ($self->store->can('for_session')) { $c->session->{__user} = $self->store->for_session($c, $user); } else { $c->session->{__user} = $user->for_session; } } return $user; } sub remove_persisted_user { my ($self, $c) = @_; if ( $c->can('session') and $self->config->{'use_session'} and $c->session_is_valid ) { delete @{ $c->session }{qw/__user __user_realm/}; } } ## backwards compatibility - I don't think many people wrote realms since they ## have only existed for a short time - but just in case. sub save_user_in_session { my ( $self, $c, $user ) = @_; return $self->persist_user($c, $user); } sub from_session { my ($self, $c, $frozen_user) = @_; return $self->store->from_session($c, $frozen_user); } __PACKAGE__; __END__ =pod =head1 NAME Catalyst::Authentication::Realm - Base class for realm objects. =head1 DESCRIPTION =head1 CONFIGURATION =over 4 =item class By default this class is used by L for all realms. The class parameter allows you to choose a different class to use for this realm. Creating a new Realm class can allow for authentication methods that fall outside the normal credential/store methodology. =item auto_create_user Set this to true if you wish this realm to auto-create user accounts when the user doesn't exist (most useful for remote authentication schemes). =item auto_update_user Set this to true if you wish this realm to auto-update user accounts after authentication (most useful for remote authentication schemes). =item use_session Sets session usage for this particular realm - overriding the global use_sesion setting. =back =head1 METHODS =head2 new( $realmname, $config, $app ) Instantiantes this realm, plus the specified store and credential classes. =head2 store( ) Returns an instance of the store object for this realm. =head2 credential( ) Returns an instance of the credential object for this realm. =head2 find_user( $authinfo, $c ) Retrieves the user given the authentication information provided. This is most often called from the credential. The default realm class simply delegates this call the store object. If enabled, auto-creation and auto-updating of users is also handled here. =head2 authenticate( $c, $authinfo) Performs the authentication process for the current realm. The default realm class simply delegates this to the credential and sets the authenticated user on success. Returns the authenticated user object; =head1 USER PERSISTENCE The Realm class allows complete control over the persistance of users between requests. By default the realm attempts to use the Catalyst session system to accomplish this. By overriding the methods below in a custom Realm class, however, you can handle user persistance in any way you see fit. =head2 persist_user($c, $user) persist_user is the entry point for saving user information between requests in most cases this will utilize the session. By default this uses the catalyst session system to store the user by calling for_session on the active store. The user object must be a subclass of Catalyst::Authentication::User. If you have updated the user object, you must call persist_user again to ensure that the persisted user object reflects your updates. =head2 remove_persisted_user($c) Removes any persisted user data. By default, removes the user from the session. =head2 user_is_restorable( $c ) Returns whether there is a persisted user that may be restored. Returns a token used to restore the user. With the default session persistance it returns the raw frozen user information. =head2 restore_user($c, [$frozen_user]) Restores the user from the given frozen_user parameter, or if not provided, using the response from $self->user_is_restorable(); Uses $self->from_session() to decode the frozen user. =head2 failed_user_restore($c) If there is a session to restore, but the restore fails for any reason then this method is called. This method supplied just removes the persisted user, but can be overridden if required to have more complex logic (e.g. finding a the user by their 'old' username). =head2 from_session($c, $frozenuser ) Decodes the frozenuser information provided and returns an instantiated user object. By default, this call is delegated to $store->from_session(). =head2 save_user_in_session($c, $user) DEPRECATED. Use persist_user instead. (this simply calls persist_user) =cut Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Authentication/Store/000755 000765 000024 00000000000 12131606106 026120 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Authentication/Store.pod000644 000765 000024 00000010012 11641336536 026632 0ustar00t0mstaff000000 000000 =head1 NAME Catalyst::Authentication::Store - All about authentication stores =head1 MULTIPLE BACKENDS B This is documentation for the old store system used in versions of L prior to 0.10. This is NOT how the new realm-based stores work. This is here for reference only. See L instead. =head1 OLD STORE DOCUMENTATION BELOW A key issue to understand about authentication stores is that there are potentially many of them. Each one is registered into the application, and has a name. For most applications, there is only one, and in this framework it is called 'default'. When you use a plugin, like use Catalyst qw/ Authentication Authentication::Store::Foo /; the Store plugins typically only act at setup time. They rarely do more than check out the configuration, and register e.g. Store::Foo, and set it as the default store. __PACKAGE__->default_auth_store( $store ); # the same as __PACKAGE__->register_auth_stores( default => $store ); =head1 WORKING WITH USERS All credential verifiers should accept either a user object, or a user ID. If a user ID is provided, then they will fetch the user object from the default store, and check against it. This should be pretty much DWIM all the time. When you need multiple authentication backends per application then you must fetch things yourself. For example: my $user = $c->get_auth_store("other_store")->get_user($id); $c->login( $user, $supplied_password ); Instead of just: $c->login( $id, $supplied_password ); which will go to the default store. =head1 WRITING A BACKEND Writing an authentication storage backend is a very simple matter. The only method you really need to support is C. This method should accept an arbitrary list of parameters (determined by you or the credential verifyer), and return an object inheriting L. For introspection purposes you can also define the C method. See below for optional features. This is not necessary, but might be in the future. =head2 Integrating with Catalyst::Plugin::Session If your users support sessions, your store should also define the C method. When the user object is saved in the session the C method is called, and that is used as the value in the session (typically a user id). The store is also saved in the hash. If C<< $user->store >> returns something registered, that store's name is used. If not, the user's class is used as if it were a store (and must also support C). =head2 Optional Features Each user has the C method. For example: $user->supports(qw/password clear/); should return a true value if this specific user has a clear text password. This is on a per user (not necessarily a per store) basis. To make assumptions about the store as a whole, $store->user_supports(qw/password clear/); is supposed to be the lowest common denominator. The standardization of these values is to be goverened by the community, typically defined by the credential verification plugins. =head2 Stores implying certain credentials Sometimes a store is agnostic to the credentials (DB storage, for example), but sometimes it isn't (like an Htpasswd file). If you are writing a backend that wraps around a module, like L wraps around L, it makes sense to delegate the credential checks. This particular example caused the following "feature" to be added: $user->supports(qw/password self_check/); =head2 Writing a plugin to go with the backend Typically the backend will do the heavy lifting, by registering a store. These plugins should look something like this: sub setup { my $c = shift; $c->default_auth_store( # a store can be an object or a class Catalyst::Authentication::Store::Foo::Backend->new( ... ) ); $c->NEXT::setup(@_); } Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Authentication/User/000755 000765 000024 00000000000 12131606106 025742 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Authentication/User.pm000644 000765 000024 00000007777 11773554614 026343 0ustar00t0mstaff000000 000000 package Catalyst::Authentication::User; use Moose; use namespace::autoclean; with 'MooseX::Emulate::Class::Accessor::Fast'; use Scalar::Util qw/refaddr/; ## auth_realm is the realm this user came from. __PACKAGE__->mk_accessors(qw/auth_realm store/); ## THIS IS NOT A COMPLETE CLASS! it is intended to provide base functionality only. ## translation - it won't work if you try to use it directly. ## chances are you want to override this. sub id { shift->get('id'); } ## this relies on 'supported_features' being implemented by the subclass.. ## but it is not an error if it is not. it just means you support nothing. ## nihilist user objects are welcome here. sub supports { my ( $self, @spec ) = @_; my $cursor = undef; if ($self->can('supported_features')) { $cursor = $self->supported_features; # traverse the feature list, for (@spec) { #die "bad feature spec: @spec" if ref($cursor) ne "HASH"; return if ref($cursor) ne "HASH"; $cursor = $cursor->{$_}; } } return $cursor; } ## REQUIRED. ## get should return the value of the field specified as it's single argument from the underlying ## user object. This is here to provide a simple, standard way of accessing individual elements of a user ## object - ensuring no overlap between C::P::A::User methods and actual fieldnames. ## this is not the most effecient method, since it uses introspection. If you have an underlying object ## you most likely want to write this yourself. sub get { my ($self, $field) = @_; my $object; if ($object = $self->get_object and $object->can($field)) { return $object->$field(); } else { return undef; } } ## REQUIRED. ## get_object should return the underlying user object. This is for when more advanced uses of the ## user is required. Modifications to the existing user, etc. Changes in the object returned ## by this routine may not be reflected in the C::P::A::User object - if this is required, re-authenticating ## the user is probably the best route to take. ## note that it is perfectly acceptable to return $self in cases where there is no underlying object. sub get_object { return shift; } ## obj is shorthand for get_object. This is originally from the DBIx::Class store, but ## as it has become common usage, this makes things more compatible. Plus, it's shorter. sub obj { my $self = shift; return $self->get_object(@_); } sub AUTOLOAD { my $self = shift; (my $method) = (our $AUTOLOAD =~ /([^:]+)$/); return if $method eq "DESTROY"; my $obj = $self->obj; # Don't bother unless we have a backing object return if refaddr($obj) eq refaddr($self); $obj->$method(@_); } __PACKAGE__; __END__ =pod =head1 NAME Catalyst::Authentication::User - Base class for user objects. =head1 SYNOPSIS package MyStore::User; use base qw/Catalyst::Authentication::User/; =head1 DESCRIPTION This is the base class for authentication user objects. THIS IS NOT A COMPLETE CLASS! it is intended to provide base functionality only. It provides the base methods listed below, and any additional methods are proxied onto the user object fetched from the underlieing store. =head1 NOTES TO STORE IMPLEMENTORS Please read the comments in the source code of this class to work out which methods you should override. =head1 METHODS =head2 id( ) A unique ID by which a user can be retrieved from the store. =head2 store( ) Should return a class name that can be used to refetch the user using it's ID. =head2 supports( ) An introspection method used to determine what features a user object has, to support credential and authorization plugins. =head2 get( $field ) Returns the value for the $field provided. =head2 get_object( ) Returns the underlying object storing the user data. The return value of this method will vary depending on the storage module used. =head2 obj( ) Shorthand for get_object( ) =head2 AUTOLOAD Delegates any unknown methods onto the user object returned by ->obj =cut Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Authentication/User/Hash.pm000644 000765 000024 00000006015 11773550351 027200 0ustar00t0mstaff000000 000000 package Catalyst::Authentication::User::Hash; use strict; use warnings; use base qw/Catalyst::Authentication::User/; sub new { my $class = shift; bless { ( @_ > 1 ) ? @_ : %{ $_[0] } }, $class; } sub AUTOLOAD { my $self = shift; ( my $key ) = ( our $AUTOLOAD =~ m/([^:]*)$/ ); $self->_accessor( $key, @_ ); } # this class effectively handles any method calls sub can { 1 } sub id { my $self = shift; $self->_accessor( "id", @_ ); } ## deprecated. Let the base class handle this. # sub store { # my $self = shift; # $self->_accessor( "store", @_ ) || ref $self; # } sub _accessor { my $self = shift; my $key = shift; if (@_) { my $arr = $self->{__hash_obj_key_is_array}{$key} = @_ > 1; $self->{$key} = $arr ? [@_] : shift; } my $data = $self->{$key}; ( $self->{__hash_obj_key_is_array}{$key} || $key =~ /roles/ ) ? @{ $data || [] } : $data; } ## password portion of this is no longer necessary, but here for backwards compatibility. my %features = ( password => { clear => ["password"], crypted => ["crypted_password"], hashed => [qw/hashed_password hash_algorithm/], self_check => undef, }, roles => ["roles"], session => 1, ); sub supports { my ( $self, @spec ) = @_; my $cursor = \%features; return 1 if @spec == 1 and exists $self->{ $spec[0] }; # traverse the feature list, for (@spec) { return if ref($cursor) ne "HASH"; $cursor = $cursor->{$_}; } if ( ref $cursor ) { die "bad feature spec: @spec" unless ref $cursor eq "ARRAY"; # check that all the keys required for a feature are in here foreach my $key (@$cursor) { return undef unless exists $self->{$key}; } return 1; } else { return $cursor; } } sub for_session { my $self = shift; return $self; # we serialize the whole user } sub from_session { my ( $self, $c, $user ) = @_; $user; } __PACKAGE__; __END__ =pod =head1 NAME Catalyst::Authentication::User::Hash - An easy authentication user object based on hashes. =head1 SYNOPSIS use Catalyst::Authentication::User::Hash; Catalyst::Authentication::User::Hash->new( password => "s3cr3t", ); =head1 DESCRIPTION This implementation of authentication user handles is supposed to go hand in hand with L. =head1 METHODS =head2 new( @pairs ) Create a new object with the key-value-pairs listed in the arg list. =head2 supports( ) Checks for existence of keys that correspond with features. =head2 for_session( ) Just returns $self, expecting it to be serializable. =head2 from_session( ) Just passes returns the unserialized object, hoping it's intact. =head2 AUTOLOAD( ) Accessor for the key whose name is the method. =head2 store( ) Accessors that override superclass's dying virtual methods. =head2 id( ) =head2 can( ) =head1 SEE ALSO L =cut Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Authentication/Store/Minimal.pm000644 000765 000024 00000013476 11773554563 030103 0ustar00t0mstaff000000 000000 package Catalyst::Authentication::Store::Minimal; use Moose; use namespace::autoclean; with 'MooseX::Emulate::Class::Accessor::Fast'; use Scalar::Util qw( blessed ); __PACKAGE__->mk_accessors(qw/userhash userclass/); sub new { my ( $class, $config, $app, $realm) = @_; my $self = bless { userhash => $config->{'users'}, userclass => $config->{'user_class'} || "Catalyst::Authentication::User::Hash", }, $class; Catalyst::Utils::ensure_class_loaded( $self->userclass ); return $self; } sub from_session { my ( $self, $c, $id ) = @_; return $id if ref $id; $self->find_user( { id => $id } ); } ## this is not necessarily a good example of what find_user can do, since all we do is ## look up with the id anyway. find_user can be used to locate a user based on other ## combinations of data. See C::P::Authentication::Store::DBIx::Class for a better example sub find_user { my ( $self, $userinfo, $c ) = @_; my $id = $userinfo->{'id'}; $id ||= $userinfo->{'username'}; return unless exists $self->userhash->{$id}; my $user = $self->userhash->{$id}; if ( ref($user) eq "HASH") { $user->{id} ||= $id; return bless $user, $self->userclass; } elsif ( ref($user) && blessed($user) && $user->isa('Catalyst::Authentication::User::Hash')) { return $user; } else { Catalyst::Exception->throw( "The user '$id' must be a hash reference or an " . "object of class Catalyst::Authentication::User::Hash"); } return $user; } sub user_supports { my $self = shift; # choose a random user scalar keys %{ $self->userhash }; ( undef, my $user ) = each %{ $self->userhash }; $user->supports(@_); } ## Backwards compatibility # # This is a backwards compatible routine. get_user is specifically for loading a user by it's unique id # find_user is capable of doing the same by simply passing { id => $id } # no new code should be written using get_user as it is deprecated. sub get_user { my ( $self, $id ) = @_; $self->find_user({id => $id}); } __PACKAGE__; __END__ =pod =head1 NAME Catalyst::Authentication::Store::Minimal - Minimal authentication store =head1 SYNOPSIS # you probably just want Store::Minimal under most cases, # but if you insist you can instantiate your own store: use Catalyst::Authentication::Store::Minimal; use Catalyst qw/ Authentication /; __PACKAGE__->config( 'Plugin::Authentication' => { default_realm => 'members', realms => { members => { credential => { class => 'Password', password_field => 'password', password_type => 'clear' }, store => { class => 'Minimal', users => { bob => { password => "s00p3r", editor => 'yes', roles => [qw/edit delete/], }, william => { password => "s3cr3t", roles => [qw/comment/], } } } } } } ); =head1 DESCRIPTION This authentication store lets you create a very quick and dirty user database in your application's config hash. You will need to include the Authentication plugin, and at least one Credential plugin to use this Store. Credential::Password is reccommended. It's purpose is mainly for testing, and it should probably be replaced by a more "serious" store for production. The hash in the config, as well as the user objects/hashes are freely mutable at runtime. =head1 CONFIGURATION =over 4 =item class The classname used for the store. This is part of L and is the method by which Catalyst::Authentication::Store::Minimal is loaded as the user store. For this module to be used, this must be set to 'Minimal'. =item user_class The class used for the user object. If you don't specify a class name, the default L will be used. If you define your own class, it must inherit from L. =item users This is a simple hash of users, the keys are the usenames, and the values are hashrefs containing a password key/value pair, and optionally, a roles/list of role-names pair. If using roles, you will also need to add the Authorization::Roles plugin. See the SYNOPSIS for an example. =back =head1 METHODS There are no publicly exported routines in the Minimal store (or indeed in most authentication stores) However, below is a description of the routines required by L for all authentication stores. =head2 new( $config, $app, $realm ) Constructs a new store object, which uses the user element of the supplied config hash ref as it's backing structure. =head2 find_user( $authinfo, $c ) Keys the hash by the 'id' or 'username' element in the authinfo hash and returns the user. ... documentation fairy stopped here. ... If the return value is unblessed it will be blessed as L. =head2 from_session( $id ) Delegates to C. =head2 user_supports( ) Chooses a random user from the hash and delegates to it. =head2 get_user( ) Deprecated =head2 setup( ) =cut Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Authentication/Store/Null.pm000644 000765 000024 00000003756 11773554575 027432 0ustar00t0mstaff000000 000000 package Catalyst::Authentication::Store::Null; use Moose; use namespace::autoclean; with 'MooseX::Emulate::Class::Accessor::Fast'; use Catalyst::Authentication::User::Hash; __PACKAGE__->mk_accessors( qw( _config ) ); sub new { my ( $class, $config, $app, $realm ) = @_; bless { _config => $config }, $class; } sub for_session { my ( $self, $c, $user ) = @_; return $user; } sub from_session { my ( $self, $c, $user ) = @_; return $user; } sub find_user { my ( $self, $userinfo, $c ) = @_; return bless $userinfo, 'Catalyst::Authentication::User::Hash'; } sub user_supports { my $self = shift; Catalyst::Authentication::User::Hash->supports(@_); } 1; __END__ =pod =head1 NAME Catalyst::Authentication::Store::Null - Null authentication store =head1 SYNOPSIS use Catalyst qw( Authentication ); __PACKAGE__->config( 'Plugin::Authentication' => { default_realm => 'remote', realms => { remote => { credential => { class => 'TypeKey', key_url => 'http://example.com/regkeys.txt', }, store => { class => 'Null', } } } }); =head1 DESCRIPTION The Null store is a transparent store where any supplied user data is accepted. This is mainly useful for remotely authenticating credentials (e.g. TypeKey, OpenID) which may not be tied to any local storage. It also helps facilitate integration with the Session plugin. =head1 METHODS =head2 new( ) Creates a new instance of the store. =head2 for_session( ) Returns the user object passed to the method. =head2 from_session( ) Returns the user object passed to the method. =head2 find_user( ) Since this store isn't tied to any real set of users, this method just returns the user info bless as a L object. =head2 user_supports( ) Delegates to L. =cut Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Authentication/Realm/Compatibility.pm000644 000765 000024 00000001532 11773555667 031266 0ustar00t0mstaff000000 000000 package Catalyst::Authentication::Realm::Compatibility; use strict; use warnings; use base qw/Catalyst::Authentication::Realm/; ## very funky - the problem here is that we can't do real realm initialization ## but we need a real realm object to function. So - we kinda fake it - we ## create an empty object - sub new { my ($class, $realmname, $config, $app) = @_; my $self = { config => $config }; bless $self, $class; $self->config->{'use_session'} = $app->config->{'Plugin::Authentication'}{'use_session'} || '1'; $self->name($realmname); return $self; } __PACKAGE__; __END__ =pod =head1 NAME Catalyst::Authentication::Realm::Compatibility - Compatibility realm object =head1 DESCRIPTION An empty realm object for compatibility reasons. =head1 METHODS =head2 new( ) Returns a, basically empty, realm object. =cut Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Authentication/Realm/Progressive.pm000644 000765 000024 00000012612 11773550350 030746 0ustar00t0mstaff000000 000000 package Catalyst::Authentication::Realm::Progressive; use Carp; use warnings; use strict; use base 'Catalyst::Authentication::Realm'; =head1 NAME Catalyst::Authentication::Realm::Progressive - Authenticate against multiple realms =head1 SYNOPSIS This Realm allows an application to use a single authenticate() call during which multiple realms are used and tried incrementally until one performs a successful authentication is accomplished. A simple use case is a Temporary Password that looks and acts exactly as a regular password. Without changing the authentication code, you can authenticate against multiple realms. Another use might be to support a legacy website authentication system, trying the current auth system first, and upon failure, attempting authentication against the legacy system. =head2 EXAMPLE If your application has multiple realms to authenticate, such as a temporary password realm and a normal realm, you can configure the progressive realm as the default, and configure it to iteratively call the temporary realm and then the normal realm. __PACKAGE__->config( 'Plugin::Authentication' => { default_realm => 'progressive', realms => { progressive => { class => 'Progressive', realms => [ 'temp', 'normal' ], # Modify the authinfo passed into authenticate by merging # these hashes into the realm's authenticate call: authinfo_munge => { normal => { 'type' => 'normal' }, temp => { 'type' => 'temporary' }, } }, normal => { credential => { class => 'Password', password_field => 'secret', password_type => 'hashed', password_hash_type => 'SHA-1', }, store => { class => 'DBIx::Class', user_model => 'Schema::Person::Identity', id_field => 'id', } }, temp => { credential => { class => 'Password', password_field => 'secret', password_type => 'hashed', password_hash_type => 'SHA-1', }, store => { class => 'DBIx::Class', user_model => 'Schema::Person::Identity', id_field => 'id', } }, } } ); Then, in your controller code, to attempt authentication against both realms you just have to do a simple authenticate call: if ( $c->authenticate({ id => $username, password => $password }) ) { if ( $c->user->type eq 'temporary' ) { # Force user to change password } } =head1 CONFIGURATION =over =item realms An array reference consisting of each realm to attempt authentication against, in the order listed. If the realm does not exist, calling authenticate will die. =item authinfo_munge A hash reference keyed by realm names, with values being hash references to merge into the authinfo call that is subsequently passed into the realm's authenticate method. This is useful if your store uses the same class for each realm, separated by some other token (in the L authinfo_mungesection, the 'realm' is a column on C that will be either 'temp' or 'local', to ensure the query to fetch the user finds the right Identity record for that realm. =back =head1 METHODS =head2 new ($realmname, $config, $app) Constructs an instance of this realm. =head2 authenticate This method iteratively calls each realm listed in the C configuration key. It returns after the first successful authentication call is done. =cut sub authenticate { my ( $self, $c, $authinfo ) = @_; my $realms = $self->config->{realms}; carp "No realms to authenticate against, check configuration" unless $realms; carp "Realms configuration must be an array reference" unless ref $realms eq 'ARRAY'; foreach my $realm_name ( @$realms ) { my $realm = $c->get_auth_realm( $realm_name ); carp "Unable to find realm: $realm_name, check configuration" unless $realm; my $auth = { %$authinfo }; $auth->{realm} ||= $realm->name; if ( my $info = $self->config->{authinfo_munge}->{$realm->name} ) { $auth = Catalyst::Utils::merge_hashes($auth, $info); } if ( my $obj = $realm->authenticate( $c, $auth ) ) { $c->set_authenticated( $obj, $realm->name ); return $obj; } } return; } ## we can not rely on inheriting new() because in this case we do not ## load a credential or store, which is what new() sets up in the ## standard realm. So we have to create our realm object, set our name ## and return $self in order to avoid nasty warnings. sub new { my ($class, $realmname, $config, $app) = @_; my $self = { config => $config }; bless $self, $class; $self->name($realmname); return $self; } =head1 AUTHORS J. Shirley C<< >> Jay Kuri C<< >> =head1 COPYRIGHT & LICENSE Copyright (c) 2008 the aforementioned authors. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Authentication/Credential/NoPassword.pm000644 000765 000024 00000003350 12073067276 031552 0ustar00t0mstaff000000 000000 package Catalyst::Authentication::Credential::NoPassword; use Moose; use utf8; has 'realm' => (is => 'ro', required => 1); around BUILDARGS => sub { my $orig = shift; my $class = shift; if ( @_ == 3 ) { my ($config, $app, $realm) = @_; return $class->$orig( realm => $realm ); } else { return $class->$orig(@_); } }; sub authenticate { my ($self, $c, $realm, $authinfo) = @_; $self->realm->find_user($authinfo, $c); } 1; __END__ =head1 NAME Catalyst::Authentication::Credential::NoPassword - Authenticate a user without a password. =head1 SYNOPSIS use Catalyst qw/ Authentication /; package MyApp::Controller::Auth; sub login_as_another_user : Local { my ($self, $c) = @_; if ($c->user_exists() and $c->user->username() eq 'root') { $c->authenticate( {id => c->req->params->{user_id}}, 'nopassword' ); } } =head1 DESCRIPTION This authentication credential checker takes authentication information (most often a username) and retrieves the user from the store. No validation of any credentials is done. This is intended for administrative backdoors, SAML logins and so on when you have identified the new user by other means. =head1 CONFIGURATION # example class = NoPassword class = DBIx::Class user_model = DB::User role_relation = roles role_field = name =head1 METHODS =head2 authenticate ( $c, $realm, $authinfo ) Try to log a user in. =cut Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Authentication/Credential/Password.pm000644 000765 000024 00000022154 11773557437 031271 0ustar00t0mstaff000000 000000 package Catalyst::Authentication::Credential::Password; use Moose; use namespace::autoclean; with 'MooseX::Emulate::Class::Accessor::Fast'; use Scalar::Util (); use Catalyst::Exception (); use Digest (); __PACKAGE__->mk_accessors(qw/_config realm/); sub new { my ($class, $config, $app, $realm) = @_; # Note _config is horrible back compat hackery! my $self = { _config => $config }; bless $self, $class; $self->realm($realm); $self->_config->{'password_field'} ||= 'password'; $self->_config->{'password_type'} ||= 'clear'; $self->_config->{'password_hash_type'} ||= 'SHA-1'; my $passwordtype = $self->_config->{'password_type'}; if (!grep /$passwordtype/, ('none', 'clear', 'hashed', 'salted_hash', 'crypted', 'self_check')) { Catalyst::Exception->throw(__PACKAGE__ . " used with unsupported password type: " . $self->_config->{'password_type'}); } return $self; } sub authenticate { my ( $self, $c, $realm, $authinfo ) = @_; ## because passwords may be in a hashed format, we have to make sure that we remove the ## password_field before we pass it to the user routine, as some auth modules use ## all data passed to them to find a matching user... my $userfindauthinfo = {%{$authinfo}}; delete($userfindauthinfo->{$self->_config->{'password_field'}}); my $user_obj = $realm->find_user($userfindauthinfo, $c); if (ref($user_obj)) { if ($self->check_password($user_obj, $authinfo)) { return $user_obj; } } else { $c->log->debug( 'Unable to locate user matching user info provided in realm: ' . $realm->name ) if $c->debug; return; } } sub check_password { my ( $self, $user, $authinfo ) = @_; if ($self->_config->{'password_type'} eq 'self_check') { return $user->check_password($authinfo->{$self->_config->{'password_field'}}); } else { my $password = $authinfo->{$self->_config->{'password_field'}}; my $storedpassword = $user->get($self->_config->{'password_field'}); if ($self->_config->{'password_type'} eq 'none') { return 1; } elsif ($self->_config->{'password_type'} eq 'clear') { # FIXME - Should we warn in the $storedpassword undef case, # as the user probably fluffed the config? return unless defined $storedpassword; return $password eq $storedpassword; } elsif ($self->_config->{'password_type'} eq 'crypted') { return $storedpassword eq crypt( $password, $storedpassword ); } elsif ($self->_config->{'password_type'} eq 'salted_hash') { require Crypt::SaltedHash; my $salt_len = $self->_config->{'password_salt_len'} ? $self->_config->{'password_salt_len'} : 0; return Crypt::SaltedHash->validate( $storedpassword, $password, $salt_len ); } elsif ($self->_config->{'password_type'} eq 'hashed') { my $d = Digest->new( $self->_config->{'password_hash_type'} ); $d->add( $self->_config->{'password_pre_salt'} || '' ); $d->add($password); $d->add( $self->_config->{'password_post_salt'} || '' ); my $computed = $d->clone()->digest; my $b64computed = $d->clone()->b64digest; return ( ( $computed eq $storedpassword ) || ( unpack( "H*", $computed ) eq $storedpassword ) || ( $b64computed eq $storedpassword) || ( $b64computed.'=' eq $storedpassword) ); } } } __PACKAGE__; __END__ =pod =head1 NAME Catalyst::Authentication::Credential::Password - Authenticate a user with a password. =head1 SYNOPSIS use Catalyst qw/ Authentication /; package MyApp::Controller::Auth; sub login : Local { my ( $self, $c ) = @_; $c->authenticate( { username => $c->req->param('username'), password => $c->req->param('password') }); } =head1 DESCRIPTION This authentication credential checker takes authentication information (most often a username) and a password, and attempts to validate the password provided against the user retrieved from the store. =head1 CONFIGURATION # example __PACKAGE__->config('Plugin::Authentication' => { default_realm => 'members', realms => { members => { credential => { class => 'Password', password_field => 'password', password_type => 'hashed', password_hash_type => 'SHA-1' }, ... The password module is capable of working with several different password encryption/hashing algorithms. The one the module uses is determined by the credential configuration. Those who have used L prior to the 0.10 release should note that the password field and type information is no longer part of the store configuration and is now part of the Password credential configuration. =over 4 =item class The classname used for Credential. This is part of L and is the method by which Catalyst::Authentication::Credential::Password is loaded as the credential validator. For this module to be used, this must be set to 'Password'. =item password_field The field in the user object that contains the password. This will vary depending on the storage class used, but is most likely something like 'password'. In fact, this is so common that if this is left out of the config, it defaults to 'password'. This field is obtained from the user object using the get() method. Essentially: $user->get('passwordfieldname'); B If the password_field is something other than 'password', you must be sure to use that same field name when calling $c->authenticate(). =item password_type This sets the password type. Often passwords are stored in crypted or hashed formats. In order for the password module to verify the plaintext password passed in, it must be told what format the password will be in when it is retreived from the user object. The supported options are: =over 8 =item none No password check is done. An attempt is made to retrieve the user based on the information provided in the $c->authenticate() call. If a user is found, authentication is considered to be successful. =item clear The password in user is in clear text and will be compared directly. =item self_check This option indicates that the password should be passed to the check_password() routine on the user object returned from the store. =item crypted The password in user is in UNIX crypt hashed format. =item salted_hash The password in user is in salted hash format, and will be validated using L. If this password type is selected, you should also provide the B config element to define the salt length. =item hashed If the user object supports hashed passwords, they will be used in conjunction with L. The following config elements affect the hashed configuration: =over 8 =item password_hash_type The hash type used, passed directly to L. =item password_pre_salt Any pre-salt data to be passed to L before processing the password. =item password_post_salt Any post-salt data to be passed to L after processing the password. =back =back =back =head1 USAGE The Password credential module is very simple to use. Once configured as indicated above, authenticating using this module is simply a matter of calling $c->authenticate() with an authinfo hashref that includes the B element. The password element should contain the password supplied by the user to be authenticated, in clear text. The other information supplied in the auth hash is ignored by the Password module, and simply passed to the auth store to be used to retrieve the user. An example call follows: if ($c->authenticate({ username => $username, password => $password} )) { # authentication successful } else { # authentication failed } =head1 METHODS There are no publicly exported routines in the Password module (or indeed in most credential modules.) However, below is a description of the routines required by L for all credential modules. =head2 new( $config, $app, $realm ) Instantiate a new Password object using the configuration hash provided in $config. A reference to the application is provided as the second argument. Note to credential module authors: new() is called during the application's plugin setup phase, which is before the application specific controllers are loaded. The practical upshot of this is that things like $c->model(...) will not function as expected. =head2 authenticate( $authinfo, $c ) Try to log a user in, receives a hashref containing authentication information as the first argument, and the current context as the second. =head2 check_password( ) =cut Catalyst-Plugin-Authentication-0.10023/lib/Catalyst/Authentication/Credential/Remote.pm000644 000765 000024 00000030560 12131605711 030674 0ustar00t0mstaff000000 000000 package Catalyst::Authentication::Credential::Remote; use Moose; use namespace::autoclean; with 'MooseX::Emulate::Class::Accessor::Fast'; use Try::Tiny qw/ try catch /; __PACKAGE__->mk_accessors( qw/allow_re deny_re cutname_re source realm username_field/); sub new { my ( $class, $config, $app, $realm ) = @_; my $self = { }; bless $self, $class; # we are gonna compile regular expresions defined in config parameters # and explicitly throw an exception saying what parameter was invalid if (defined($config->{allow_regexp}) && ($config->{allow_regexp} ne "")) { try { $self->allow_re( qr/$config->{allow_regexp}/ ) } catch { Catalyst::Exception->throw( "Invalid regular expression in ". "'allow_regexp' configuration parameter"); }; } if (defined($config->{deny_regexp}) && ($config->{deny_regexp} ne "")) { try { $self->deny_re( qr/$config->{deny_regexp}/ ) } catch { Catalyst::Exception->throw( "Invalid regular expression in ". "'deny_regexp' configuration parameter"); }; } if (defined($config->{cutname_regexp}) && ($config->{cutname_regexp} ne "")) { try { $self->cutname_re( qr/$config->{cutname_regexp}/ ) } catch { Catalyst::Exception->throw( "Invalid regular expression in ". "'cutname_regexp' configuration parameter"); }; } $self->source($config->{source} || 'REMOTE_USER'); $self->realm($realm); $self->username_field($config->{username_field} || 'username'); return $self; } sub authenticate { my ( $self, $c, $realm, $authinfo ) = @_; my $remuser; if ($self->source eq "REMOTE_USER") { # compatibility hack: if ($c->engine->can('env') && defined($c->engine->env)) { # BEWARE: $c->engine->env was broken prior 5.80005 $remuser = $c->engine->env->{REMOTE_USER}; } elsif ($c->req->can('remote_user')) { # $c->req->remote_users was introduced in 5.80005; if not evailable we are # gonna use $c->req->user that is deprecated but more or less works as well $remuser = $c->req->remote_user; } elsif ($c->req->can('user')) { # maybe show warning that we are gonna use DEPRECATED $req->user if (ref($c->req->user)) { # I do not know exactly when this happens but it happens Catalyst::Exception->throw( "Cannot get remote user from ". "\$c->req->user as it seems to be a reference not a string" ); } else { $remuser = $c->req->user; } } } elsif ($self->source =~ /^(SSL_CLIENT_.*|CERT_*|AUTH_USER)$/) { # if you are using 'exotic' webserver or if the user is # authenticated e.g via SSL certificate his name could be avaliable # in different variables # BEWARE: $c->engine->env was broken prior 5.80005 my $nam=$self->source; if ($c->engine->can('env')) { $remuser = $c->engine->env->{$nam}; } else { # this happens on Catalyst 5.80004 and before (when using FastCGI) Catalyst::Exception->throw( "Cannot handle parameter 'source=$nam'". " as runnig Catalyst engine has broken \$c->engine->env" ); } } else { Catalyst::Exception->throw( "Invalid value of 'source' parameter"); } return unless defined($remuser); return if ($remuser eq ""); # $authinfo hash can contain item username (it is optional) - if it is so # this username has to be equal to remote_user my $authuser = $authinfo->{username}; return if (defined($authuser) && ($authuser ne $remuser)); # handle deny / allow checks return if (defined($self->deny_re) && ($remuser =~ $self->deny_re)); return if (defined($self->allow_re) && ($remuser !~ $self->allow_re)); # if param cutname_regexp is specified we try to cut the final usename as a # substring from remote_user my $usr = $remuser; if (defined($self->cutname_re)) { if (($remuser =~ $self->cutname_re) && ($1 ne "")) { $usr = $1; } } $authinfo->{ $self->username_field } = $usr; my $user_obj = $realm->find_user( $authinfo, $c ); return ref($user_obj) ? $user_obj : undef; } 1; __END__ =pod =head1 NAME Catalyst::Authentication::Credential::Remote - Let the webserver (e.g. Apache) authenticate Catalyst application users =head1 SYNOPSIS # in your MyApp.pm __PACKAGE__->config( 'Plugin::Authentication' => { default_realm => 'remoterealm', realms => { remoterealm => { credential => { class => 'Remote', allow_regexp => '^(user.*|admin|guest)$', deny_regexp => 'test', }, store => { class => 'Null', # if you want to have some additional user attributes # like user roles, user full name etc. you can specify # here the store where you keep this data } }, }, }, ); # in your Controller/Root.pm you can implement "auto-login" in this way sub begin : Private { my ( $self, $c ) = @_; unless ($c->user_exists) { # authenticate() for this module does not need any user info # as the username is taken from $c->req->remote_user and # password is not needed unless ($c->authenticate( {} )) { # return 403 forbidden or kick out the user in other way }; } } # or you can implement in any controller an ordinary login action like this sub login : Global { my ( $self, $c ) = @_; $c->authenticate( {} ); } =head1 DESCRIPTION This module allows you to authenticate the users of your Catalyst application on underlaying webserver. The complete list of authentication method available via this module depends just on what your webserver (e.g. Apache, IIS, Lighttpd) is able to handle. Besides the common methods like HTTP Basic and Digest authentication you can also use sophisticated ones like so called "integrated authentication" via NTLM or Kerberos (popular in corporate intranet applications running in Windows Active Directory environment) or even the SSL authentication when users authenticate themself using their client SSL certificates. The main idea of this module is based on a fact that webserver passes the name of authenticated user into Catalyst application as REMOTE_USER variable (or in case of SSL client authentication in other variables like SSL_CLIENT_S_DN on Apache + mod_ssl) - from this point referenced as WEBUSER. This module simply takes this value - perfoms some optional checks (see below) - and if everything is OK the WEBUSER is declared as authenticated on Catalyst level. In fact this module does not perform any check for password or other credential; it simply believes the webserver that user was properly authenticated. =head1 CONFIG =head2 class This config item is B. B is part of the core L module, it contains the class name of the store to be used. The classname used for Credential. This is part of L and is the method by which Catalyst::Authentication::Credential::Remote is loaded as the credential validator. For this module to be used, this must be set to 'Remote'. =head2 source This config item is B - default is REMOTE_USER. B contains a name of a variable passed from webserver that contains the user identification. Supported values: REMOTE_USER, SSL_CLIENT_*, CERT_*, AUTH_USER B Support for using different variables than REMOTE_USER does not work properly with Catalyst 5.8004 and before (if you want details see source code). Note1: Apache + mod_ssl uses SSL_CLIENT_S_DN, SSL_CLIENT_S_DN_* etc. (has to be enabled by 'SSLOption +StdEnvVars') or you can also let Apache make a copy of this value into REMOTE_USER (Apache option 'SSLUserName SSL_CLIENT_S_DN'). Note2: Microsoft IIS uses CERT_SUBJECT, CERT_SERIALNUMBER etc. for storing info about client authenticated via SSL certificate. AUTH_USER on IIS seems to have the same value as REMOTE_USER (but there might be some differences I am not aware of). =head2 deny_regexp This config item is B - no default value. B contains a regular expression used for check against WEBUSER (see details below) =head2 allow_regexp This config item is B - no default value. B contains a regular expression used for check against WEBUSER. Allow/deny checking of WEBUSER values goes in this way: 1) If B is defined and WEBUSER matches deny_regexp then authentication FAILS otherwise continues with next step. If deny_regexp is not defined or is an empty string we skip this step. 2) If B is defined and WEBUSER matches allow_regexp then authentication PASSES otherwise FAILS. If allow_regexp is not defined or is an empty string we skip this step. The order deny-allow is fixed. =head2 cutname_regexp This config item is B - no default value. If param B is specified we try to cut the final usename passed to Catalyst application as a substring from WEBUSER. This is useful for example in case of SSL authentication when WEBUSER looks like this 'CN=john, OU=Unit Name, O=Company, C=CZ' - from this format we can simply cut pure usename by cutname_regexp set to 'CN=(.*), OU=Unit Name, O=Company, C=CZ'. Substring is always taken as '$1' regexp substring. If WEBUSER does not match cutname_regexp at all or if '$1' regexp substring is empty we pass the original WEBUSER value (without cutting) to Catalyst application. =head2 username_field This config item is B - default is I The key name in the authinfo hash that the user's username is mapped into. This is useful for using a store which requires a specific unusual field name for the username. The username is additionally mapped onto the I key. =head1 METHODS =head2 new ( $config, $app, $realm ) Instantiate a new Catalyst::Authentication::Credential::Remote object using the configuration hash provided in $config. In case of invalid value of any configuration parameter (e.g. invalid regular expression) throws an exception. =cut =head2 authenticate ( $realm, $authinfo ) Takes the username form WEBUSER set by webserver, performs additional checks using optional allow_regexp/deny_regexp configuration params, optionaly takes substring from WEBUSER and the sets the resulting value as a Catalyst username. =cut =head1 COMPATIBILITY It is B to use this module with Catalyst 5.80005 and above as previous versions have some bugs related to $c->engine->env and do not support $c->req->remote_user. This module tries some workarounds when it detects an older version and should work as well. =head1 USING WITH A REVERSE PROXY If you are using a reverse proxy, then the WEBUSER will not be directly accessible by the Catalyst server. To use remote authentication, you will have to modify the web server to set a header containing the WEBUSER. You would then need to modify the PSGI configuration to map the header back to the WEBUSER variable. For example, in Apache you would add the configuration RequestHeader unset X-Forwarded-User RewriteEngine On RewriteCond %{LA-U:REMOTE_USER} (.+) RewriteRule . - [E=RU:%1] RequestHeader set X-Forwarded-User %{RU}e You then need to create a Plack::Middleware module to map the header back to the WEBUSER: package Plack::Middleware::MyRemote; use parent qw( Plack::Middleware ); use Plack::Util; sub call { my ($self, $env) = @_; my $user = $env->{HTTP_X_FORWARDED_USER} // ""; $env->{REMOTE_USER} = $user if ($user && ($user ne '(null)')); my $res = $self->app->($env); return $res; } 1; Finally, you need to modify F to use the custom middleware: use strict; use warnings; use MyApp; use Plack::Builder; my $app = Drain->apply_default_middlewares(Drain->psgi_app); builder { enable "Plack::Middleware::MyRemote"; $app; }; =cut Catalyst-Plugin-Authentication-0.10023/inc/Module/000755 000765 000024 00000000000 12131606106 021511 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/inc/Module/AutoInstall.pm000644 000765 000024 00000062162 12131606053 024316 0ustar00t0mstaff000000 000000 #line 1 package Module::AutoInstall; use strict; use Cwd (); use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # special map on pre-defined feature sets my %FeatureMap = ( '' => 'Core Features', # XXX: deprecated '-core' => 'Core Features', ); # various lexical flags my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $InstallDepsTarget, $HasCPANPLUS ); my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps, $UpgradeDeps ); my ( $PostambleActions, $PostambleActionsNoTest, $PostambleActionsUpgradeDeps, $PostambleActionsUpgradeDepsNoTest, $PostambleActionsListDeps, $PostambleActionsListAllDeps, $PostambleUsed, $NoTest); # See if it's a testing or non-interactive session _accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN ); _init(); sub _accept_default { $AcceptDefault = shift; } sub _installdeps_target { $InstallDepsTarget = shift; } sub missing_modules { return @Missing; } sub do_install { __PACKAGE__->install( [ $Config ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) : () ], @Missing, ); } # initialize various flags, and/or perform install sub _init { foreach my $arg ( @ARGV, split( /[\s\t]+/, $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || '' ) ) { if ( $arg =~ /^--config=(.*)$/ ) { $Config = [ split( ',', $1 ) ]; } elsif ( $arg =~ /^--installdeps=(.*)$/ ) { __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--upgradedeps=(.*)$/ ) { $UpgradeDeps = 1; __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--default(?:deps)?$/ ) { $AcceptDefault = 1; } elsif ( $arg =~ /^--check(?:deps)?$/ ) { $CheckOnly = 1; } elsif ( $arg =~ /^--skip(?:deps)?$/ ) { $SkipInstall = 1; } elsif ( $arg =~ /^--test(?:only)?$/ ) { $TestOnly = 1; } elsif ( $arg =~ /^--all(?:deps)?$/ ) { $AllDeps = 1; } } } # overrides MakeMaker's prompt() to automatically accept the default choice sub _prompt { goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault; my ( $prompt, $default ) = @_; my $y = ( $default =~ /^[Yy]/ ); print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] '; print "$default\n"; return $default; } # the workhorse sub import { my $class = shift; my @args = @_ or return; my $core_all; print "*** $class version " . $class->VERSION . "\n"; print "*** Checking for Perl dependencies...\n"; my $cwd = Cwd::cwd(); $Config = []; my $maxlen = length( ( sort { length($b) <=> length($a) } grep { /^[^\-]/ } map { ref($_) ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} ) : '' } map { +{@args}->{$_} } grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} } )[0] ); # We want to know if we're under CPAN early to avoid prompting, but # if we aren't going to try and install anything anyway then skip the # check entirely since we don't want to have to load (and configure) # an old CPAN just for a cosmetic message $UnderCPAN = _check_lock(1) unless $SkipInstall || $InstallDepsTarget; while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) { my ( @required, @tests, @skiptests ); my $default = 1; my $conflict = 0; if ( $feature =~ m/^-(\w+)$/ ) { my $option = lc($1); # check for a newer version of myself _update_to( $modules, @_ ) and return if $option eq 'version'; # sets CPAN configuration options $Config = $modules if $option eq 'config'; # promote every features to core status $core_all = ( $modules =~ /^all$/i ) and next if $option eq 'core'; next unless $option eq 'core'; } print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n"; $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' ); unshift @$modules, -default => &{ shift(@$modules) } if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) { if ( $mod =~ m/^-(\w+)$/ ) { my $option = lc($1); $default = $arg if ( $option eq 'default' ); $conflict = $arg if ( $option eq 'conflict' ); @tests = @{$arg} if ( $option eq 'tests' ); @skiptests = @{$arg} if ( $option eq 'skiptests' ); next; } printf( "- %-${maxlen}s ...", $mod ); if ( $arg and $arg =~ /^\D/ ) { unshift @$modules, $arg; $arg = 0; } # XXX: check for conflicts and uninstalls(!) them. my $cur = _version_of($mod); if (_version_cmp ($cur, $arg) >= 0) { print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n"; push @Existing, $mod => $arg; $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { if (not defined $cur) # indeed missing { print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n"; } else { # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above print "too old. ($cur < $arg)\n"; } push @required, $mod => $arg; } } next unless @required; my $mandatory = ( $feature eq '-core' or $core_all ); if ( !$SkipInstall and ( $CheckOnly or ($mandatory and $UnderCPAN) or $AllDeps or $InstallDepsTarget or _prompt( qq{==> Auto-install the } . ( @required / 2 ) . ( $mandatory ? ' mandatory' : ' optional' ) . qq{ module(s) from CPAN?}, $default ? 'y' : 'n', ) =~ /^[Yy]/ ) ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } elsif ( !$SkipInstall and $default and $mandatory and _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', ) =~ /^[Nn]/ ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { $DisabledTests{$_} = 1 for map { glob($_) } @tests; } } if ( @Missing and not( $CheckOnly or $UnderCPAN) ) { require Config; my $make = $Config::Config{make}; if ($InstallDepsTarget) { print "*** To install dependencies type '$make installdeps' or '$make installdeps_notest'.\n"; } else { print "*** Dependencies will be installed the next time you type '$make'.\n"; } # make an educated guess of whether we'll need root permission. print " (You may need to do that as the 'root' user.)\n" if eval '$>'; } print "*** $class configuration finished.\n"; chdir $cwd; # import to main:: no strict 'refs'; *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main'; return (@Existing, @Missing); } sub _running_under { my $thing = shift; print <<"END_MESSAGE"; *** Since we're running under ${thing}, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } # Check to see if we are currently running under CPAN.pm and/or CPANPLUS; # if we are, then we simply let it taking care of our dependencies sub _check_lock { return unless @Missing or @_; if ($ENV{PERL5_CPANM_IS_RUNNING}) { return _running_under('cpanminus'); } my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING}; if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) { return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS'); } require CPAN; if ($CPAN::VERSION > '1.89') { if ($cpan_env) { return _running_under('CPAN'); } return; # CPAN.pm new enough, don't need to check further } # last ditch attempt, this -will- configure CPAN, very sorry _load_cpan(1); # force initialize even though it's already loaded # Find the CPAN lock-file my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" ); return unless -f $lock; # Check the lock local *LOCK; return unless open(LOCK, $lock); if ( ( $^O eq 'MSWin32' ? _under_cpan() : == getppid() ) and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore' ) { print <<'END_MESSAGE'; *** Since we're running under CPAN, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } close LOCK; return; } sub install { my $class = shift; my $i; # used below to strip leading '-' from config keys my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } ); my ( @modules, @installed ); while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) { # grep out those already installed if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) { push @installed, $pkg; } else { push @modules, $pkg, $ver; } } if ($UpgradeDeps) { push @modules, @installed; @installed = (); } return @installed unless @modules; # nothing to do return @installed if _check_lock(); # defer to the CPAN shell print "*** Installing dependencies...\n"; return unless _connected_to('cpan.org'); my %args = @config; my %failed; local *FAILED; if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) { while () { chomp; $failed{$_}++ } close FAILED; my @newmod; while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) { push @newmod, ( $k => $v ) unless $failed{$k}; } @modules = @newmod; } if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) { _install_cpanplus( \@modules, \@config ); } else { _install_cpan( \@modules, \@config ); } print "*** $class installation finished.\n"; # see if we have successfully installed them while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) { push @installed, $pkg; } elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) { print FAILED "$pkg\n"; } } close FAILED if $args{do_once}; return @installed; } sub _install_cpanplus { my @modules = @{ +shift }; my @config = _cpanplus_config( @{ +shift } ); my $installed = 0; require CPANPLUS::Backend; my $cp = CPANPLUS::Backend->new; my $conf = $cp->configure_object; return unless $conf->can('conf') # 0.05x+ with "sudo" support or _can_write($conf->_get_build('base')); # 0.04x # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $conf->get_conf('makeflags') || ''; if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) { # 0.03+ uses a hashref here $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; } else { # 0.02 and below uses a scalar $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); } $conf->set_conf( makeflags => $makeflags ); $conf->set_conf( prereqs => 1 ); while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) { $conf->set_conf( $key, $val ); } my $modtree = $cp->module_tree; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { print "*** Installing $pkg...\n"; MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; my $success; my $obj = $modtree->{$pkg}; if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $cp->install( modules => [ $obj->{module} ] ); if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation cancelled.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _cpanplus_config { my @config = (); while ( @_ ) { my ($key, $value) = (shift(), shift()); if ( $key eq 'prerequisites_policy' ) { if ( $value eq 'follow' ) { $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL(); } elsif ( $value eq 'ask' ) { $value = CPANPLUS::Internals::Constants::PREREQ_ASK(); } elsif ( $value eq 'ignore' ) { $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE(); } else { die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n"; } push @config, 'prereqs', $value; } elsif ( $key eq 'force' ) { push @config, $key, $value; } elsif ( $key eq 'notest' ) { push @config, 'skiptest', $value; } else { die "*** Cannot convert option $key to CPANPLUS version.\n"; } } return @config; } sub _install_cpan { my @modules = @{ +shift }; my @config = @{ +shift }; my $installed = 0; my %args; _load_cpan(); require Config; if (CPAN->VERSION < 1.80) { # no "sudo" support, probe for writableness return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) ) and _can_write( $Config::Config{sitelib} ); } # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $CPAN::Config->{make_install_arg} || ''; $CPAN::Config->{make_install_arg} = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); # don't show start-up info $CPAN::Config->{inhibit_startup_message} = 1; # set additional options while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) { ( $args{$opt} = $arg, next ) if $opt =~ /^(?:force|notest)$/; # pseudo-option $CPAN::Config->{$opt} = $arg; } if ($args{notest} && (not CPAN::Shell->can('notest'))) { die "Your version of CPAN is too old to support the 'notest' pragma"; } local $CPAN::Config->{prerequisites_policy} = 'follow'; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; print "*** Installing $pkg...\n"; my $obj = CPAN::Shell->expand( Module => $pkg ); my $success = 0; if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = do { if ($args{force}) { CPAN::Shell->force( install => $pkg ) } elsif ($args{notest}) { CPAN::Shell->notest( install => $pkg ) } else { CPAN::Shell->install($pkg) } }; $rv ||= eval { $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, ) ->{install} if $CPAN::META; }; if ( $rv eq 'YES' ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation failed.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _has_cpanplus { return ( $HasCPANPLUS = ( $INC{'CPANPLUS/Config.pm'} or _load('CPANPLUS::Shell::Default') ) ); } # make guesses on whether we're under the CPAN installation directory sub _under_cpan { require Cwd; require File::Spec; my $cwd = File::Spec->canonpath( Cwd::cwd() ); my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} ); return ( index( $cwd, $cpan ) > -1 ); } sub _update_to { my $class = __PACKAGE__; my $ver = shift; return if _version_cmp( _version_of($class), $ver ) >= 0; # no need to upgrade if ( _prompt( "==> A newer version of $class ($ver) is required. Install?", 'y' ) =~ /^[Nn]/ ) { die "*** Please install $class $ver manually.\n"; } print << "."; *** Trying to fetch it from CPAN... . # install ourselves _load($class) and return $class->import(@_) if $class->install( [], $class, $ver ); print << '.'; exit 1; *** Cannot bootstrap myself. :-( Installation terminated. . } # check if we're connected to some host, using inet_aton sub _connected_to { my $site = shift; return ( ( _load('Socket') and Socket::inet_aton($site) ) or _prompt( qq( *** Your host cannot resolve the domain name '$site', which probably means the Internet connections are unavailable. ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/ ); } # check if a directory is writable; may create it on demand sub _can_write { my $path = shift; mkdir( $path, 0755 ) unless -e $path; return 1 if -w $path; print << "."; *** You are not allowed to write to the directory '$path'; the installation may fail due to insufficient permissions. . if ( eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt( qq( ==> Should we try to re-execute the autoinstall process with 'sudo'?), ((-t STDIN) ? 'y' : 'n') ) =~ /^[Yy]/ ) { # try to bootstrap ourselves from sudo print << "."; *** Trying to re-execute the autoinstall process with 'sudo'... . my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; return unless system( 'sudo', $^X, $0, "--config=$config", "--installdeps=$missing" ); print << "."; *** The 'sudo' command exited with error! Resuming... . } return _prompt( qq( ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/; } # load a module and return the version it reports sub _load { my $mod = pop; # method/function doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; local $@; return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 ); } # report version without loading a module sub _version_of { my $mod = pop; # method/function doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; foreach my $dir ( @INC ) { next if ref $dir; my $path = File::Spec->catfile($dir, $file); next unless -e $path; require ExtUtils::MM_Unix; return ExtUtils::MM_Unix->parse_version($path); } return undef; } # Load CPAN.pm and it's configuration sub _load_cpan { return if $CPAN::VERSION and $CPAN::Config and not @_; require CPAN; # CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to # CPAN::HandleConfig->load. CPAN reports that the redirection # is deprecated in a warning printed at the user. # CPAN-1.81 expects CPAN::HandleConfig->load, does not have # $CPAN::HandleConfig::VERSION but cannot handle # CPAN::Config->load # Which "versions expect CPAN::Config->load? if ( $CPAN::HandleConfig::VERSION || CPAN::HandleConfig->can('load') ) { # Newer versions of CPAN have a HandleConfig module CPAN::HandleConfig->load; } else { # Older versions had the load method in Config directly CPAN::Config->load; } } # compare two versions, either use Sort::Versions or plain comparison # return values same as <=> sub _version_cmp { my ( $cur, $min ) = @_; return -1 unless defined $cur; # if 0 keep comparing return 1 unless $min; $cur =~ s/\s+$//; # check for version numbers that are not in decimal format if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) { if ( ( $version::VERSION or defined( _load('version') )) and version->can('new') ) { # use version.pm if it is installed. return version->new($cur) <=> version->new($min); } elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) ) { # use Sort::Versions as the sorting algorithm for a.b.c versions return Sort::Versions::versioncmp( $cur, $min ); } warn "Cannot reliably compare non-decimal formatted versions.\n" . "Please install version.pm or Sort::Versions.\n"; } # plain comparison local $^W = 0; # shuts off 'not numeric' bugs return $cur <=> $min; } # nothing; this usage is deprecated. sub main::PREREQ_PM { return {}; } sub _make_args { my %args = @_; $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing } if $UnderCPAN or $TestOnly; if ( $args{EXE_FILES} and -e 'MANIFEST' ) { require ExtUtils::Manifest; my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); $args{EXE_FILES} = [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ]; } $args{test}{TESTS} ||= 't/*.t'; $args{test}{TESTS} = join( ' ', grep { !exists( $DisabledTests{$_} ) } map { glob($_) } split( /\s+/, $args{test}{TESTS} ) ); my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; $PostambleActions = ( ($missing and not $UnderCPAN) ? "\$(PERL) $0 --config=$config --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); my $deps_list = join( ',', @Missing, @Existing ); $PostambleActionsUpgradeDeps = "\$(PERL) $0 --config=$config --upgradedeps=$deps_list"; my $config_notest = join( ',', (UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config}), 'notest', 1 ) if $Config; $PostambleActionsNoTest = ( ($missing and not $UnderCPAN) ? "\$(PERL) $0 --config=$config_notest --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); $PostambleActionsUpgradeDepsNoTest = "\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list"; $PostambleActionsListDeps = '@$(PERL) -le "print for @ARGV" ' . join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing); my @all = (@Missing, @Existing); $PostambleActionsListAllDeps = '@$(PERL) -le "print for @ARGV" ' . join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all); return %args; } # a wrapper to ExtUtils::MakeMaker::WriteMakefile sub Write { require Carp; Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; if ($CheckOnly) { print << "."; *** Makefile not written in check-only mode. . return; } my %args = _make_args(@_); no strict 'refs'; $PostambleUsed = 0; local *MY::postamble = \&postamble unless defined &MY::postamble; ExtUtils::MakeMaker::WriteMakefile(%args); print << "." unless $PostambleUsed; *** WARNING: Makefile written with customized MY::postamble() without including contents from Module::AutoInstall::postamble() -- auto installation features disabled. Please contact the author. . return 1; } sub postamble { $PostambleUsed = 1; my $fragment; $fragment .= <<"AUTO_INSTALL" if !$InstallDepsTarget; config :: installdeps \t\$(NOECHO) \$(NOOP) AUTO_INSTALL $fragment .= <<"END_MAKE"; checkdeps :: \t\$(PERL) $0 --checkdeps installdeps :: \t$PostambleActions installdeps_notest :: \t$PostambleActionsNoTest upgradedeps :: \t$PostambleActionsUpgradeDeps upgradedeps_notest :: \t$PostambleActionsUpgradeDepsNoTest listdeps :: \t$PostambleActionsListDeps listalldeps :: \t$PostambleActionsListAllDeps END_MAKE return $fragment; } 1; __END__ #line 1193 Catalyst-Plugin-Authentication-0.10023/inc/Module/Install/000755 000765 000024 00000000000 12131606106 023117 5ustar00t0mstaff000000 000000 Catalyst-Plugin-Authentication-0.10023/inc/Module/Install.pm000644 000765 000024 00000030135 12131606052 023457 0ustar00t0mstaff000000 000000 #line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.06'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. Catalyst-Plugin-Authentication-0.10023/inc/Module/Install/Authority.pm000644 000765 000024 00000000444 12131606053 025450 0ustar00t0mstaff000000 000000 #line 1 package Module::Install::Authority; use strict; use warnings; use base qw/Module::Install::Base/; our $VERSION = '0.02'; $VERSION = eval $VERSION; sub authority { my $self = shift; my $pause_id = shift; $self->Meta->{values}->{x_authority} = $pause_id; } 1; #line 69 Catalyst-Plugin-Authentication-0.10023/inc/Module/Install/AuthorRequires.pm000644 000765 000024 00000001131 12131606053 026434 0ustar00t0mstaff000000 000000 #line 1 use strict; use warnings; package Module::Install::AuthorRequires; use base 'Module::Install::Base'; # cargo cult BEGIN { our $VERSION = '0.02'; our $ISCORE = 1; } sub author_requires { my $self = shift; return $self->{values}->{author_requires} unless @_; my @added; while (@_) { my $mod = shift or last; my $version = shift || 0; push @added, [$mod => $version]; } push @{ $self->{values}->{author_requires} }, @added; $self->admin->author_requires(@added); return map { @$_ } @added; } 1; __END__ #line 92 Catalyst-Plugin-Authentication-0.10023/inc/Module/Install/AuthorTests.pm000644 000765 000024 00000002215 12131606053 025743 0ustar00t0mstaff000000 000000 #line 1 package Module::Install::AuthorTests; use 5.005; use strict; use Module::Install::Base; use Carp (); #line 16 use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.002'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } #line 42 sub author_tests { my ($self, @dirs) = @_; _add_author_tests($self, \@dirs, 0); } #line 56 sub recursive_author_tests { my ($self, @dirs) = @_; _add_author_tests($self, \@dirs, 1); } sub _wanted { my $href = shift; sub { /\.t$/ and -f $_ and $href->{$File::Find::dir} = 1 } } sub _add_author_tests { my ($self, $dirs, $recurse) = @_; return unless $Module::Install::AUTHOR; my @tests = $self->tests ? (split / /, $self->tests) : 't/*.t'; # XXX: pick a default, later -- rjbs, 2008-02-24 my @dirs = @$dirs ? @$dirs : Carp::confess "no dirs given to author_tests"; @dirs = grep { -d } @dirs; if ($recurse) { require File::Find; my %test_dir; File::Find::find(_wanted(\%test_dir), @dirs); $self->tests( join ' ', @tests, map { "$_/*.t" } sort keys %test_dir ); } else { $self->tests( join ' ', @tests, map { "$_/*.t" } sort @dirs ); } } #line 107 1; Catalyst-Plugin-Authentication-0.10023/inc/Module/Install/AutoInstall.pm000644 000765 000024 00000004162 12131606053 025720 0ustar00t0mstaff000000 000000 #line 1 package Module::Install::AutoInstall; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub AutoInstall { $_[0] } sub run { my $self = shift; $self->auto_install_now(@_); } sub write { my $self = shift; $self->auto_install(@_); } sub auto_install { my $self = shift; return if $self->{done}++; # Flatten array of arrays into a single array my @core = map @$_, map @$_, grep ref, $self->build_requires, $self->requires; my @config = @_; # We'll need Module::AutoInstall $self->include('Module::AutoInstall'); require Module::AutoInstall; my @features_require = Module::AutoInstall->import( (@config ? (-config => \@config) : ()), (@core ? (-core => \@core) : ()), $self->features, ); my %seen; my @requires = map @$_, map @$_, grep ref, $self->requires; while (my ($mod, $ver) = splice(@requires, 0, 2)) { $seen{$mod}{$ver}++; } my @build_requires = map @$_, map @$_, grep ref, $self->build_requires; while (my ($mod, $ver) = splice(@build_requires, 0, 2)) { $seen{$mod}{$ver}++; } my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires; while (my ($mod, $ver) = splice(@configure_requires, 0, 2)) { $seen{$mod}{$ver}++; } my @deduped; while (my ($mod, $ver) = splice(@features_require, 0, 2)) { push @deduped, $mod => $ver unless $seen{$mod}{$ver}++; } $self->requires(@deduped); $self->makemaker_args( Module::AutoInstall::_make_args() ); my $class = ref($self); $self->postamble( "# --- $class section:\n" . Module::AutoInstall::postamble() ); } sub installdeps_target { my ($self, @args) = @_; $self->include('Module::AutoInstall'); require Module::AutoInstall; Module::AutoInstall::_installdeps_target(1); $self->auto_install(@args); } sub auto_install_now { my $self = shift; $self->auto_install(@_); Module::AutoInstall::do_install(); } 1; Catalyst-Plugin-Authentication-0.10023/inc/Module/Install/Base.pm000644 000765 000024 00000002147 12131606053 024334 0ustar00t0mstaff000000 000000 #line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 Catalyst-Plugin-Authentication-0.10023/inc/Module/Install/Can.pm000644 000765 000024 00000006157 12131606053 024170 0ustar00t0mstaff000000 000000 #line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 Catalyst-Plugin-Authentication-0.10023/inc/Module/Install/Fetch.pm000644 000765 000024 00000004627 12131606053 024520 0ustar00t0mstaff000000 000000 #line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Catalyst-Plugin-Authentication-0.10023/inc/Module/Install/Include.pm000644 000765 000024 00000001015 12131606053 025036 0ustar00t0mstaff000000 000000 #line 1 package Module::Install::Include; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub include { shift()->admin->include(@_); } sub include_deps { shift()->admin->include_deps(@_); } sub auto_include { shift()->admin->auto_include(@_); } sub auto_include_deps { shift()->admin->auto_include_deps(@_); } sub auto_include_dependent_dists { shift()->admin->auto_include_dependent_dists(@_); } 1; Catalyst-Plugin-Authentication-0.10023/inc/Module/Install/Makefile.pm000644 000765 000024 00000027437 12131606053 025210 0ustar00t0mstaff000000 000000 #line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 Catalyst-Plugin-Authentication-0.10023/inc/Module/Install/Metadata.pm000644 000765 000024 00000043277 12131606053 025213 0ustar00t0mstaff000000 000000 #line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; Catalyst-Plugin-Authentication-0.10023/inc/Module/Install/Win32.pm000644 000765 000024 00000003403 12131606053 024360 0ustar00t0mstaff000000 000000 #line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Catalyst-Plugin-Authentication-0.10023/inc/Module/Install/WriteAll.pm000644 000765 000024 00000002376 12131606053 025211 0ustar00t0mstaff000000 000000 #line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1;