[Catalyst-commits] r7945 - in trunk/Catalyst-Plugin-Authentication-Credential-HTTP: . lib/Catalyst lib/Catalyst/Plugin/Authentication/Credential t

t0m at dev.catalyst.perl.org t0m at dev.catalyst.perl.org
Mon Jun 23 21:21:52 BST 2008


Author: t0m
Date: 2008-06-23 21:21:52 +0100 (Mon, 23 Jun 2008)
New Revision: 7945

Removed:
   trunk/Catalyst-Plugin-Authentication-Credential-HTTP/lib/Catalyst/Authentication/
   trunk/Catalyst-Plugin-Authentication-Credential-HTTP/t/04pod_spelling.t
Modified:
   trunk/Catalyst-Plugin-Authentication-Credential-HTTP/
   trunk/Catalyst-Plugin-Authentication-Credential-HTTP/Changes
   trunk/Catalyst-Plugin-Authentication-Credential-HTTP/MANIFEST.SKIP
   trunk/Catalyst-Plugin-Authentication-Credential-HTTP/Makefile.PL
   trunk/Catalyst-Plugin-Authentication-Credential-HTTP/lib/Catalyst/Plugin/Authentication/Credential/HTTP.pm
   trunk/Catalyst-Plugin-Authentication-Credential-HTTP/t/basic.t
   trunk/Catalyst-Plugin-Authentication-Credential-HTTP/t/live_app_digest.t
Log:
Back out r7888 as I am lose, and doing compat properly isn't nice. Going to push the new code in a the new namespace, then do compat here, or just deprecate this module..


Property changes on: trunk/Catalyst-Plugin-Authentication-Credential-HTTP
___________________________________________________________________
Name: svn:ignore
   - META.yml
Makefile
blib
inc
pm_to_blib
Makefile.old
Name: svk:merge
   - 5790e164-973e-0410-be86-a0c6746e9881:/local/Catalyst-Plugin-Authentication-Credential-HTTP:4975

Modified: trunk/Catalyst-Plugin-Authentication-Credential-HTTP/Changes
===================================================================
--- trunk/Catalyst-Plugin-Authentication-Credential-HTTP/Changes	2008-06-23 19:56:50 UTC (rev 7944)
+++ trunk/Catalyst-Plugin-Authentication-Credential-HTTP/Changes	2008-06-23 20:21:52 UTC (rev 7945)
@@ -1,7 +1,3 @@
-0.11  2008-06-03
-   - Rename to remove Plugin from namespace. The Plugin version is now a wrapper with a deprecation notice.
-   - Change the test suite to use C::P::Cache rather than C::P::Cache::FileCache
-
 0.10  2007-04-26
     - switch to Module::Install
 

Modified: trunk/Catalyst-Plugin-Authentication-Credential-HTTP/MANIFEST.SKIP
===================================================================
--- trunk/Catalyst-Plugin-Authentication-Credential-HTTP/MANIFEST.SKIP	2008-06-23 19:56:50 UTC (rev 7944)
+++ trunk/Catalyst-Plugin-Authentication-Credential-HTTP/MANIFEST.SKIP	2008-06-23 20:21:52 UTC (rev 7945)
@@ -21,5 +21,3 @@
 \#$
 \b\.#
 ^..*\.sw[po]$
-# Avoid ShipIt configuration
-.shipit

Modified: trunk/Catalyst-Plugin-Authentication-Credential-HTTP/Makefile.PL
===================================================================
--- trunk/Catalyst-Plugin-Authentication-Credential-HTTP/Makefile.PL	2008-06-23 19:56:50 UTC (rev 7944)
+++ trunk/Catalyst-Plugin-Authentication-Credential-HTTP/Makefile.PL	2008-06-23 20:21:52 UTC (rev 7945)
@@ -1,10 +1,10 @@
 use inc::Module::Install 0.65;
 
-name 'Catalyst-Authentication-Credential-HTTP';
-all_from 'lib/Catalyst/Authentication/Credential/HTTP.pm';
+name 'Catalyst-Plugin-Authentication-Credential-HTTP';
+all_from 'lib/Catalyst/Plugin/Authentication/Credential/HTTP.pm';
 
 requires 'Catalyst::Runtime';
-requires 'Catalyst::Plugin::Authentication' => '0.10000';
+requires 'Catalyst::Plugin::Authentication';
 requires 'Data::UUID' => '0.11';
 requires 'String::Escape';
 requires 'Test::Exception';

Modified: trunk/Catalyst-Plugin-Authentication-Credential-HTTP/lib/Catalyst/Plugin/Authentication/Credential/HTTP.pm
===================================================================
--- trunk/Catalyst-Plugin-Authentication-Credential-HTTP/lib/Catalyst/Plugin/Authentication/Credential/HTTP.pm	2008-06-23 19:56:50 UTC (rev 7944)
+++ trunk/Catalyst-Plugin-Authentication-Credential-HTTP/lib/Catalyst/Plugin/Authentication/Credential/HTTP.pm	2008-06-23 20:21:52 UTC (rev 7945)
@@ -1,11 +1,366 @@
+#!/usr/bin/perl
+
 package Catalyst::Plugin::Authentication::Credential::HTTP;
-use base qw/Catalyst::Authentication::Credential::HTTP/;
+use base qw/Catalyst::Plugin::Authentication::Credential::Password/;
 
-our $VERSION = '0.11';
+use strict;
+use warnings;
 
-# FIXME - Add a warning here?
-# FIXME - Is this package even needed?
+use String::Escape ();
+use URI::Escape    ();
+use Catalyst       ();
+use Digest::MD5    ();
 
+our $VERSION = "0.10";
+
+sub authenticate_http {
+    my ( $c, @args ) = @_;
+
+    return 1 if $c->_is_http_auth_type('digest') && $c->authenticate_digest(@args);
+    return 1 if $c->_is_http_auth_type('basic')  && $c->authenticate_basic(@args);
+}
+
+sub get_http_auth_store {
+    my ( $c, %opts ) = @_;
+
+    my $store = $opts{store} || $c->config->{authentication}{http}{store} || return;
+
+    return ref $store
+        ? $store
+        : $c->get_auth_store($store);
+}
+
+sub authenticate_basic {
+    my ( $c, %opts ) = @_;
+
+    $c->log->debug('Checking http basic authentication.') if $c->debug;
+
+    my $headers = $c->req->headers;
+
+    if ( my ( $username, $password ) = $headers->authorization_basic ) {
+
+        my $user;
+
+        unless ( $user = $opts{user} ) {
+            if ( my $store = $c->get_http_auth_store(%opts) ) {
+                $user = $store->get_user($username);
+            } else {
+                $user = $username;
+            }
+        }
+
+        return $c->login( $user, $password );
+    }
+
+    return 0;
+}
+
+sub authenticate_digest {
+    my ( $c, %opts ) = @_;
+
+    $c->log->debug('Checking http digest authentication.') if $c->debug;
+
+    my $headers       = $c->req->headers;
+    my @authorization = $headers->header('Authorization');
+    foreach my $authorization (@authorization) {
+        next unless $authorization =~ m{^Digest};
+
+        my %res = map {
+            my @key_val = split /=/, $_, 2;
+            $key_val[0] = lc $key_val[0];
+            $key_val[1] =~ s{"}{}g;    # remove the quotes
+            @key_val;
+        } split /,\s?/, substr( $authorization, 7 );    #7 == length "Digest "
+
+        my $opaque = $res{opaque};
+        my $nonce  = $c->get_digest_authorization_nonce( __PACKAGE__ . '::opaque:' . $opaque );
+        next unless $nonce;
+
+        $c->log->debug('Checking authentication parameters.')
+          if $c->debug;
+
+        my $uri         = '/' . $c->request->path;
+        my $algorithm   = $res{algorithm} || 'MD5';
+        my $nonce_count = '0x' . $res{nc};
+
+        my $check = $uri eq $res{uri}
+          && ( exists $res{username} )
+          && ( exists $res{qop} )
+          && ( exists $res{cnonce} )
+          && ( exists $res{nc} )
+          && $algorithm eq $nonce->algorithm
+          && hex($nonce_count) > hex( $nonce->nonce_count )
+          && $res{nonce} eq $nonce->nonce;    # TODO: set Stale instead
+
+        unless ($check) {
+            $c->log->debug('Digest authentication failed. Bad request.')
+              if $c->debug;
+            $c->res->status(400);             # bad request
+            die $Catalyst::DETACH;
+        }
+
+        $c->log->debug('Checking authentication response.')
+          if $c->debug;
+
+        my $username = $res{username};
+        my $realm    = $res{realm};
+
+        my $user;
+
+        unless ( $user = $opts{user} ) {
+            if ( my $store = $c->get_http_auth_store(%opts) || $c->default_auth_store ) {
+                $user = $store->get_user($username);
+            }
+        }
+
+        unless ($user) {    # no user, no authentication
+            $c->log->debug('Unknown user: $user.') if $c->debug;
+            return 0;
+        }
+
+        # everything looks good, let's check the response
+
+        # calculate H(A2) as per spec
+        my $ctx = Digest::MD5->new;
+        $ctx->add( join( ':', $c->request->method, $res{uri} ) );
+        if ( $res{qop} eq 'auth-int' ) {
+            my $digest =
+              Digest::MD5::md5_hex( $c->request->body );    # not sure here
+            $ctx->add( ':', $digest );
+        }
+        my $A2_digest = $ctx->hexdigest;
+
+        # the idea of the for loop:
+        # if we do not want to store the plain password in our user store,
+        # we can store md5_hex("$username:$realm:$password") instead
+        for my $r ( 0 .. 1 ) {
+
+            # calculate H(A1) as per spec
+            my $A1_digest = $r ? $user->password : do {
+                $ctx = Digest::MD5->new;
+                $ctx->add( join( ':', $username, $realm, $user->password ) );
+                $ctx->hexdigest;
+            };
+            if ( $nonce->algorithm eq 'MD5-sess' ) {
+                $ctx = Digest::MD5->new;
+                $ctx->add( join( ':', $A1_digest, $res{nonce}, $res{cnonce} ) );
+                $A1_digest = $ctx->hexdigest;
+            }
+
+            my $rq_digest = Digest::MD5::md5_hex(
+                join( ':',
+                    $A1_digest, $res{nonce},
+                    $res{qop} ? ( $res{nc}, $res{cnonce}, $res{qop} ) : (),
+                    $A2_digest )
+            );
+
+            $nonce->nonce_count($nonce_count);
+            $c->cache->set( __PACKAGE__ . '::opaque:' . $nonce->opaque,
+                $nonce );
+
+            return $c->login( $user, $user->password )
+              if $rq_digest eq $res{response};
+        }
+    }
+
+    return 0;
+}
+
+sub _check_cache {
+    my $c = shift;
+
+    die "A cache is needed for http digest authentication."
+      unless $c->can('cache');
+}
+
+sub _is_http_auth_type {
+    my ( $c, $type ) = @_;
+
+    my $cfgtype = lc( $c->config->{authentication}{http}{type} || 'any' );
+    return 1 if $cfgtype eq 'any' || $cfgtype eq lc $type;
+    return 0;
+}
+
+sub authorization_required {
+    my ( $c, @args ) = @_;
+
+    return 1 if $c->authenticate_http(@args);
+    
+    $c->authorization_required_response(@args);
+
+    die $Catalyst::DETACH;
+}
+
+sub authorization_required_response {
+    my ( $c, %opts ) = @_;
+
+    $c->res->status(401);
+    $c->res->content_type('text/plain');
+    $c->res->body($c->config->{authentication}{http}{authorization_required_message} || 
+                  $opts{authorization_required_message} || 
+                  'Authorization required.');
+
+    # *DONT* short circuit
+    my $ok;
+    $ok++ if $c->_create_digest_auth_response(\%opts);
+    $ok++ if $c->_create_basic_auth_response(\%opts);
+
+    unless ( $ok ) {
+        die 'Could not build authorization required response. '
+        . 'Did you configure a valid authentication http type: '
+        . 'basic, digest, any';
+    }
+}
+
+sub _add_authentication_header {
+    my ( $c, $header ) = @_;
+    $c->res->headers->push_header( 'WWW-Authenticate' => $header );
+}
+
+sub _create_digest_auth_response {
+    my ( $c, $opts ) = @_;
+      
+    return unless $c->_is_http_auth_type('digest');
+    
+    if ( my $digest = $c->_build_digest_auth_header( $opts ) ) {
+        $c->_add_authentication_header( $digest );
+        return 1;
+    }
+
+    return;
+}
+
+sub _create_basic_auth_response {
+    my ( $c, $opts ) = @_;
+    
+    return unless $c->_is_http_auth_type('basic');
+
+    if ( my $basic = $c->_build_basic_auth_header( $opts ) ) {
+        $c->_add_authentication_header( $basic );
+        return 1;
+    }
+
+    return;
+}
+
+sub _build_auth_header_realm {
+    my ( $c, $opts ) = @_;    
+
+    if ( my $realm = $opts->{realm} ) {
+        return 'realm=' . String::Escape::qprintable($realm);
+    } else {
+        return;
+    }
+}
+
+sub _build_auth_header_domain {
+    my ( $c, $opts ) = @_;
+
+    if ( my $domain = $opts->{domain} ) {
+        Catalyst::Exception->throw("domain must be an array reference")
+          unless ref($domain) && ref($domain) eq "ARRAY";
+
+        my @uris =
+          $c->config->{authentication}{http}{use_uri_for}
+          ? ( map { $c->uri_for($_) } @$domain )
+          : ( map { URI::Escape::uri_escape($_) } @$domain );
+
+        return qq{domain="@uris"};
+    } else {
+        return;
+    }
+}
+
+sub _build_auth_header_common {
+    my ( $c, $opts ) = @_;
+
+    return (
+        $c->_build_auth_header_realm($opts),
+        $c->_build_auth_header_domain($opts),
+    );
+}
+
+sub _build_basic_auth_header {
+    my ( $c, $opts ) = @_;
+    return $c->_join_auth_header_parts( Basic => $c->_build_auth_header_common( $opts ) );
+}
+
+sub _build_digest_auth_header {
+    my ( $c, $opts ) = @_;
+
+    my $nonce = $c->_digest_auth_nonce($opts);
+
+    my $key = __PACKAGE__ . '::opaque:' . $nonce->opaque;
+   
+    $c->store_digest_authorization_nonce( $key, $nonce );
+
+    return $c->_join_auth_header_parts( Digest =>
+        $c->_build_auth_header_common($opts),
+        map { sprintf '%s="%s"', $_, $nonce->$_ } qw(
+            qop
+            nonce
+            opaque
+            algorithm
+        ),
+    );
+}
+
+sub _digest_auth_nonce {
+    my ( $c, $opts ) = @_;
+
+    my $package = __PACKAGE__ . '::Nonce';
+
+    my $nonce   = $package->new;
+
+    if ( my $algorithm = $opts->{algorithm} || $c->config->{authentication}{http}{algorithm}) { 
+        $nonce->algorithm( $algorithm );
+    }
+
+    return $nonce;
+}
+
+sub _join_auth_header_parts {
+    my ( $c, $type, @parts ) = @_;
+    return "$type " . join(", ", @parts );
+}
+
+sub get_digest_authorization_nonce {
+    my ( $c, $key ) = @_;
+
+    $c->_check_cache;
+    $c->cache->get( $key );
+}
+
+sub store_digest_authorization_nonce {
+    my ( $c, $key, $nonce ) = @_;
+
+    $c->_check_cache;
+    $c->cache->set( $key, $nonce );
+}
+
+package Catalyst::Plugin::Authentication::Credential::HTTP::Nonce;
+
+use strict;
+use base qw[ Class::Accessor::Fast ];
+use Data::UUID ();
+
+our $VERSION = "0.01";
+
+__PACKAGE__->mk_accessors(qw[ nonce nonce_count qop opaque algorithm ]);
+
+sub new {
+    my $class = shift;
+    my $self  = $class->SUPER::new(@_);
+
+    $self->nonce( Data::UUID->new->create_b64 );
+    $self->opaque( Data::UUID->new->create_b64 );
+    $self->qop('auth,auth-int');
+    $self->nonce_count('0x0');
+    $self->algorithm('MD5');
+
+    return $self;
+}
+
 1;
 
 __END__
@@ -25,10 +380,145 @@
         Authentication::Credential::HTTP
     /;
 
+    __PACKAGE__->config->{authentication}{http}{type} = 'any'; # or 'digest' or 'basic'
+    __PACKAGE__->config->{authentication}{users} = {
+        Mufasa => { password => "Circle Of Life", },
+    };
+
+    sub foo : Local {
+        my ( $self, $c ) = @_;
+
+        $c->authorization_required( realm => "foo" ); # named after the status code ;-)
+
+        # either user gets authenticated or 401 is sent
+
+        do_stuff();
+    }
+
+    # with ACL plugin
+    __PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate_http });
+
+    sub end : Private {
+        my ( $self, $c ) = @_;
+
+        $c->authorization_required_response( realm => "foo" );
+        $c->error(0);
+    }
+
 =head1 DESCRIPTION
 
-This module is deprecated. Please see L<Catalyst::Authentication::Credential::HTTP>
+This moduule lets you use HTTP authentication with
+L<Catalyst::Plugin::Authentication>. Both basic and digest authentication
+are currently supported.
 
+When authentication is required, this module sets a status of 401, and
+the body of the response to 'Authorization required.'. To override
+this and set your own content, check for the C<< $c->res->status ==
+401 >> in your C<end> action, and change the body accordingly.
+
+=head2 TERMS
+
+=over 4
+
+=item Nonce
+
+A nonce is a one-time value sent with each digest authentication
+request header. The value must always be unique, so per default the
+last value of the nonce is kept using L<Catalyst::Plugin::Cache>. To
+change this behaviour, override the
+C<store_digest_authorization_nonce> and
+C<get_digest_authorization_nonce> methods as shown below.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item authorization_required %opts
+
+Tries to C<authenticate_http>, and if that fails calls
+C<authorization_required_response> and detaches the current action call stack.
+
+This method just passes the options through untouched.
+
+=item authenticate_http %opts
+
+Looks inside C<< $c->request->headers >> and processes the digest and basic
+(badly named) authorization header.
+
+This will only try the methods set in the configuration. First digest, then basic.
+
+See the next two methods for what %opts can contain.
+
+=item authenticate_basic %opts
+
+=item authenticate_digest %opts
+
+Try to authenticate one of the methods without checking if the method is
+allowed in the configuration.
+
+%opts can contain C<store> (either an object or a name), C<user> (to disregard
+%the username from the header altogether, overriding it with a username or user
+%object).
+
+=item authorization_required_response %opts
+
+Sets C<< $c->response >> to the correct status code, and adds the correct
+header to demand authentication data from the user agent.
+
+Typically used by C<authorization_required>, but may be invoked manually.
+
+%opts can contain C<realm>, C<domain> and C<algorithm>, which are used to build
+%the digest header.
+
+=item store_digest_authorization_nonce $key, $nonce
+
+=item get_digest_authorization_nonce $key
+
+Set or get the C<$nonce> object used by the digest auth mode.
+
+You may override these methods. By default they will call C<get> and C<set> on
+C<< $c->cache >>.
+
+=item get_http_auth_store %opts
+
+=back
+
+=head1 CONFIGURATION
+
+All configuration is stored in C<< YourApp->config->{authentication}{http} >>.
+
+This should be a hash, and it can contain the following entries:
+
+=over 4
+
+=item store
+
+Either a name or an object -- the default store to use for HTTP authentication.
+
+=item type
+
+Can be either C<any> (the default), C<basic> or C<digest>.
+
+This controls C<authorization_required_response> and C<authenticate_http>, but
+not the "manual" methods.
+
+=item authorization_required_message
+
+Set this to a string to override the default body content "Authorization required."
+
+=back
+
+=head1 RESTRICTIONS
+
+When using digest authentication, this module will only work together
+with authentication stores whose User objects have a C<password>
+method that returns the plain-text password. It will not work together
+with L<Catalyst::Authentication::Store::Htpasswd>, or
+L<Catalyst::Plugin::Authentication::Store::DBIC> stores whose
+C<password> methods return a hashed or salted version of the password.
+
 =head1 AUTHORS
 
 Yuval Kogman, C<nothingmuch at woobling.org>
@@ -37,11 +527,9 @@
 
 Sascha Kiefer C<esskar at cpan.org>
 
-Tomas Doran C<bobtfish at bobtfish.net>
-
 =head1 SEE ALSO
 
-L<Catalyst::Authentication::Credential::HTTP>.
+RFC 2617 (or its successors), L<Catalyst::Plugin::Cache>, L<Catalyst::Plugin::Authentication>
 
 =head1 COPYRIGHT & LICENSE
 


Property changes on: trunk/Catalyst-Plugin-Authentication-Credential-HTTP/lib/Catalyst/Plugin/Authentication/Credential/HTTP.pm
___________________________________________________________________
Name: eol
   + native

Deleted: trunk/Catalyst-Plugin-Authentication-Credential-HTTP/t/04pod_spelling.t
===================================================================
--- trunk/Catalyst-Plugin-Authentication-Credential-HTTP/t/04pod_spelling.t	2008-06-23 19:56:50 UTC (rev 7944)
+++ trunk/Catalyst-Plugin-Authentication-Credential-HTTP/t/04pod_spelling.t	2008-06-23 20:21:52 UTC (rev 7945)
@@ -1,23 +0,0 @@
-#!perl -w
-use strict;
-use warnings;
-use Test::More;
-
-eval 'use Test::Spelling 0.11';
-plan skip_all => 'Test::Spelling 0.11 not installed' if $@;
-plan skip_all => 'set TEST_SPELLING to enable this test' unless $ENV{TEST_SPELLING};
-
-set_spell_cmd('aspell list');
-
-add_stopwords( grep { defined $_ && length $_ } <DATA>);
-
-all_pod_files_spelling_ok();
-
-__DATA__
-behaviour
-Doran
-Kiefer
-Kogman
-Yuval
-auth
-username

Modified: trunk/Catalyst-Plugin-Authentication-Credential-HTTP/t/basic.t
===================================================================
--- trunk/Catalyst-Plugin-Authentication-Credential-HTTP/t/basic.t	2008-06-23 19:56:50 UTC (rev 7944)
+++ trunk/Catalyst-Plugin-Authentication-Credential-HTTP/t/basic.t	2008-06-23 20:21:52 UTC (rev 7945)
@@ -7,7 +7,7 @@
 use Test::Exception;
 use HTTP::Headers;
 
-my $m; BEGIN { use_ok($m = "Catalyst::Authentication::Credential::HTTP") }
+my $m; BEGIN { use_ok($m = "Catalyst::Plugin::Authentication::Credential::HTTP") }
 can_ok( $m, "authenticate_http" );
 can_ok( $m, "authorization_required" );
 can_ok( $m, "authorization_required_response" );

Modified: trunk/Catalyst-Plugin-Authentication-Credential-HTTP/t/live_app_digest.t
===================================================================
--- trunk/Catalyst-Plugin-Authentication-Credential-HTTP/t/live_app_digest.t	2008-06-23 19:56:50 UTC (rev 7944)
+++ trunk/Catalyst-Plugin-Authentication-Credential-HTTP/t/live_app_digest.t	2008-06-23 20:21:52 UTC (rev 7945)
@@ -6,12 +6,9 @@
     eval { require Test::WWW::Mechanize::Catalyst }
       or plan skip_all =>
       "Test::WWW::Mechanize::Catalyst is needed for this test";
-    eval { require Catalyst::Plugin::Cache }
+    eval { require Catalyst::Plugin::Cache::FileCache }
       or plan skip_all =>
-      "Catalyst::Plugin::Cache is needed for this test";
-    eval { require Cache::FileCache }
-      or plan skip_all =>
-      "Cache::FileCache is needed for this test";
+      "Catalyst::Plugin::Cache::FileCache is needed for this test";
     plan tests => 4;
 }
 use HTTP::Request;
@@ -21,7 +18,7 @@
       Authentication
       Authentication::Store::Minimal
       Authentication::Credential::HTTP
-      Cache
+      Cache::FileCache
       /;
     use Test::More;
     our $users;
@@ -30,9 +27,6 @@
         $c->authorization_required( realm => 'testrealm at host.com' );
         $c->res->body( $c->user->id );
     }
-    __PACKAGE__->config->{cache}{backend} = {
-        class => 'Cache::FileCache',
-    };
     __PACKAGE__->config->{authentication}{http}{type} = 'digest';
     __PACKAGE__->config->{authentication}{users} = $users = {
         Mufasa => { password         => "Circle Of Life", },
@@ -82,4 +76,3 @@
 $mech->request($r);
 is( $mech->status, 200, "status is 200" );
 $mech->content_contains( "Mufasa", "Mufasa output" );
-




More information about the Catalyst-commits mailing list