[Catalyst-commits] r8414 - in
Catalyst-Authentication-Credential-HTTP/1.000/trunk: .
lib/Catalyst/Authentication/Credential t
t0m at dev.catalyst.perl.org
t0m at dev.catalyst.perl.org
Fri Sep 12 19:20:02 BST 2008
Author: t0m
Date: 2008-09-12 19:20:01 +0100 (Fri, 12 Sep 2008)
New Revision: 8414
Modified:
Catalyst-Authentication-Credential-HTTP/1.000/trunk/Changes
Catalyst-Authentication-Credential-HTTP/1.000/trunk/Todo
Catalyst-Authentication-Credential-HTTP/1.000/trunk/lib/Catalyst/Authentication/Credential/HTTP.pm
Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/basic.t
Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/live_app_digest.t
Log:
Checking in changes prior to tagging of version 1.004. Changelog diff is:
=== Changes
==================================================================
--- Changes (revision 7359)
+++ Changes (local)
@@ -1,3 +1,9 @@
+1.004 2008-09-12
+ - Add tests for use_uri_for configuration options.
+ - Add tests and documentation for storing an MD5
+ of "$user:$relam:$password" instead of cleartext password
+ when doing digest auth.
+
1.003 2008-09-11
- Add ability to override the realm name presented for authentication
when calling $c->authenticate. Documentation and tests for this.
Modified: Catalyst-Authentication-Credential-HTTP/1.000/trunk/Changes
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/trunk/Changes 2008-09-12 14:33:41 UTC (rev 8413)
+++ Catalyst-Authentication-Credential-HTTP/1.000/trunk/Changes 2008-09-12 18:20:01 UTC (rev 8414)
@@ -1,3 +1,9 @@
+1.004 2008-09-12
+ - Add tests for use_uri_for configuration options.
+ - Add tests and documentation for storing an MD5
+ of "$user:$relam:$password" instead of cleartext password
+ when doing digest auth.
+
1.003 2008-09-11
- Add ability to override the realm name presented for authentication
when calling $c->authenticate. Documentation and tests for this.
Modified: Catalyst-Authentication-Credential-HTTP/1.000/trunk/Todo
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/trunk/Todo 2008-09-12 14:33:41 UTC (rev 8413)
+++ Catalyst-Authentication-Credential-HTTP/1.000/trunk/Todo 2008-09-12 18:20:01 UTC (rev 8414)
@@ -1,5 +1,4 @@
-. Document md5'd passwords for digest stuff
-. Add deprecation notice to old module.
. Split auth headers / do auth methods again, and make authenticate call each in turn.
-. Document / test 'algorithm' config.
-. Test and document use_uri_for config & domain
+. Document / test 'algorithm' config - MD5-sess / MD5.
+. Better documentation for 'domain' option.
+. Domain option should be able to be passed as config.
\ No newline at end of file
Modified: Catalyst-Authentication-Credential-HTTP/1.000/trunk/lib/Catalyst/Authentication/Credential/HTTP.pm
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/trunk/lib/Catalyst/Authentication/Credential/HTTP.pm 2008-09-12 14:33:41 UTC (rev 8413)
+++ Catalyst-Authentication-Credential-HTTP/1.000/trunk/lib/Catalyst/Authentication/Credential/HTTP.pm 2008-09-12 18:20:01 UTC (rev 8414)
@@ -13,7 +13,7 @@
__PACKAGE__->mk_accessors(qw/_config realm/);
}
-our $VERSION = "1.003";
+our $VERSION = "1.004";
sub new {
my ($class, $config, $app, $realm) = @_;
@@ -143,7 +143,6 @@
# we can store md5_hex("$username:$realm:$password") instead
my $password_field = $self->_config->{password_field};
for my $r ( 0 .. 1 ) {
- # FIXME - Do not assume accessor is called password.
# calculate H(A1) as per spec
my $A1_digest = $r ? $user->$password_field() : do {
$ctx = Digest::MD5->new;
@@ -274,7 +273,6 @@
sub _build_auth_header_common {
my ( $self, $c, $opts ) = @_;
-warn("HERE Opts $opts");
return (
$self->_build_auth_header_realm($c, $opts),
$self->_build_auth_header_domain($c, $opts),
@@ -489,8 +487,12 @@
=item authenticate_digest $c, $realm, \%auth_info
Performs HTTP digest authentication. Note that the password_type B<must> by I<clear> for
-digest authentication to succeed.
+digest authentication to succeed, and you must have L<Catalyst::Plugin::Session> in
+your application as digest authentication needs to store persistent data.
+Note - if you do not want to store your user passwords as clear text, then it is possible
+to store instead the MD5 digest in hex of the string '$username:$realm:$password'
+
=item authorization_required_response $c, $realm, \%auth_info
Sets C<< $c->response >> to the correct status code, and adds the correct
Modified: Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/basic.t
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/basic.t 2008-09-12 14:33:41 UTC (rev 8413)
+++ Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/basic.t 2008-09-12 18:20:01 UTC (rev 8414)
@@ -1,7 +1,7 @@
#!/usr/bin/perl
use strict;
use warnings;
-use Test::More tests => 31;
+use Test::More tests => 34;
use Test::MockObject::Extends;
use Test::MockObject;
use Test::Exception;
@@ -34,6 +34,8 @@
my $cache = Test::MockObject->new;
$cache->mock(set => sub { shift->{$_[0]} = $_[1] });
$cache->mock(get => sub { return shift->{$_[0]} });
+my $uri_for_called = 0;
+$c->mock(uri_for => sub { my ($c, $uri) = @_; $uri_for_called++; return 'uri_for:' . $uri} );
$c->mock(cache => sub { $cache });
$c->mock(debug => sub { 0 });
my @login_info;
@@ -147,12 +149,25 @@
$res_headers->clear;
$c->clear;
{
- my $self = new_self( type => 'any', password_type => 'clear',
- #use_uri_for => 1,
- );
+ my $self = new_self( type => 'any', password_type => 'clear');
throws_ok {
$self->authenticate( $c, $realm, {domain => [qw/dom1 dom2/]} );
} qr/^ $Catalyst::DETACH $/x, "detached";
like( ($res_headers->header('WWW-Authenticate'))[0], qr/domain="dom1 dom2"/, "WWW-Authenticate header set: digest domains set");
like( ($res_headers->header('WWW-Authenticate'))[1], qr/domain="dom1 dom2"/, "WWW-Authenticate header set: basic domains set");
}
+
+# Check domain config works with use_uri_for option
+$req_headers->clear;
+$res_headers->clear;
+$c->clear;
+{
+ my $self = new_self( type => 'any', password_type => 'clear', use_uri_for => 1);
+ throws_ok {
+ $self->authenticate( $c, $realm, {domain => [qw/dom1 dom2/]} );
+ } qr/^ $Catalyst::DETACH $/x, "detached";
+ like( ($res_headers->header('WWW-Authenticate'))[0], qr/domain="uri_for:dom1 uri_for:dom2"/,
+ "WWW-Authenticate header set: digest domains set with use_uri_for");
+ like( ($res_headers->header('WWW-Authenticate'))[1], qr/domain="uri_for:dom1 uri_for:dom2"/,
+ "WWW-Authenticate header set: basic domains set with use_uri_for");
+}
\ No newline at end of file
Modified: Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/live_app_digest.t
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/live_app_digest.t 2008-09-12 14:33:41 UTC (rev 8413)
+++ Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/live_app_digest.t 2008-09-12 18:20:01 UTC (rev 8414)
@@ -12,8 +12,9 @@
eval { require Cache::FileCache }
or plan skip_all =>
"Cache::FileCache is needed for this test";
- plan tests => 4;
+ plan tests => 8;
}
+use Digest::MD5;
use HTTP::Request;
{
package AuthTestApp;
@@ -29,7 +30,12 @@
$c->authenticate();
$c->res->body( $c->user->id );
}
- %users = ( Mufasa => { pass => "Circle Of Life", }, );
+ my $digest_pass = Digest::MD5->new;
+ $digest_pass->add('Mufasa2:testrealm at host.com:Circle Of Life');
+ %users = (
+ Mufasa => { pass => "Circle Of Life", },
+ Mufasa2 => { pass => $digest_pass->hexdigest, },
+ );
__PACKAGE__->config->{cache}{backend} = {
class => 'Cache::FileCache',
};
@@ -53,46 +59,51 @@
__PACKAGE__->setup;
}
use Test::WWW::Mechanize::Catalyst qw/AuthTestApp/;
-my $mech = Test::WWW::Mechanize::Catalyst->new;
-$mech->get("http://localhost/moose");
-is( $mech->status, 401, "status is 401" );
-my $www_auth = $mech->res->headers->header('WWW-Authenticate');
-my %www_auth_params = map {
- my @key_val = split /=/, $_, 2;
- $key_val[0] = lc $key_val[0];
- $key_val[1] =~ s{"}{}g; # remove the quotes
- @key_val;
-} split /, /, substr( $www_auth, 7 ); #7 == length "Digest "
-$mech->content_lacks( "foo", "no output" );
-my $response = '';
-{
- my $username = 'Mufasa';
- my $password = 'Circle Of Life';
- my $realm = $www_auth_params{realm};
- my $nonce = $www_auth_params{nonce};
- my $cnonce = '0a4f113b';
- my $opaque = $www_auth_params{opaque};
- my $nc = '00000001';
- my $method = 'GET';
- my $qop = 'auth';
- my $uri = '/moose';
- my $ctx = Digest::MD5->new;
- $ctx->add( join( ':', $username, $realm, $password ) );
- my $A1_digest = $ctx->hexdigest;
- $ctx = Digest::MD5->new;
- $ctx->add( join( ':', $method, $uri ) );
- my $A2_digest = $ctx->hexdigest;
- my $digest = Digest::MD5::md5_hex(
- join( ':',
- $A1_digest, $nonce, $qop ? ( $nc, $cnonce, $qop ) : (), $A2_digest )
- );
- $response = qq{Digest username="$username", realm="$realm", nonce="$nonce", uri="$uri", qop=$qop, nc=$nc, cnonce="$cnonce", response="$digest", opaque="$opaque"};
+sub do_test {
+ my $username = shift;
+ my $mech = Test::WWW::Mechanize::Catalyst->new;
+ $mech->get("http://localhost/moose");
+ is( $mech->status, 401, "status is 401" );
+ my $www_auth = $mech->res->headers->header('WWW-Authenticate');
+ my %www_auth_params = map {
+ my @key_val = split /=/, $_, 2;
+ $key_val[0] = lc $key_val[0];
+ $key_val[1] =~ s{"}{}g; # remove the quotes
+ @key_val;
+ } split /, /, substr( $www_auth, 7 ); #7 == length "Digest "
+ $mech->content_lacks( "foo", "no output" );
+ my $response = '';
+ {
+ my $password = 'Circle Of Life';
+ my $realm = $www_auth_params{realm};
+ my $nonce = $www_auth_params{nonce};
+ my $cnonce = '0a4f113b';
+ my $opaque = $www_auth_params{opaque};
+ my $nc = '00000001';
+ my $method = 'GET';
+ my $qop = 'auth';
+ my $uri = '/moose';
+ my $ctx = Digest::MD5->new;
+ $ctx->add( join( ':', $username, $realm, $password ) );
+ my $A1_digest = $ctx->hexdigest;
+ $ctx = Digest::MD5->new;
+ $ctx->add( join( ':', $method, $uri ) );
+ my $A2_digest = $ctx->hexdigest;
+ my $digest = Digest::MD5::md5_hex(
+ join( ':',
+ $A1_digest, $nonce, $qop ? ( $nc, $cnonce, $qop ) : (), $A2_digest )
+ );
+
+ $response = qq{Digest username="$username", realm="$realm", nonce="$nonce", uri="$uri", qop=$qop, nc=$nc, cnonce="$cnonce", response="$digest", opaque="$opaque"};
+ }
+ my $r = HTTP::Request->new( GET => "http://localhost/moose" );
+ $mech->request($r);
+ $r->headers->push_header( Authorization => $response );
+ $mech->request($r);
+ is( $mech->status, 200, "status is 200" );
+ $mech->content_contains( $username, "Mufasa output" );
}
-my $r = HTTP::Request->new( GET => "http://localhost/moose" );
-$mech->request($r);
-$r->headers->push_header( Authorization => $response );
-$mech->request($r);
-is( $mech->status, 200, "status is 200" );
-$mech->content_contains( "Mufasa", "Mufasa output" );
+do_test('Mufasa');
+do_test('Mufasa2');
\ No newline at end of file
More information about the Catalyst-commits
mailing list