[Catalyst-commits] r9004 - in trunk/Catalyst-Plugin-Authentication:
lib/Catalyst/Authentication/Credential
lib/Catalyst/Authentication/Store
lib/Catalyst/Plugin/Authentication/Credential
lib/Catalyst/Plugin/Authentication/Store t
t0m at dev.catalyst.perl.org
t0m at dev.catalyst.perl.org
Sun Jan 4 21:20:15 GMT 2009
Author: t0m
Date: 2009-01-04 21:20:14 +0000 (Sun, 04 Jan 2009)
New Revision: 9004
Modified:
trunk/Catalyst-Plugin-Authentication/lib/Catalyst/Authentication/Credential/Password.pm
trunk/Catalyst-Plugin-Authentication/lib/Catalyst/Authentication/Store/Minimal.pm
trunk/Catalyst-Plugin-Authentication/lib/Catalyst/Plugin/Authentication/Credential/Password.pm
trunk/Catalyst-Plugin-Authentication/lib/Catalyst/Plugin/Authentication/Store/Minimal.pm
trunk/Catalyst-Plugin-Authentication/t/05_password.t
Log:
Chop up - move backcompat code into the ::Plugin:: namespace, as those are what are loaded for back compat, and leave the nice new code alone. Change back-compat for the store so that the methods are proxied onto the default auth store. Seems to about work with other auth plugins too, which is better than the previous try..
Modified: trunk/Catalyst-Plugin-Authentication/lib/Catalyst/Authentication/Credential/Password.pm
===================================================================
--- trunk/Catalyst-Plugin-Authentication/lib/Catalyst/Authentication/Credential/Password.pm 2009-01-04 21:15:31 UTC (rev 9003)
+++ trunk/Catalyst-Plugin-Authentication/lib/Catalyst/Authentication/Credential/Password.pm 2009-01-04 21:20:14 UTC (rev 9004)
@@ -89,118 +89,6 @@
}
}
-## 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__
Modified: trunk/Catalyst-Plugin-Authentication/lib/Catalyst/Authentication/Store/Minimal.pm
===================================================================
--- trunk/Catalyst-Plugin-Authentication/lib/Catalyst/Authentication/Store/Minimal.pm 2009-01-04 21:15:31 UTC (rev 9003)
+++ trunk/Catalyst-Plugin-Authentication/lib/Catalyst/Authentication/Store/Minimal.pm 2009-01-04 21:20:14 UTC (rev 9004)
@@ -71,39 +71,6 @@
$self->find_user({id => $id});
}
-## 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( __PACKAGE__->new( $cfg, $c ) ) if $cfg;
-
- $c->NEXT::setup(@_);
-}
-
__PACKAGE__;
__END__
@@ -221,6 +188,8 @@
=head2 get_user( )
+Deprecated
+
=head2 setup( )
=cut
Modified: trunk/Catalyst-Plugin-Authentication/lib/Catalyst/Plugin/Authentication/Credential/Password.pm
===================================================================
--- trunk/Catalyst-Plugin-Authentication/lib/Catalyst/Plugin/Authentication/Credential/Password.pm 2009-01-04 21:15:31 UTC (rev 9003)
+++ trunk/Catalyst-Plugin-Authentication/lib/Catalyst/Plugin/Authentication/Credential/Password.pm 2009-01-04 21:20:14 UTC (rev 9004)
@@ -3,8 +3,120 @@
use strict;
use warnings;
-use base qw/Catalyst::Authentication::Credential::Password/;
+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__
Modified: trunk/Catalyst-Plugin-Authentication/lib/Catalyst/Plugin/Authentication/Store/Minimal.pm
===================================================================
--- trunk/Catalyst-Plugin-Authentication/lib/Catalyst/Plugin/Authentication/Store/Minimal.pm 2009-01-04 21:15:31 UTC (rev 9003)
+++ trunk/Catalyst-Plugin-Authentication/lib/Catalyst/Plugin/Authentication/Store/Minimal.pm 2009-01-04 21:20:14 UTC (rev 9004)
@@ -3,8 +3,46 @@
use strict;
use warnings;
-use base qw/Catalyst::Authentication::Store::Minimal/;
+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::setup(@_);
+}
+
+foreach my $method (qw/ get_user user_supports find_user from_session /) {
+ no strict 'refs';
+ *{$method} = sub { __PACKAGE__->default_auth_store->$method( @_ ) };
+}
+
__PACKAGE__;
__END__
Modified: trunk/Catalyst-Plugin-Authentication/t/05_password.t
===================================================================
--- trunk/Catalyst-Plugin-Authentication/t/05_password.t 2009-01-04 21:15:31 UTC (rev 9003)
+++ trunk/Catalyst-Plugin-Authentication/t/05_password.t 2009-01-04 21:20:14 UTC (rev 9004)
@@ -6,6 +6,6 @@
my $m; BEGIN { use_ok($m = "Catalyst::Authentication::Credential::Password") }
-can_ok($m, "login");
+can_ok($m, "authenticate");
More information about the Catalyst-commits
mailing list