[catagits/Catalyst-Plugin-Authentication.git] / lib / Catalyst / Plugin / Authentication / Credential / Password.pm

#!/usr/bin/perl

package Catalyst::Plugin::Authentication::Credential::Password;

use strict;
use warnings;

use Scalar::Util        ();
use Catalyst::Exception ();
use Digest              ();

sub new {
    my ($class, $config, $app) = @_;
    
    my $self = { %{$config} };
    $self->{'password_field'} ||= 'password';
    $self->{'password_type'}  ||= 'clear';
    $self->{'password_hash_type'} ||= 'SHA-1';
    
    if (!grep /$$self{'password_type'}/, ('clear', 'hashed', 'salted_hash', 'crypted', 'self_check')) {
        Catalyst::Exception->throw(__PACKAGE__ . " used with unsupported password type: " . $self->{'password_type'});
    }

    bless $self, $class;
}

sub authenticate {
    my ( $self, $c, $authstore, $authinfo ) = @_;

    my $user_obj = $authstore->find_user($authinfo, $c);
    if ($user_obj) {
        if ($self->check_password($user_obj, $authinfo)) {
            return $user_obj;
        }
    } else {
        $c->log->debug("Unable to locate user matching user info provided");
        return;
    }
}

sub check_password {
    my ( $self, $user, $authinfo ) = @_;
    
    if ($self->{'password_type'} eq 'self_check') {
        return $user->check_password($authinfo->{$self->{'password_field'}});
    } else {
        my $password = $authinfo->{$self->{'password_field'}};
        my $storedpassword = $user->get($self->{'password_field'});
        
        if ($self->{password_type} eq 'clear') {
            return $password eq $storedpassword;
        }  elsif ($self->{'password_type'} eq 'crypted') {            
            return $storedpassword eq crypt( $password, $storedpassword );
        } elsif ($self->{'password_type'} eq 'salted_hash') {
            require Crypt::SaltedHash;
            my $salt_len = $self->{'password_salt_len'} ? $self->{'password_salt_len'} : 0;
            return Crypt::SaltedHash->validate( $storedpassword, $password,
                $salt_len );
        } elsif ($self->{'password_type'} eq 'hashed') {

             my $d = Digest->new( $self->{'password_hash_type'} );
             $d->add( $self->{'password_pre_salt'} || '' );
             $d->add($password);
             $d->add( $self->{'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 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." );
    }
}

__PACKAGE__;

__END__

=pod

=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
      /;

    package MyApp::Controller::Auth;

    # *** NOTE ***
    # if you place an action named 'login' in your application's root (as
    # opposed to inside a controller) the following snippet will recurse,
    # giving you lots of grief.
    # never name actions in the root controller after plugin methods - use
    # controllers and : Global instead.

    sub login : Local {
        my ( $self, $c ) = @_;

        $c->login( $c->req->param('username'), $c->req->param('password') );
    }

=head1 DESCRIPTION

This authentication credential checker takes a username (or userid) and a 
password, and tries various methods of comparing a password based on what 
the chosen store's user objects support:

=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<crypt> function.

=item hashed password

If the user object supports hashed passwords, they will be used in conjunction
with L<Digest>.

=back

=head1 METHODS

=over 4

=item login $username, $password

Try to log a user in.

C<$username> can be a string (e.g. retrieved from a form) or an object. 
If the object is a L<Catalyst::Plugin::Authentication::User> it will be used 
as is. Otherwise C<< $c->get_user >> is used to retrieve it.

C<$password> is a string.

If C<$username> or C<$password> are not provided, the query parameters 
C<login>, C<user>, C<username> and C<password>, C<passwd>, C<pass> will 
be tried instead.

=back

=head1 RELATED USAGE

After the user is logged in, the user object for the current logged in user 
can be retrieved from the context using the C<< $c->user >> method.

The current user can be logged out again by calling the C<< $c->logout >> 
method.

=head1 SUPPORTING THIS PLUGIN

For a User class to support credential verification using this plugin, it
needs to indicate what sort of password a given user supports 
by implementing the C<supported_features> method in one or many of the 
following ways:

=head2 Clear Text Passwords

Predicate:

	$user->supported_features(qw/password clear/);

Expected methods:

=over 4

=item password

Returns the user's clear text password as a string to be compared with C<eq>.

=back

=head2 Crypted Passwords

Predicate:

	$user->supported_features(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->supported_features(qw/password hashed/);

Expected methods:

=over 4

=item hashed_password

Return's the hash of the user's password as B<binary>.

=item hash_algorithm

Returns a string suitable for feeding into L<Digest/new>.

=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.

=back

=head2 Crypt::SaltedHash Passwords

Predicate:

	$user->supported_features(qw/password salted_hash/);

Expected methods:

=over 4

=item hashed_password

Returns the hash of the user's password as returned from L<Crypt-SaltedHash>->generate.

=back

Optional methods:

=over 4

=item password_salt_len

Returns the length of salt used to generate the salted hash.

=back

=cut
Commit	Line	Data
a90296d4	1	#!/usr/bin/perl
	2
	3	package Catalyst::Plugin::Authentication::Credential::Password;
	4
	5	use strict;
	6	use warnings;
	7
	8	use Scalar::Util ();
	9	use Catalyst::Exception ();
	10	use Digest ();
	11
54c8dc06	12	sub new {
	13	my ($class, $config, $app) = @_;
	14
	15	my $self = { %{$config} };
	16	$self->{'password_field'} \|\|= 'password';
	17	$self->{'password_type'} \|\|= 'clear';
	18	$self->{'password_hash_type'} \|\|= 'SHA-1';
	19
	20	if (!grep /$$self{'password_type'}/, ('clear', 'hashed', 'salted_hash', 'crypted', 'self_check')) {
	21	Catalyst::Exception->throw(__PACKAGE__ . " used with unsupported password type: " . $self->{'password_type'});
	22	}
a90296d4	23
54c8dc06	24	bless $self, $class;
	25	}
	26
	27	sub authenticate {
	28	my ( $self, $c, $authstore, $authinfo ) = @_;
	29
	30	my $user_obj = $authstore->find_user($authinfo, $c);
	31	if ($user_obj) {
	32	if ($self->check_password($user_obj, $authinfo)) {
	33	return $user_obj;
a93f1197	34	}
54c8dc06	35	} else {
	36	$c->log->debug("Unable to locate user matching user info provided");
	37	return;
	38	}
	39	}
a93f1197	40
54c8dc06	41	sub check_password {
	42	my ( $self, $user, $authinfo ) = @_;
	43
	44	if ($self->{'password_type'} eq 'self_check') {
	45	return $user->check_password($authinfo->{$self->{'password_field'}});
	46	} else {
	47	my $password = $authinfo->{$self->{'password_field'}};
	48	my $storedpassword = $user->get($self->{'password_field'});
	49
	50	if ($self->{password_type} eq 'clear') {
	51	return $password eq $storedpassword;
	52	} elsif ($self->{'password_type'} eq 'crypted') {
	53	return $storedpassword eq crypt( $password, $storedpassword );
	54	} elsif ($self->{'password_type'} eq 'salted_hash') {
	55	require Crypt::SaltedHash;
	56	my $salt_len = $self->{'password_salt_len'} ? $self->{'password_salt_len'} : 0;
	57	return Crypt::SaltedHash->validate( $storedpassword, $password,
	58	$salt_len );
	59	} elsif ($self->{'password_type'} eq 'hashed') {
	60
	61	my $d = Digest->new( $self->{'password_hash_type'} );
	62	$d->add( $self->{'password_pre_salt'} \|\| '' );
	63	$d->add($password);
	64	$d->add( $self->{'password_post_salt'} \|\| '' );
	65
	66	my $computed = $d->clone()->digest;
	67	my $b64computed = $d->clone()->b64digest;
	68	return ( ( $computed eq $storedpassword )
	69	\|\| ( unpack( "H*", $computed ) eq $storedpassword )
	70	\|\| ( $b64computed eq $storedpassword)
	71	\|\| ( $b64computed.'=' eq $storedpassword) );
a93f1197	72	}
a90296d4	73	}
54c8dc06	74	}
	75
	76	## BACKWARDS COMPATIBILITY - all subs below here are deprecated
	77	## They are here for compatibility with older modules that use / inherit from C::P::A::Password
	78	## login()'s existance relies rather heavily on the fact that Credential::Password
	79	## is being used as a credential. This may not be the case. This is only here
	80	## for backward compatibility. It will go away in a future version
	81	## login should not be used in new applications.
a90296d4	82
54c8dc06	83	sub login {
	84	my ( $c, $user, $password, @rest ) = @_;
	85
	86	unless (
	87	defined($user)
	88	or
	89	$user = $c->request->param("login")
	90	\|\| $c->request->param("user")
	91	\|\| $c->request->param("username")
	92	) {
	93	$c->log->debug(
	94	"Can't login a user without a user object or user ID param")
	95	if $c->debug;
	96	return;
	97	}
	98
	99	unless (
	100	defined($password)
	101	or
	102	$password = $c->request->param("password")
	103	\|\| $c->request->param("passwd")
	104	\|\| $c->request->param("pass")
	105	) {
	106	$c->log->debug("Can't login a user without a password")
	107	if $c->debug;
	108	return;
	109	}
	110
a93f1197	111	unless ( Scalar::Util::blessed($user)
85d1d92d	112	and $user->isa("Catalyst::Plugin::Authentication::User") )
a93f1197	113	{
2f7d8b59	114	if ( my $user_obj = $c->get_user( $user, $password, @rest ) ) {
a93f1197	115	$user = $user_obj;
	116	}
	117	else {
	118	$c->log->debug("User '$user' doesn't exist in the default store")
	119	if $c->debug;
	120	return;
	121	}
	122	}
a90296d4	123
	124	if ( $c->_check_password( $user, $password ) ) {
	125	$c->set_authenticated($user);
a93f1197	126	$c->log->debug("Successfully authenticated user '$user'.")
a93f1197	127	if $c->debug;
a90296d4	128	return 1;
	129	}
	130	else {
a93f1197	131	$c->log->debug(
85d1d92d	132	"Failed to authenticate user '$user'. Reason: 'Incorrect password'")
a93f1197	133	if $c->debug;
a90296d4	134	return;
a90296d4	135	}
54c8dc06	136
a90296d4	137	}
a90296d4	138
54c8dc06	139	## also deprecated. Here for compatibility with older credentials which do not inherit from C::P::A::Password
a90296d4	140	sub _check_password {
a90296d4	141	my ( $c, $user, $password ) = @_;
54c8dc06	142
a90296d4	143	if ( $user->supports(qw/password clear/) ) {
	144	return $user->password eq $password;
	145	}
	146	elsif ( $user->supports(qw/password crypted/) ) {
	147	my $crypted = $user->crypted_password;
	148	return $crypted eq crypt( $password, $crypted );
	149	}
	150	elsif ( $user->supports(qw/password hashed/) ) {
	151
	152	my $d = Digest->new( $user->hash_algorithm );
	153	$d->add( $user->password_pre_salt \|\| '' );
	154	$d->add($password);
	155	$d->add( $user->password_post_salt \|\| '' );
	156
fd5b31a0	157	my $stored = $user->hashed_password;
	158	my $computed = $d->clone()->digest;
	159	my $b64computed = $d->clone()->b64digest;
a90296d4	160
a90296d4	161	return ( ( $computed eq $stored )
fd5b31a0	162	\|\| ( unpack( "H*", $computed ) eq $stored )
	163	\|\| ( $b64computed eq $stored)
	164	\|\| ( $b64computed.'=' eq $stored) );
a90296d4	165	}
	166	elsif ( $user->supports(qw/password salted_hash/) ) {
	167	require Crypt::SaltedHash;
	168
	169	my $salt_len =
	170	$user->can("password_salt_len") ? $user->password_salt_len : 0;
	171
	172	return Crypt::SaltedHash->validate( $user->hashed_password, $password,
	173	$salt_len );
	174	}
	175	elsif ( $user->supports(qw/password self_check/) ) {
	176
	177	# while somewhat silly, this is to prevent code duplication
	178	return $user->check_password($password);
	179
	180	}
	181	else {
	182	Catalyst::Exception->throw(
	183	"The user object $user does not support any "
	184	. "known password authentication mechanism." );
	185	}
	186	}
	187
	188	__PACKAGE__;
	189
	190	__END__
	191
	192	=pod
	193
	194	=head1 NAME
	195
	196	Catalyst::Plugin::Authentication::Credential::Password - Authenticate a user
	197	with a password.
	198
	199	=head1 SYNOPSIS
	200
	201	use Catalyst qw/
	202	Authentication
	203	Authentication::Store::Foo
	204	Authentication::Credential::Password
	205	/;
	206
8d3ca09c	207	package MyApp::Controller::Auth;
	208
	209	# * NOTE *
	210	# if you place an action named 'login' in your application's root (as
	211	# opposed to inside a controller) the following snippet will recurse,
	212	# giving you lots of grief.
	213	# never name actions in the root controller after plugin methods - use
	214	# controllers and : Global instead.
	215
a90296d4	216	sub login : Local {
	217	my ( $self, $c ) = @_;
	218
	219	$c->login( $c->req->param('username'), $c->req->param('password') );
	220	}
	221
	222	=head1 DESCRIPTION
	223
9b09fd1c	224	This authentication credential checker takes a username (or userid) and a
9b09fd1c	225	password, and tries various methods of comparing a password based on what
a90296d4	226	the chosen store's user objects support:
	227
	228	=over 4
	229
	230	=item clear text password
	231
	232	If the user has clear a clear text password it will be compared directly.
	233
	234	=item crypted password
	235
	236	If UNIX crypt hashed passwords are supported, they will be compared using
	237	perl's builtin C<crypt> function.
	238
	239	=item hashed password
	240
	241	If the user object supports hashed passwords, they will be used in conjunction
	242	with L<Digest>.
	243
	244	=back
	245
	246	=head1 METHODS
	247
	248	=over 4
	249
	250	=item login $username, $password
	251
	252	Try to log a user in.
	253
a2fcf979	254	C<$username> can be a string (e.g. retrieved from a form) or an object.
9b09fd1c	255	If the object is a L<Catalyst::Plugin::Authentication::User> it will be used
a90296d4	256	as is. Otherwise C<< $c->get_user >> is used to retrieve it.
	257
	258	C<$password> is a string.
	259
d1481e8f	260	If C<$username> or C<$password> are not provided, the query parameters
9b09fd1c	261	C<login>, C<user>, C<username> and C<password>, C<passwd>, C<pass> will
	262	be tried instead.
	263
	264	=back
	265
	266	=head1 RELATED USAGE
	267
	268	After the user is logged in, the user object for the current logged in user
	269	can be retrieved from the context using the C<< $c->user >> method.
	270
	271	The current user can be logged out again by calling the C<< $c->logout >>
	272	method.
	273
a90296d4	274	=head1 SUPPORTING THIS PLUGIN
9b09fd1c	275
	276	For a User class to support credential verification using this plugin, it
	277	needs to indicate what sort of password a given user supports
	278	by implementing the C<supported_features> method in one or many of the
	279	following ways:
	280
a90296d4	281	=head2 Clear Text Passwords
	282
	283	Predicate:
	284
	285	$user->supported_features(qw/password clear/);
	286
	287	Expected methods:
	288
	289	=over 4
	290
	291	=item password
	292
	293	Returns the user's clear text password as a string to be compared with C<eq>.
	294
	295	=back
	296
	297	=head2 Crypted Passwords
	298
	299	Predicate:
	300
	301	$user->supported_features(qw/password crypted/);
	302
	303	Expected methods:
	304
	305	=over 4
	306
	307	=item crypted_password
	308
	309	Return's the user's crypted password as a string, with the salt as the first two chars.
	310
	311	=back
	312
	313	=head2 Hashed Passwords
	314
	315	Predicate:
	316
	317	$user->supported_features(qw/password hashed/);
	318
	319	Expected methods:
	320
	321	=over 4
	322
	323	=item hashed_password
	324
	325	Return's the hash of the user's password as B<binary>.
	326
	327	=item hash_algorithm
	328
	329	Returns a string suitable for feeding into L<Digest/new>.
	330
	331	=item password_pre_salt
	332
	333	=item password_post_salt
	334
	335	Returns a string to be hashed before/after the user's password. Typically only
	336	a pre-salt is used.
	337
	338	=back
	339
	340	=head2 Crypt::SaltedHash Passwords
	341
	342	Predicate:
	343
	344	$user->supported_features(qw/password salted_hash/);
345
346	Expected methods:
347
348	=over 4
349
350	=item hashed_password
351
352	Returns the hash of the user's password as returned from L<Crypt-SaltedHash>->generate.
353
354	=back
355
356	Optional methods:
357
358	=over 4
359
360	=item password_salt_len
361
362	Returns the length of salt used to generate the salted hash.
363
364	=back
365
366	=cut
367
368