--- /dev/null
+package Catalyst::Authentication::Credential::Password;
+
+use strict;
+use warnings;
+
+use base qw/Class::Accessor::Fast/;
+
+use Scalar::Util ();
+use Catalyst::Exception ();
+use Digest ();
+
+BEGIN {
+ __PACKAGE__->mk_accessors(qw/_config realm/);
+}
+
+sub new {
+ my ($class, $config, $app, $realm) = @_;
+
+ 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") 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') {
+ 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) );
+ }
+ }
+}
+
+## 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::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->{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<Catalyst::Plugin::Authentication> 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<Catalyst::Plugin::Authentication> 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');
+
+=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<Crypt::SaltedHash>. If this password type is selected, you should
+also provide the B<password_salt_len> config element to define the salt length.
+
+=item hashed
+
+If the user object supports hashed passwords, they will be used in conjunction
+with L<Digest>. The following config elements affect the hashed configuration:
+
+=over 8
+
+=item password_hash_type
+
+The hash type used, passed directly to L<Digest/new>.
+
+=item password_pre_salt
+
+Any pre-salt data to be passed to L<Digest/add> before processing the password.
+
+=item password_post_salt
+
+Any post-salt data to be passed to L<Digest/add> 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<password> 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<Catalyst::Plugin::Authentication> for all credential modules.
+
+=head2 new( $config, $app )
+
+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( )
+
+=head2 login( )
+
+=cut
-package Catalyst::Plugin::Authentication::Realm;
+package Catalyst::Authentication::Realm;
use strict;
use warnings;
=head1 NAME
-Catalyst::Plugin::Authentication::Realm - Base class for realm objects.
+Catalyst::Authentication::Realm - Base class for realm objects.
=head1 DESCRIPTION
-package Catalyst::Plugin::Authentication::Realm::Compatibility;
+package Catalyst::Authentication::Realm::Compatibility;
use strict;
use warnings;
-use base qw/Catalyst::Plugin::Authentication::Realm/;
+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
=head1 NAME
-Catalyst::Plugin::Authentication::Realm::Compatibility - Compatibility realm object
+Catalyst::Authentication::Realm::Compatibility - Compatibility realm object
=head1 DESCRIPTION
=head1 NAME
-Catalyst::Plugin::Authentication::Store - All about authentication stores
+Catalyst::Authentication::Store - All about authentication stores
=head1 MULTIPLE BACKENDS
L<Catalyst::Plugin::Authentication> prior to 0.10. This is NOT how the
new realm-based stores work. This is here for reference only.
-See L<Catalyst::Plugin::Authentication::Internals> instead.
+See L<Catalyst::Authentication::Internals> instead.
=head1 OLD STORE DOCUMENTATION BELOW
This method should accept an arbitrary list of parameters (determined by you or
the credential verifyer), and return an object inheriting
-L<Catalyst::Plugin::Authentication::User>.
+L<Catalyst::Authentication::User>.
For introspection purposes you can also define the C<user_supports> method. See
below for optional features. This is not necessary, but might be in the future.
sometimes it isn't (like an Htpasswd file).
If you are writing a backend that wraps around a module, like
-L<Catalyst::Plugin::Authentication::Store::Htpasswd> wraps around
+L<Catalyst::Authentication::Store::Htpasswd> wraps around
L<Authen::Htpasswd>, it makes sense to delegate the credential checks.
This particular example caused the following "feature" to be added:
$c->default_auth_store(
# a store can be an object or a class
- Catalyst::Plugin::Authentication::Store::Foo::Backend->new(
+ Catalyst::Authentication::Store::Foo::Backend->new(
...
)
);
--- /dev/null
+package Catalyst::Authentication::Store::Minimal;
+
+use strict;
+use warnings;
+
+use Catalyst::Authentication::User::Hash;
+use Scalar::Util qw( blessed );
+use base qw/Class::Accessor::Fast/;
+
+BEGIN {
+ __PACKAGE__->mk_accessors(qw/userhash/);
+}
+
+sub new {
+ my ( $class, $config, $app, $realm) = @_;
+
+ bless { userhash => $config->{'users'} }, $class;
+}
+
+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};
+
+ #print STDERR "FOO1! " . ref($user) . " - ". Scalar::Util::blessed($user) . "\n";
+
+ if ( ref($user) eq "HASH") {
+ $user->{id} ||= $id;
+ return bless $user, "Catalyst::Authentication::User::Hash";
+ } 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});
+}
+
+## backwards compatibility
+sub setup {
+ my $c = shift;
+
+ $c->default_auth_store(
+ __PACKAGE__->new(
+ $c->config->{authentication}, $c
+ )
+ );
+
+ $c->NEXT::setup(@_);
+}
+
+__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->{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<Catalyst::Plugin::Authentication> 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 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<Catalyst::Plugin::Authentication> 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<Catalyst::Authentication::User::Hash>.
+
+=head2 from_session( $id )
+
+Delegates to C<get_user>.
+
+=head2 user_supports( )
+
+Chooses a random user from the hash and delegates to it.
+
+=head2 get_user( )
+
+=head2 setup( )
+
+=cut
+
+
-package Catalyst::Plugin::Authentication::Store::Null;
+package Catalyst::Authentication::Store::Null;
use strict;
use warnings;
-use Catalyst::Plugin::Authentication::User::Hash;
+use Catalyst::Authentication::User::Hash;
use base qw( Class::Accessor::Fast );
sub find_user {
my ( $self, $userinfo, $c ) = @_;
- return bless $userinfo, 'Catalyst::Plugin::Authentication::User::Hash';
+ return bless $userinfo, 'Catalyst::Authentication::User::Hash';
}
sub user_supports {
my $self = shift;
- Catalyst::Plugin::Authentication::User::Hash->supports(@_);
+ Catalyst::Authentication::User::Hash->supports(@_);
}
1;
=head1 NAME
-Catalyst::Plugin::Authentication::Store::Null - Null authentication store
+Catalyst::Authentication::Store::Null - Null authentication store
=head1 SYNOPSIS
=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<Catalyst::Plugin::Authentication::User::Hash>
+the user info bless as a L<Catalyst::Authentication::User::Hash>
object.
=head2 user_supports( )
-Delegates to L<Catalyst::Plugin::Authentication::User::Hash>.
+Delegates to L<Catalyst::Authentication::User::Hash>.
=cut
-package Catalyst::Plugin::Authentication::User;
+package Catalyst::Authentication::User;
use strict;
use warnings;
=head1 NAME
-Catalyst::Plugin::Authentication::User - Base class for user objects.
+Catalyst::Authentication::User - Base class for user objects.
=head1 SYNOPSIS
package MyStore::User;
- use base qw/Catalyst::Plugin::Authentication::User/;
+ use base qw/Catalyst::Authentication::User/;
=head1 DESCRIPTION
-package Catalyst::Plugin::Authentication::User::Hash;
+package Catalyst::Authentication::User::Hash;
use strict;
use warnings;
-use base qw/Catalyst::Plugin::Authentication::User/;
+use base qw/Catalyst::Authentication::User/;
sub new {
my $class = shift;
=head1 NAME
-Catalyst::Plugin::Authentication::User::Hash - An easy authentication user
+Catalyst::Authentication::User::Hash - An easy authentication user
object based on hashes.
=head1 SYNOPSIS
- use Catalyst::Plugin::Authentication::User::Hash;
+ use Catalyst::Authentication::User::Hash;
- Catalyst::Plugin::Authentication::User::Hash->new(
+ Catalyst::Authentication::User::Hash->new(
password => "s3cr3t",
);
=head1 DESCRIPTION
This implementation of authentication user handles is supposed to go hand in
-hand with L<Catalyst::Plugin::Authentication::Store::Minimal>.
+hand with L<Catalyst::Authentication::Store::Minimal>.
=head1 METHODS
use Tie::RefHash;
use Class::Inspector;
-use Catalyst::Plugin::Authentication::Realm;
+use Catalyst::Authentication::Realm;
# this optimization breaks under Template::Toolkit
# use user_exists instead
my $realmclass = $config->{class};
if( !$realmclass ) {
- $realmclass = 'Catalyst::Plugin::Authentication::Realm';
+ $realmclass = 'Catalyst::Authentication::Realm';
} elsif ($realmclass !~ /^\+(.*)$/ ) {
- $realmclass = "Catalyst::Plugin::Authentication::Realm::${realmclass}";
+ $realmclass = "Catalyst::Authentication::Realm::${realmclass}";
} else {
$realmclass = $1;
}
user, it must have come from the realm specified.)
The above example is somewhat similar to role based access control.
-L<Catalyst::Plugin::Authentication::Store::Minimal> treats the roles field as
+L<Catalyst::Authentication::Store::Minimal> treats the roles field as
an array of role names. Let's leverage this. Add the role authorization
plugin:
name, which is used to reference the realm, a credential and a store.
You can also specify as realm class to instantiate instead of the default
-L<Catalyst::Plugin::Authentication::Realm> class.
+L<Catalyst::Authentication::Realm> class.
Each realm config contains two hashes, one called 'credential' and one called
'store', each of which provide configuration details to the respective modules.
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<Password>', for example, is expanded to
-Catalyst::Plugin::Authentication::Credential::B<Password>. For stores, the
+Catalyst::Authentication::Credential::B<Password>. For stores, the
classname 'B<storename>' is expanded to:
-Catalyst::Plugin::Authentication::Store::B<storename>.
+Catalyst::Authentication::Store::B<storename>.
=back
=head2 Realms
-L<Catalyst::Plugin::Authentication::Realm>
+L<Catalyst::Authentication::Realm>
=head2 User Storage Backends
-L<Catalyst::Plugin::Authentication::Store::Minimal>,
-L<Catalyst::Plugin::Authentication::Store::DBIx::Class>,
+L<Catalyst::Authentication::Store::Minimal>,
+L<Catalyst::Authentication::Store::DBIx::Class>,
=head2 Credential verification
-L<Catalyst::Plugin::Authentication::Credential::Password>,
+L<Catalyst::Authentication::Credential::Password>,
=head2 Authorization
use strict;
use warnings;
-use base qw/Class::Accessor::Fast/;
-
-use Scalar::Util ();
-use Catalyst::Exception ();
-use Digest ();
-
-BEGIN {
- __PACKAGE__->mk_accessors(qw/_config realm/);
-}
-
-sub new {
- my ($class, $config, $app, $realm) = @_;
-
- 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") 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') {
- 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) );
- }
- }
-}
-
-## 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::Plugin::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." );
- }
-}
+use base qw/Catalyst::Authentication::Credential::Password/;
__PACKAGE__;
=head1 NAME
-Catalyst::Plugin::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') });
- }
+Catalyst::Plugin::Authentication::Credential::Password - Compatibility shim
=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->{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<Catalyst::Plugin::Authentication> 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<Catalyst::Plugin::Authentication> and is the method by which
-Catalyst::Plugin::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');
-
-=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<Crypt::SaltedHash>. If this password type is selected, you should
-also provide the B<password_salt_len> config element to define the salt length.
-
-=item hashed
-
-If the user object supports hashed passwords, they will be used in conjunction
-with L<Digest>. The following config elements affect the hashed configuration:
-
-=over 8
-
-=item password_hash_type
-
-The hash type used, passed directly to L<Digest/new>.
-
-=item password_pre_salt
-
-Any pre-salt data to be passed to L<Digest/add> before processing the password.
-
-=item password_post_salt
-
-Any post-salt data to be passed to L<Digest/add> 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<password> 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<Catalyst::Plugin::Authentication> for all credential modules.
-
-=head2 new( $config, $app )
-
-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.
+THIS IS A COMPATIBILITY SHIM. It allows old configurations of Catalyst
+Authentication to work without code changes.
-=head2 check_password( )
+Please see L<Catalyst::Authentication::Credential::Password> for more information.
-=head2 login( )
-=cut
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<MUST>
inherit from
-L<Catalyst::Plugin::Authentication::User|Catalyst::Plugin::Authentication::User>.
+L<Catalyst::Authentication::User|Catalyst::Authentication::User>.
=head3 USER METHODS
The routines required by the
L<Catalyst::Plugin::Authentication|Catalyst::Plugin::Authentication> plugin
are below. Note that of these, only get_object is strictly required, as the
-L<Catalyst::Plugin::Authentication::User|Catalyst::Plugin::Authentication::User>
+L<Catalyst::Authentication::User|Catalyst::Authentication::User>
base class contains reasonable implementations of the rest. If you do choose
to implement only the C<get_object()> routine, please read the base class code
and documentation so that you fully understand how the other routines will be
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::Plugin::Authentication::User, so if your class inherits from that, you
+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<Note:> If you want the authentication module to be able to save your user in
certainly expecting the user to be found using the information provided
to $c->authenticate().
-Look at the L<Catalyst::Plugin::Authentication::Credential::Password|Catalyst::Plugin::Authentication::Credential::Password>
+Look at the L<Catalyst::Authentication::Credential::Password|Catalyst::Authentication::Credential::Password>
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
place those arguments that are specific to your credential
within their own subhash named after your module.
-The L<Catalyst::Plugin::Authentication::Store::DBIx::Class|Catalyst::Plugin::Authentication::Store::DBIx::Class> module does this
+The L<Catalyst::Authentication::Store::DBIx::Class|Catalyst::Authentication::Store::DBIx::Class> module does this
in order to encapsulate arguments intended specifically for
-that module. See the L<Catalyst::Plugin::Authentication::Store::DBIx::Class::User|Catalyst::Plugin::Authentication::Store::DBIx::Class::User>
+that module. See the L<Catalyst::Authentication::Store::DBIx::Class::User|Catalyst::Authentication::Store::DBIx::Class::User>
source for details.
=back
use strict;
use warnings;
-use Catalyst::Plugin::Authentication::User::Hash;
-use Scalar::Util ();
-use base qw/Class::Accessor::Fast/;
-
-BEGIN {
- __PACKAGE__->mk_accessors(qw/userhash/);
-}
-
-sub new {
- my ( $class, $config, $app, $realm) = @_;
-
- bless { userhash => $config->{'users'} }, $class;
-}
-
-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 ) {
- if ( Scalar::Util::blessed($user)
- and $user->isa('Catalyst::Plugin::Authentication::User::Hash') )
- {
- return $user;
- }
- if ( ref $user eq "HASH" ) {
- $user->{id} ||= $id;
- return bless $user, "Catalyst::Plugin::Authentication::User::Hash";
- }
- else {
- Catalyst::Exception->throw( "The user '$id' is a reference of type "
- . ref($user)
- . " but should be a HASH" );
- }
- }
- else {
- Catalyst::Exception->throw(
- "The user '$id' is has to be a hash reference or an object");
- }
-
- 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});
-}
-
-## backwards compatibility
-sub setup {
- my $c = shift;
-
- $c->default_auth_store(
- __PACKAGE__->new(
- $c->config->{authentication}, $c
- )
- );
-
- $c->NEXT::setup(@_);
-}
+use base qw/Catalyst::Authentication::Store::Minimal/;
__PACKAGE__;
=head1 NAME
-Catalyst::Plugin::Authentication::Store::Minimal - Minimal authentication store
-
-=head1 SYNOPSIS
+Catalyst::Plugin::Authentication::Store::Minimal - Compatibility shim
- # you probably just want Store::Minimal under most cases,
- # but if you insist you can instantiate your own store:
-
- use Catalyst::Plugin::Authentication::Store::Minimal;
-
- use Catalyst qw/
- Authentication
- /;
-
- __PACKAGE__->config->{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<Catalyst::Plugin::Authentication> and is the method by which
-Catalyst::Plugin::Authentication::Store::Minimal is loaded as the
-user store. For this module to be used, this must be set to
-'Minimal'.
-
-=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<Catalyst::Plugin::Authentication> 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<Catalyst::Plugin::Authentication::User::Hash>.
-
-=head2 from_session( $id )
-
-Delegates to C<get_user>.
-
-=head2 user_supports( )
-
-Chooses a random user from the hash and delegates to it.
-
-=head2 get_user( )
-
-=head2 setup( )
-
-=cut
+THIS IS A COMPATIBILITY SHIM. It allows old configurations of Catalyst
+Authentication to work without code changes.
+Please see L<Catalyst::Authentication::Store::Minimal> for more information.
use Test::More 'no_plan';
-my $m; BEGIN { use_ok($m = "Catalyst::Plugin::Authentication::Credential::Password") }
+my $m; BEGIN { use_ok($m = "Catalyst::Authentication::Credential::Password") }
can_ok($m, "login");
use Test::More tests => 6;
use Test::Exception;
-my $m; BEGIN { use_ok($m = "Catalyst::Plugin::Authentication::User") }
+my $m; BEGIN { use_ok($m = "Catalyst::Authentication::User") }
{
package SomeUser;
package User::SessionRestoring;
-use base qw/Catalyst::Plugin::Authentication::User::Hash/;
+use base qw/Catalyst::Authentication::User::Hash/;
sub for_session { $_[0]->id }
sub store { $_[0]->{store} }
projects / catagits/Catalyst-Plugin-Authentication.git / commitdiff