[Catalyst-commits] r8169 - in
Catalyst-Authentication-Credential-HTTP/1.000/trunk: .
lib/Catalyst lib/Catalyst/Authentication/Credential t
t0m at dev.catalyst.perl.org
t0m at dev.catalyst.perl.org
Wed Jul 30 15:43:05 BST 2008
Author: t0m
Date: 2008-07-30 15:43:05 +0100 (Wed, 30 Jul 2008)
New Revision: 8169
Added:
Catalyst-Authentication-Credential-HTTP/1.000/trunk/.shipit
Catalyst-Authentication-Credential-HTTP/1.000/trunk/Todo
Catalyst-Authentication-Credential-HTTP/1.000/trunk/lib/Catalyst/Authentication/
Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/04pod_spelling.t
Removed:
Catalyst-Authentication-Credential-HTTP/1.000/trunk/lib/Catalyst/Plugin/
Modified:
Catalyst-Authentication-Credential-HTTP/1.000/trunk/
Catalyst-Authentication-Credential-HTTP/1.000/trunk/Changes
Catalyst-Authentication-Credential-HTTP/1.000/trunk/MANIFEST.SKIP
Catalyst-Authentication-Credential-HTTP/1.000/trunk/Makefile.PL
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.t
Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/live_app_digest.t
Log:
Pour all my changes for the new auth framework on top of the module.
Property changes on: Catalyst-Authentication-Credential-HTTP/1.000/trunk
___________________________________________________________________
Name: svn:ignore
+ META.yml
pm_to_blib
MANIFEST
blib
inc
Makefile
.*.swp
Added: Catalyst-Authentication-Credential-HTTP/1.000/trunk/.shipit
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/trunk/.shipit (rev 0)
+++ Catalyst-Authentication-Credential-HTTP/1.000/trunk/.shipit 2008-07-30 14:43:05 UTC (rev 8169)
@@ -0,0 +1,10 @@
+# auto-generated shipit config file.
+steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest
+#, Commit, Tag, MakeDist
+
+svk.tagpattern = //mirror/Catalyst-Authentication-Credential-HTTP/1.000/tags/%v
+
+# svn.tagpattern = MyProj-%v
+# svn.tagpattern = http://code.example.com/svn/tags/MyProj-%v
+
+CheckChangeLog.files = Changes
Modified: Catalyst-Authentication-Credential-HTTP/1.000/trunk/Changes
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/trunk/Changes 2008-07-30 14:22:13 UTC (rev 8168)
+++ Catalyst-Authentication-Credential-HTTP/1.000/trunk/Changes 2008-07-30 14:43:05 UTC (rev 8169)
@@ -1,4 +1,12 @@
-0.11 2008-11-12
+1.000 2008-??-??
+ - Rename to remove Plugin from namespace. This is a pretty breaking change,
+ as lots of things work differently with the new auth refactor.
+ - Pull out some functionality which I think is better in other
+ modules (realms/stores). With the auth refactor, this module didn't need
+ to do so much. If anyone misses any of the functionality, please yell at
+ me and I'll put it back.
+
+0.11 2008-07-12
- Changed cache modules used in the tests to not be deprecated.
- Fix RT#31036, and comply with RFC2617 Section 1.2.
Modified: Catalyst-Authentication-Credential-HTTP/1.000/trunk/MANIFEST.SKIP
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/trunk/MANIFEST.SKIP 2008-07-30 14:22:13 UTC (rev 8168)
+++ Catalyst-Authentication-Credential-HTTP/1.000/trunk/MANIFEST.SKIP 2008-07-30 14:43:05 UTC (rev 8169)
@@ -21,3 +21,5 @@
\#$
\b\.#
^..*\.sw[po]$
+# Avoid ShipIt configuration
+.shipit
Modified: Catalyst-Authentication-Credential-HTTP/1.000/trunk/Makefile.PL
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/trunk/Makefile.PL 2008-07-30 14:22:13 UTC (rev 8168)
+++ Catalyst-Authentication-Credential-HTTP/1.000/trunk/Makefile.PL 2008-07-30 14:43:05 UTC (rev 8169)
@@ -1,10 +1,10 @@
use inc::Module::Install 0.65;
-name 'Catalyst-Plugin-Authentication-Credential-HTTP';
-all_from 'lib/Catalyst/Plugin/Authentication/Credential/HTTP.pm';
+name 'Catalyst-Authentication-Credential-HTTP';
+all_from 'lib/Catalyst/Authentication/Credential/HTTP.pm';
requires 'Catalyst::Runtime';
-requires 'Catalyst::Plugin::Authentication';
+requires 'Catalyst::Plugin::Authentication' => '0.10000';
requires 'Data::UUID' => '0.11';
requires 'String::Escape';
requires 'Test::Exception';
Added: Catalyst-Authentication-Credential-HTTP/1.000/trunk/Todo
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/trunk/Todo (rev 0)
+++ Catalyst-Authentication-Credential-HTTP/1.000/trunk/Todo 2008-07-30 14:43:05 UTC (rev 8169)
@@ -0,0 +1,13 @@
+. shipit
+. Port work's apps.
+. Document how to find the credential module, so that you can call authorization_required_response if you want to.
+. Document, and test overriding the realm's realm->name method.
+. Add deprecation notice to old module.
+. shipit
+. Test $self->_config->{authorization_required_message} + authorization_required_message = undef does not stamp on body.
+. 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
+. shipit
+. Steal NTLM from Catalyst::Plugin::Authentication::Store::HTTP
+
Copied: Catalyst-Authentication-Credential-HTTP/1.000/trunk/lib/Catalyst/Authentication (from rev 8168, Catalyst-Authentication-Credential-HTTP/1.000/trunk/lib/Catalyst/Plugin/Authentication)
Modified: Catalyst-Authentication-Credential-HTTP/1.000/trunk/lib/Catalyst/Authentication/Credential/HTTP.pm
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/trunk/lib/Catalyst/Plugin/Authentication/Credential/HTTP.pm 2008-07-30 14:22:13 UTC (rev 8168)
+++ Catalyst-Authentication-Credential-HTTP/1.000/trunk/lib/Catalyst/Authentication/Credential/HTTP.pm 2008-07-30 14:43:05 UTC (rev 8169)
@@ -1,8 +1,6 @@
-#!/usr/bin/perl
+package Catalyst::Authentication::Credential::HTTP;
+use base qw/Catalyst::Component/;
-package Catalyst::Plugin::Authentication::Credential::HTTP;
-use base qw/Catalyst::Plugin::Authentication::Credential::Password/;
-
use strict;
use warnings;
@@ -11,52 +9,68 @@
use Catalyst ();
use Digest::MD5 ();
-our $VERSION = "0.11";
+BEGIN {
+ __PACKAGE__->mk_accessors(qw/_config realm/);
+}
-sub authenticate_http {
- my ( $c, @args ) = @_;
+our $VERSION = "1.000";
- 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 new {
+ my ($class, $config, $app, $realm) = @_;
+
+ my $self = { _config => $config, _debug => $app->debug };
+ bless $self, $class;
+
+ $self->realm($realm);
+
+ my $type = $self->_config->{'type'} ||= 'any';
+
+ if (!grep /$type/, ('basic', 'digest', 'any')) {
+ Catalyst::Exception->throw(__PACKAGE__ . " used with unsupported authentication type: " . $type);
+ }
+ return $self;
}
-sub get_http_auth_store {
- my ( $c, %opts ) = @_;
+sub authenticate {
+ my ( $self, $c, $realm, $auth_info ) = @_;
+ my $auth;
- my $store = $opts{store} || $c->config->{authentication}{http}{store} || return;
+ $auth = $self->authenticate_digest($c, $realm, $auth_info) if $self->_is_http_auth_type('digest');
+ return $auth if $auth;
- return ref $store
- ? $store
- : $c->get_auth_store($store);
+ $auth = $self->authenticate_basic($c, $realm, $auth_info) if $self->_is_http_auth_type('basic');
+ return $auth if $auth;
+
+ $self->authorization_required_response($c, $realm, $auth_info);
+ die $Catalyst::DETACH;
}
sub authenticate_basic {
- my ( $c, %opts ) = @_;
+ my ( $self, $c, $realm, $auth_info ) = @_;
$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;
+ my $user_obj = $realm->find_user( { username => $username }, $c);
+ if (ref($user_obj)) {
+ if ($user_obj->check_password($password)) {
+ $c->set_authenticated($user_obj);
+ return $user_obj;
}
}
-
- return $c->login( $user, $password );
+ else {
+ $c->log->debug("Unable to locate user matching user info provided") if $c->debug;
+ return;
+ }
}
- return 0;
+ return;
}
sub authenticate_digest {
- my ( $c, %opts ) = @_;
+ my ( $self, $c, $realm, $auth_info ) = @_;
$c->log->debug('Checking http digest authentication.') if $c->debug;
@@ -64,7 +78,6 @@
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];
@@ -73,7 +86,7 @@
} split /,\s?/, substr( $authorization, 7 ); #7 == length "Digest "
my $opaque = $res{opaque};
- my $nonce = $c->get_digest_authorization_nonce( __PACKAGE__ . '::opaque:' . $opaque );
+ my $nonce = $self->get_digest_authorization_nonce( $c, __PACKAGE__ . '::opaque:' . $opaque );
next unless $nonce;
$c->log->debug('Checking authentication parameters.')
@@ -96,30 +109,25 @@
$c->log->debug('Digest authentication failed. Bad request.')
if $c->debug;
$c->res->status(400); # bad request
- die $Catalyst::DETACH;
+ Carp::confess $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 = $auth_info->{user} ) {
+ $user = $realm->find_user( { username => $username }, $c);
}
-
unless ($user) { # no user, no authentication
- $c->log->debug('Unknown user: $user.') if $c->debug;
- return 0;
+ $c->log->debug("Unable to locate user matching user info provided") if $c->debug;
+ return;
}
# 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} ) );
@@ -138,7 +146,7 @@
# 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->add( join( ':', $username, $realm->name, $user->password ) );
$ctx->hexdigest;
};
if ( $nonce->algorithm eq 'MD5-sess' ) {
@@ -147,23 +155,21 @@
$A1_digest = $ctx->hexdigest;
}
- my $rq_digest = Digest::MD5::md5_hex(
- join( ':',
+ my $digest_in = join( ':',
$A1_digest, $res{nonce},
$res{qop} ? ( $res{nc}, $res{cnonce}, $res{qop} ) : (),
- $A2_digest )
- );
-
+ $A2_digest );
+ my $rq_digest = Digest::MD5::md5_hex($digest_in);
$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};
+ if ($rq_digest eq $res{response}) {
+ $c->set_authenticated($user);
+ return 1;
+ }
}
}
-
- return 0;
+ return;
}
sub _check_cache {
@@ -171,59 +177,56 @@
die "A cache is needed for http digest authentication."
unless $c->can('cache');
+ return;
}
sub _is_http_auth_type {
- my ( $c, $type ) = @_;
-
- my $cfgtype = lc( $c->config->{authentication}{http}{type} || 'any' );
+ my ( $self, $type ) = @_;
+ my $cfgtype = lc( $self->_config->{'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 ) = @_;
+ my ( $self, $c, $realm, $auth_info ) = @_;
$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.');
+ if (exists $self->_config->{authorization_required_message}) {
+ # If you set the key to undef, don't stamp on the body.
+ $c->res->body($self->_config->{authorization_required_message})
+ if defined $c->res->body($self->_config->{authorization_required_message});
+ }
+ else {
+ $c->res->body('Authorization required.');
+ }
# *DONT* short circuit
my $ok;
- $ok++ if $c->_create_digest_auth_response(\%opts);
- $ok++ if $c->_create_basic_auth_response(\%opts);
+ $ok++ if $self->_create_digest_auth_response($c, $auth_info);
+ $ok++ if $self->_create_basic_auth_response($c, $auth_info);
unless ( $ok ) {
die 'Could not build authorization required response. '
. 'Did you configure a valid authentication http type: '
. 'basic, digest, any';
}
+ return;
}
sub _add_authentication_header {
my ( $c, $header ) = @_;
- $c->res->headers->push_header( 'WWW-Authenticate' => $header );
+ $c->response->headers->push_header( 'WWW-Authenticate' => $header );
+ return;
}
sub _create_digest_auth_response {
- my ( $c, $opts ) = @_;
+ my ( $self, $c, $opts ) = @_;
- return unless $c->_is_http_auth_type('digest');
+ return unless $self->_is_http_auth_type('digest');
- if ( my $digest = $c->_build_digest_auth_header( $opts ) ) {
- $c->_add_authentication_header( $digest );
+ if ( my $digest = $self->_build_digest_auth_header( $c, $opts ) ) {
+ _add_authentication_header( $c, $digest );
return 1;
}
@@ -231,12 +234,12 @@
}
sub _create_basic_auth_response {
- my ( $c, $opts ) = @_;
+ my ( $self, $c, $opts ) = @_;
- return unless $c->_is_http_auth_type('basic');
+ return unless $self->_is_http_auth_type('basic');
- if ( my $basic = $c->_build_basic_auth_header( $opts ) ) {
- $c->_add_authentication_header( $basic );
+ if ( my $basic = $self->_build_basic_auth_header( $c, $opts ) ) {
+ _add_authentication_header( $c, $basic );
return 1;
}
@@ -244,60 +247,58 @@
}
sub _build_auth_header_realm {
- my ( $c, $opts ) = @_;
+ my ( $self ) = @_;
- if ( my $realm = $opts->{realm} ) {
- my $realm_name = String::Escape::qprintable($realm);
- $realm_name =~ s/"/\\"/g;
- return 'realm="' . $realm_name . '"';
- } else {
- return;
- }
+ if ( my $realm = $self->realm ) {
+ my $realm_name = String::Escape::qprintable($realm->name);
+ $realm_name = qq{"$realm_name"} unless $realm_name =~ /^"/;
+ return 'realm=' . $realm_name;
+ }
+ return;
}
sub _build_auth_header_domain {
- my ( $c, $opts ) = @_;
+ my ( $self, $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}
+ $self->_config->{use_uri_for}
? ( map { $c->uri_for($_) } @$domain )
: ( map { URI::Escape::uri_escape($_) } @$domain );
return qq{domain="@uris"};
- } else {
- return;
- }
+ }
+ return;
}
sub _build_auth_header_common {
- my ( $c, $opts ) = @_;
+ my ( $self, $c, $opts ) = @_;
return (
- $c->_build_auth_header_realm($opts),
- $c->_build_auth_header_domain($opts),
+ $self->_build_auth_header_realm(),
+ $self->_build_auth_header_domain($c, $opts),
);
}
sub _build_basic_auth_header {
- my ( $c, $opts ) = @_;
- return $c->_join_auth_header_parts( Basic => $c->_build_auth_header_common( $opts ) );
+ my ( $self, $c, $opts ) = @_;
+ return _join_auth_header_parts( Basic => $self->_build_auth_header_common( $c, $opts ) );
}
sub _build_digest_auth_header {
- my ( $c, $opts ) = @_;
+ my ( $self, $c, $opts ) = @_;
- my $nonce = $c->_digest_auth_nonce($opts);
+ my $nonce = $self->_digest_auth_nonce($c, $opts);
my $key = __PACKAGE__ . '::opaque:' . $nonce->opaque;
- $c->store_digest_authorization_nonce( $key, $nonce );
+ $self->store_digest_authorization_nonce( $c, $key, $nonce );
- return $c->_join_auth_header_parts( Digest =>
- $c->_build_auth_header_common($opts),
+ return _join_auth_header_parts( Digest =>
+ $self->_build_auth_header_common($c, $opts),
map { sprintf '%s="%s"', $_, $nonce->$_ } qw(
qop
nonce
@@ -308,13 +309,13 @@
}
sub _digest_auth_nonce {
- my ( $c, $opts ) = @_;
+ my ( $self, $c, $opts ) = @_;
my $package = __PACKAGE__ . '::Nonce';
my $nonce = $package->new;
- if ( my $algorithm = $opts->{algorithm} || $c->config->{authentication}{http}{algorithm}) {
+ if ( my $algorithm = $opts->{algorithm} || $self->_config->{algorithm}) {
$nonce->algorithm( $algorithm );
}
@@ -322,31 +323,31 @@
}
sub _join_auth_header_parts {
- my ( $c, $type, @parts ) = @_;
+ my ( $type, @parts ) = @_;
return "$type " . join(", ", @parts );
}
sub get_digest_authorization_nonce {
- my ( $c, $key ) = @_;
-
- $c->_check_cache;
- $c->cache->get( $key );
+ my ( $self, $c, $key ) = @_;
+
+ _check_cache($c);
+ return $c->cache->get( $key );
}
sub store_digest_authorization_nonce {
- my ( $c, $key, $nonce ) = @_;
+ my ( $self, $c, $key, $nonce ) = @_;
- $c->_check_cache;
- $c->cache->set( $key, $nonce );
+ _check_cache($c);
+ return $c->cache->set( $key, $nonce );
}
-package Catalyst::Plugin::Authentication::Credential::HTTP::Nonce;
+package Catalyst::Authentication::Credential::HTTP::Nonce;
use strict;
use base qw[ Class::Accessor::Fast ];
use Data::UUID ();
-our $VERSION = "0.01";
+our $VERSION = '0.02';
__PACKAGE__->mk_accessors(qw[ nonce nonce_count qop opaque algorithm ]);
@@ -371,45 +372,47 @@
=head1 NAME
-Catalyst::Plugin::Authentication::Credential::HTTP - HTTP Basic and Digest authentication
+Catalyst::Authentication::Credential::HTTP - HTTP Basic and Digest authentication
for Catalyst.
=head1 SYNOPSIS
use Catalyst qw/
Authentication
- Authentication::Store::Minimal
- Authentication::Credential::HTTP
/;
- __PACKAGE__->config->{authentication}{http}{type} = 'any'; # or 'digest' or 'basic'
- __PACKAGE__->config->{authentication}{users} = {
- Mufasa => { password => "Circle Of Life", },
- };
+ __PACKAGE__->config( authentication => {
+ realms => {
+ example => {
+ credential => {
+ class => 'HTTP',
+ type => 'any', # or 'digest' or 'basic'
+ },
+ store => {
+ class => 'Minimal',
+ users => {
+ Mufasa => { password => "Circle Of Life", },
+ },
+ },
+ },
+ }
+ });
sub foo : Local {
my ( $self, $c ) = @_;
- $c->authorization_required( realm => "foo" ); # named after the status code ;-)
-
+ $c->authenticate({ realm => "example" });
# either user gets authenticated or 401 is sent
do_stuff();
}
# with ACL plugin
- __PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate_http });
+ __PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate });
- sub end : Private {
- my ( $self, $c ) = @_;
-
- $c->authorization_required_response( realm => "foo" );
- $c->error(0);
- }
-
=head1 DESCRIPTION
-This moduule lets you use HTTP authentication with
+This module lets you use HTTP authentication with
L<Catalyst::Plugin::Authentication>. Both basic and digest authentication
are currently supported.
@@ -437,78 +440,68 @@
=over 4
-=item authorization_required %opts
+=item new $config, $c, $realm
-Tries to C<authenticate_http>, and if that fails calls
-C<authorization_required_response> and detaches the current action call stack.
+Simple constructor.
-This method just passes the options through untouched.
+=item authenticate $c, $realm, \%auth_info
-=item authenticate_http %opts
+Tries to authenticate the user, and if that fails calls
+C<authorization_required_response> and detaches the current action call stack.
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.
+This method just passes the options through untouched. See the next two methods for what \%auth_info can contain.
-=item authenticate_basic %opts
+=item authenticate_basic $c, $realm, \%auth_info
-=item authenticate_digest %opts
+=item authenticate_digest $c, $realm, \%auth_info
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 $c, $realm, \%auth_info
-=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.
+Typically used by C<authenticate>, but may be invoked manually.
-%opts can contain C<realm>, C<domain> and C<algorithm>, which are used to build
+%opts can contain C<domain> and C<algorithm>, which are used to build
%the digest header.
-=item store_digest_authorization_nonce $key, $nonce
+=item store_digest_authorization_nonce $c, $key, $nonce
-=item get_digest_authorization_nonce $key
+=item get_digest_authorization_nonce $c, $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} >>.
+All configuration is stored in C<< YourApp->config(authentication => { yourrealm => { credential => { class => 'HTTP', %config } } } >>.
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
+This controls C<authorization_required_response> and C<authenticate>, but
not the "manual" methods.
=item authorization_required_message
-Set this to a string to override the default body content "Authorization required."
+Set this to a string to override the default body content "Authorization required.", or set to undef to suppress body content being generated.
=back
@@ -518,25 +511,35 @@
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
+L<Catalyst::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>
+Updated to current name space and currently maintained
+by: Tomas Doran C<bobtfish at bobtfish.net>.
-Jess Robinson
+Original module by:
-Sascha Kiefer C<esskar at cpan.org>
+=over
+=item Yuval Kogman, C<nothingmuch at woobling.org>
+
+=item Jess Robinson
+
+=item Sascha Kiefer C<esskar at cpan.org>
+
+=back
+
=head1 SEE ALSO
RFC 2617 (or its successors), L<Catalyst::Plugin::Cache>, L<Catalyst::Plugin::Authentication>
=head1 COPYRIGHT & LICENSE
- Copyright (c) 2005-2006 the aforementioned authors. All rights
+ Copyright (c) 2005-2008 the aforementioned authors. All rights
reserved. This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
=cut
+
Added: Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/04pod_spelling.t
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/04pod_spelling.t (rev 0)
+++ Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/04pod_spelling.t 2008-07-30 14:43:05 UTC (rev 8169)
@@ -0,0 +1,23 @@
+#!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: Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/basic.t
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/basic.t 2008-07-30 14:22:13 UTC (rev 8168)
+++ Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/basic.t 2008-07-30 14:43:05 UTC (rev 8169)
@@ -1,15 +1,14 @@
#!/usr/bin/perl
use strict;
use warnings;
-use Test::More tests => 15;
+use Test::More tests => 22;
use Test::MockObject::Extends;
use Test::MockObject;
use Test::Exception;
use HTTP::Headers;
-my $m; BEGIN { use_ok($m = "Catalyst::Plugin::Authentication::Credential::HTTP") }
-can_ok( $m, "authenticate_http" );
-can_ok( $m, "authorization_required" );
+my $m; BEGIN { use_ok($m = "Catalyst::Authentication::Credential::HTTP") }
+can_ok( $m, "authenticate" );
can_ok( $m, "authorization_required_response" );
my $req = Test::MockObject->new;
my $req_headers = HTTP::Headers->new;
@@ -20,10 +19,19 @@
my $content_type;
$res->mock(content_type => sub { $content_type = $_[1] });
my $body;
+my $headers;
+#$res->mock(headers => sub { use Data::Dumper; warn Dumper(\@_); $headers = $_[1]; });
$res->mock(body => sub { $body = $_[1] });
my $res_headers = HTTP::Headers->new;
$res->set_always( headers => $res_headers );
-my $c = Test::MockObject::Extends->new( $m );
+my $realm = Test::MockObject->new;
+my $find_user_opts;
+my $user = Test::MockObject->new;
+my $user_pw;
+$user->mock( check_password => sub { $user_pw = $_[1]; return 1; } );
+$realm->mock( find_user => sub { $find_user_opts = $_[1]; return $user; });
+$realm->mock( name => sub { 'foo' } );
+my $c = Test::MockObject->new;
my $cache = Test::MockObject->new;
$cache->mock(set => sub { shift->{$_[0]} = $_[1] });
$cache->mock(get => sub { return shift->{$_[0]} });
@@ -31,26 +39,46 @@
$c->mock(debug => sub { 0 });
my @login_info;
$c->mock( login => sub { shift; @login_info = @_; 1 } );
+my $authenticated = 0;
+$c->mock( set_authenticated => sub { $authenticated++; } );
$c->set_always( config => {} );
$c->set_always( req => $req );
$c->set_always( res => $res );
-
-ok( !$c->authenticate_http, "http auth fails without header");
+$c->set_always( request => $req );
+$c->set_always( response => $res );
+my $config = { type => 'any' };
+my $raw_self = $m->new($config, $c, $realm);
+my $self = Test::MockObject::Extends->new( $raw_self );
+eval {
+ $self->authenticate($c, $realm);
+};
+is($@, $Catalyst::DETACH, 'Calling authenticate for http auth without header detaches');
$req_headers->authorization_basic( qw/foo bar/ );
-ok( $c->authenticate_http, "auth successful with header");
-is_deeply( \@login_info, [qw/foo bar/], "login info delegated");
-lives_ok {
- $c->authorization_required
-} "no detach on authorization required with successful authentication";
+ok($self->authenticate($c, $realm), "auth successful with header");
+is($authenticated, 1, 'authenticated once');
+is($user_pw, 'bar', 'password delegated');
+is_deeply( $find_user_opts, { username => 'foo'}, "login delegated");
$req_headers->clear;
$c->clear;
throws_ok {
- $c->authorization_required( realm => "foo" );
+ $self->authenticate( $c, $realm );
} qr/^ $Catalyst::DETACH $/x, "detached on no authorization required with bad auth";
is( $status, 401, "401 status code" );
is( $content_type, 'text/plain' );
is( $body, 'Authorization required.' );
like( ($res_headers->header('WWW-Authenticate'))[0], qr/^Digest/, "WWW-Authenticate header set: digest");
+like( ($res_headers->header('WWW-Authenticate'))[0], qr/realm="foo"/, "WWW-Authenticate header set: digest realm");
like( ($res_headers->header('WWW-Authenticate'))[1], qr/^Basic/, "WWW-Authenticate header set: basic");
-like( ($res_headers->header('WWW-Authenticate'))[1], qr/realm="foo"/, "WWW-Authenticate header set: basic with realm");
+like( ($res_headers->header('WWW-Authenticate'))[1], qr/realm="foo"/, "WWW-Authenticate header set: basic realm");
+throws_ok {
+ $self->authenticate( $c, $realm, { realm => 'myrealm' }); # Override realm object's name method by doing this.
+} qr/^ $Catalyst::DETACH $/x, "detached on no authorization required with bad auth";
+is( $status, 401, "401 status code" );
+is( $content_type, 'text/plain' );
+is( $body, 'Authorization required.' );
+TODO: {
+ local $TODO = 'This should work, it (or something very like it) used to work';
+ like( ($res_headers->header('WWW-Authenticate'))[0], qr/realm="myrealm"/, "WWW-Authenticate header set: digest realm overridden");
+ like( ($res_headers->header('WWW-Authenticate'))[1], qr/realm="myrealm"/, "WWW-Authenticate header set: basic realm overridden");
+}
Modified: Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/live_app.t
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/live_app.t 2008-07-30 14:22:13 UTC (rev 8168)
+++ Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/live_app.t 2008-07-30 14:43:05 UTC (rev 8169)
@@ -13,29 +13,45 @@
package AuthTestApp;
use Catalyst qw/
Authentication
- Authentication::Store::Minimal
- Authentication::Credential::HTTP
/;
use Test::More;
- our $users;
+ our %users;
+ __PACKAGE__->config(authentication => {
+ default_realm => 'test',
+ realms => {
+ test => {
+ store => {
+ class => 'Minimal',
+ users => \%users,
+ },
+ credential => {
+ class => 'HTTP',
+ type => 'basic',
+ },
+ },
+ },
+ });
+ sub auto : Private {
+ my ($self, $c) = @_;
+ $c->authenticate();
+ }
sub moose : Local {
my ( $self, $c ) = @_;
- $c->authorization_required;
- $c->res->body( $c->user->id );
+ $c->res->body( $c->user->id );
}
- __PACKAGE__->config->{authentication}{http}{type} = 'basic';
- __PACKAGE__->config->{authentication}{users} = $users = {
+ %users = (
foo => { password => "s3cr3t", },
- };
+ );
__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" );
+is( $mech->status, 401, "status is 401" ) or die $mech->content;
$mech->content_lacks( "foo", "no output" );
my $r = HTTP::Request->new( GET => "http://localhost/moose" );
$r->authorization_basic(qw/foo s3cr3t/);
$mech->request($r);
is( $mech->status, 200, "status is 200" );
$mech->content_contains( "foo", "foo output" );
+
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-07-30 14:22:13 UTC (rev 8168)
+++ Catalyst-Authentication-Credential-HTTP/1.000/trunk/t/live_app_digest.t 2008-07-30 14:43:05 UTC (rev 8169)
@@ -9,7 +9,7 @@
eval { require Catalyst::Plugin::Cache }
or plan skip_all =>
"Catalyst::Plugin::Cache is needed for this test";
- eval { require Cache::FileCache }
+ eval { require Cache::FileCache }
or plan skip_all =>
"Cache::FileCache is needed for this test";
plan tests => 4;
@@ -19,24 +19,35 @@
package AuthTestApp;
use Catalyst qw/
Authentication
- Authentication::Store::Minimal
- Authentication::Credential::HTTP
Cache
/;
use Test::More;
- our $users;
+ our %users;
sub moose : Local {
my ( $self, $c ) = @_;
- $c->authorization_required( realm => 'testrealm at host.com' );
+ #$c->authenticate( { realm => 'testrealm at host.com' } );
+ $c->authenticate();
$c->res->body( $c->user->id );
}
+ %users = ( Mufasa => { password => "Circle Of Life", }, );
__PACKAGE__->config->{cache}{backend} = {
class => 'Cache::FileCache',
};
- __PACKAGE__->config->{authentication}{http}{type} = 'digest';
- __PACKAGE__->config->{authentication}{users} = $users = {
- Mufasa => { password => "Circle Of Life", },
- };
+ __PACKAGE__->config( authentication => {
+ default_realm => 'testrealm at host.com',
+ realms => {
+ 'testrealm at host.com' => {
+ store => {
+ class => 'Minimal',
+ users => \%users,
+ },
+ credential => {
+ class => 'HTTP',
+ type => 'digest',
+ },
+ },
+ },
+ });
__PACKAGE__->setup;
}
use Test::WWW::Mechanize::Catalyst qw/AuthTestApp/;
@@ -82,3 +93,4 @@
$mech->request($r);
is( $mech->status, 200, "status is 200" );
$mech->content_contains( "Mufasa", "Mufasa output" );
+
More information about the Catalyst-commits
mailing list