X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FPlugin%2FAuthentication%2FCredential%2FPassword.pm;h=cfbaf3bd89cefbb2f62b2ef34f124235b48fbbc7;hb=290e5a7efa221cbd3f34a9a72206a6f2d12cc09f;hp=3e3db2d33541b32b4ebcc4bf62abaa6cbca90869;hpb=0c4ddd064218a77c17d1bd59fa2963ee31f594b4;p=catagits%2FCatalyst-Plugin-Authentication.git diff --git a/lib/Catalyst/Plugin/Authentication/Credential/Password.pm b/lib/Catalyst/Plugin/Authentication/Credential/Password.pm index 3e3db2d..cfbaf3b 100644 --- a/lib/Catalyst/Plugin/Authentication/Credential/Password.pm +++ b/lib/Catalyst/Plugin/Authentication/Credential/Password.pm @@ -1,45 +1,77 @@ -#!/usr/bin/perl - package Catalyst::Plugin::Authentication::Credential::Password; use strict; use warnings; -use Scalar::Util (); -use Catalyst::Exception (); -use Digest (); +use Catalyst::Authentication::Credential::Password (); -sub login { - my ( $c, $user, $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. - for ( $c->request ) { - $user ||= $_->param("login") - || $_->param("user") - || $_->param("username") - || Catalyst::Exception->throw("Can't determine username for login"); - - $password ||= $_->param("password") - || $_->param("passwd") - || $_->param("pass") - || Catalyst::Exception->throw("Can't determine password for login"); +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; } - $user = $c->get_user($user) || return - unless Scalar::Util::blessed($user) - and $user->isa("Catalyst:::Plugin::Authentication::User"); + 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 { - return undef; + $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; } @@ -48,16 +80,35 @@ sub _check_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 || '' ); - return $d->digest eq $user->hashed_password; + + 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( @@ -74,128 +125,15 @@ __END__ =head1 NAME -Catalyst::Plugin::Authentication::Credential::Password - Authenticate a user -with a password. - -=head1 SYNOPSIS - - use Catalyst qw/ - Authentication - Authentication::Store::Foo - Authentication::Credential::Password - /; - - sub login : Local { - my ( $self, $c ) = @_; - - $c->login( $c->req->param('login'), $c->req->param('password') ); - } +Catalyst::Plugin::Authentication::Credential::Password - Compatibility shim =head1 DESCRIPTION -This authentication credential checker takes a user and a password, and tries -various methods of comparing a password based on what the user supports: - -=over 4 - -=item clear text password - -If the user has clear a clear text password it will be compared directly. - -=item crypted password - -If UNIX crypt hashed passwords are supported, they will be compared using -perl's builtin C function. - -=item hashed password - -If the user object supports hashed passwords, they will be used in conjunction -with L. - -=back - -=head1 METHODS - -=over 4 - -=item login $user, $password - -=item login - -Try to log a user in. - -C<$user> can be an ID or object. If it isa -L it will be used as is. Otherwise -C<< $c->get_user >> is used to retrieve it. - -C<$password> is a string. - -If C<$user> or C<$password> are not provided the parameters C, C, -C and C, C, C will be tried instead. - -=back - -=head1 SUPPORTING THIS PLUGIN - -=head2 Clear Text Passwords - -Predicate: - - $user->supports(qw/password clear/); - -Expected methods: - -=over 4 - -=item password - -Returns the user's clear text password as a string to be compared with C. - -=back - -=head2 Crypted Passwords - -Predicate: - - $user->supports(qw/password crypted/); - -Expected methods: - -=over 4 - -=item crypted_password - -Return's the user's crypted password as a string, with the salt as the first two chars. - -=back - -=head2 Hashed Passwords - -Predicate: - - $user->supports(qw/password hashed/); - -Expected methods: - -=over 4 - -=item hashed_passwords - -Return's the hash of the user's password as B. - -=item hash_algorithm - -Returns a string suitable for feeding into L. - -=item password_pre_salt - -=item password_post_salt - -Returns a string to be hashed before/after the user's password. Typically only -a pre-salt is used. +THIS IS A COMPATIBILITY SHIM. It allows old configurations of Catalyst +Authentication to work without code changes. -=back +B -=cut +Please see L for more information.