Chop up - move backcompat code into the ::Plugin:: namespace, as those are what are...
Tomas Doran [Sun, 4 Jan 2009 21:20:14 +0000 (21:20 +0000)]
lib/Catalyst/Authentication/Credential/Password.pm
lib/Catalyst/Authentication/Store/Minimal.pm
lib/Catalyst/Plugin/Authentication/Credential/Password.pm
lib/Catalyst/Plugin/Authentication/Store/Minimal.pm
t/05_password.t

index 0dee8f2..9475592 100644 (file)
@@ -89,118 +89,6 @@ sub check_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__
index df3d93a..150a3e4 100644 (file)
@@ -71,39 +71,6 @@ sub get_user {
     $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 @@ Chooses a random user from the hash and delegates to it.
 
 =head2 get_user( )
 
+Deprecated
+
 =head2 setup( )
 
 =cut
index b7f5b88..cfbaf3b 100644 (file)
@@ -3,7 +3,119 @@ package Catalyst::Plugin::Authentication::Credential::Password;
 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__;
 
index bc4a32e..ee916dd 100644 (file)
@@ -3,7 +3,45 @@ package Catalyst::Plugin::Authentication::Store::Minimal;
 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__;
 
index a7b6553..7c38986 100644 (file)
@@ -6,6 +6,6 @@ use Test::More 'no_plan';
 
 my $m; BEGIN { use_ok($m = "Catalyst::Authentication::Credential::Password") }
 
-can_ok($m, "login");
+can_ok($m, "authenticate");