[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