#!/usr/bin/perl
+
+
package Catalyst::Plugin::Authentication::Credential::HTTP;
+
use base qw/Catalyst::Plugin::Authentication::Credential::Password/;
+
+
use strict;
+
use warnings;
+
+
use String::Escape ();
+
use URI::Escape ();
-our $VERSION = "0.01";
+use Catalyst ();
+
+use Digest::MD5 ();
+
+
+
+our $VERSION = "0.05";
+
+
sub authenticate_http {
+
my $c = shift;
+
+
+ return $c->authenticate_digest || $c->authenticate_basic;
+
+}
+
+
+
+sub authenticate_basic {
+
+ my $c = shift;
+
+
+
+ $c->log->debug('Checking http basic authentication.') if $c->debug;
+
+
+
my $headers = $c->req->headers;
+
+
if ( my ( $user, $password ) = $headers->authorization_basic ) {
+
+
if ( my $store = $c->config->{authentication}{http}{store} ) {
+
$user = $store->get_user($user);
+
}
+
+
return $c->login( $user, $password );
+
+ }
+
+
+
+ return 0;
+
+}
+
+
+
+sub authenticate_digest {
+
+ my $c = shift;
+
+
+
+ $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};
+
+
+
+ $c->_check_cache;
+
+
+
+ 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->cache->get( __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;
+
+ my $store = $c->config->{authentication}{http}{store}
+
+ || $c->default_auth_store;
+
+ $user = $store->get_user($username) if $store;
+
+ 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_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, %opts ) = @_;
- return 1 if $c->authenticate_http;
- $c->authorization_required_response( %opts );
+
+ return 1 if $c->_is_auth_type('digest') && $c->authenticate_digest;
+
+ return 1 if $c->_is_auth_type('basic') && $c->authenticate_basic;
+
+
+
+ $c->authorization_required_response(%opts);
+
+
die $Catalyst::DETACH;
+
}
+
+
sub authorization_required_response {
+
my ( $c, %opts ) = @_;
-
+
+
+
$c->res->status(401);
+
+
+ my ( $digest, $basic );
+
+ $digest = $c->build_authorization_required_response( \%opts, 'Digest' )
+
+ if $c->_is_auth_type('digest');
+
+ $basic = $c->build_authorization_required_response( \%opts, 'Basic' )
+
+ if $c->_is_auth_type('basic');
+
+
+
+ die 'Could not build authorization required response. '
+
+ . 'Did you configure a valid authentication http type: '
+
+ . 'basic, digest, any'
+
+ unless $digest || $basic;
+
+
+
+ $c->res->headers->push_header( 'WWW-Authenticate' => $digest )
+
+ if $digest;
+
+ $c->res->headers->push_header( 'WWW-Authenticate' => $basic ) if $basic;
+
+}
+
+
+
+sub build_authorization_required_response {
+
+ my ( $c, $opts, $type ) = @_;
+
my @opts;
- if ( my $realm = $opts{realm} ) {
- push @opts, sprintf 'realm=%s', String::Escape::qprintable($realm);
+
+
+ if ( my $realm = $opts->{realm} ) {
+
+ push @opts, 'realm=' . String::Escape::qprintable($realm);
+
}
- if ( my $domain = $opts{domain} ) {
+
+
+ if ( my $domain = $opts->{domain} ) {
+
Catalyst::Excpetion->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 );
+
+
push @opts, qq{domain="@uris"};
+
+ }
+
+
+
+ if ( $type eq 'Digest' ) {
+
+ my $package = __PACKAGE__ . '::Nonce';
+
+ my $nonce = $package->new;
+
+ $nonce->algorithm( $c->config->{authentication}{http}{algorithm}
+
+ || $nonce->algorithm );
+
+
+
+ push @opts, 'qop="' . $nonce->qop . '"';
+
+ push @opts, 'nonce="' . $nonce->nonce . '"';
+
+ push @opts, 'opaque="' . $nonce->opaque . '"';
+
+ push @opts, 'algorithm="' . $nonce->algorithm . '"';
+
+
+
+ $c->_check_cache;
+
+ $c->cache->set( __PACKAGE__ . '::opaque:' . $nonce->opaque, $nonce );
+
}
- $c->res->headers->www_authenticate(join " ", "Basic", @opts);
+
+
+ return "$type " . join( ', ', @opts );
+
}
-__PACKAGE__;
+
+
+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__
+
+
=pod
+
+
=head1 NAME
-Catalyst::Plugin::Authentication::Credential::HTTP - HTTP Basic authentication
+
+
+Catalyst::Plugin::Authentication::Credential::HTTP - HTTP Basic and Digest authentication
+
for Catlayst.
+
+
=head1 SYNOPSIS
- use Catalyst qw/
+
+
+ use Catalyst qw/
+
Authentication
+
Authentication::Store::Moose
+
Authentication::Credential::HTTP
+
/;
- sub foo : Local {
+
+
+ __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_requried( realm => "foo" ); # named after the status code ;-)
+
+
+ $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 moduule lets you use HTTP authentication with
-L<Catalyst::Plugin::Authentication>.
-Currently this module only supports the Basic scheme, but upon request Digest
-will also be added. Patches welcome!
+L<Catalyst::Plugin::Authentication>. Both basic and digest authentication
+
+are currently supported.
+
+
=head1 METHODS
+
+
=over 4
+
+
=item authorization_required
-Tries to C<authenticate_http>, and if that files calls
+
+
+Tries to C<authenticate_http>, and if that fails calls
+
C<authorization_required_response> and detaches the current action call stack.
+
+
=item authenticate_http
-Looks inside C<< $c->request->headers >> and processes the basic (badly named)
-authorization header.
+
+
+Looks inside C<< $c->request->headers >> and processes the digest and basic
+
+(badly named) authorization header.
+
+
=item authorization_required_response
+
+
Sets C<< $c->response >> to the correct status code, and adds the correct
+
header to demand authentication data from the user agent.
+
+
=back
-=cut
+=head1 AUTHORS
+
+
+
+Yuval Kogman, C<nothingmuch@woobling.org>
+
+
+
+Jess Robinson
+
+
+
+Sascha Kiefer C<esskar@cpan.org>
+
+
+
+=head1 COPYRIGHT & LICENSE
+
+
+
+ Copyright (c) 2005-2006 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
+
projects / catagits/Catalyst-Authentication-Credential-HTTP.git / blobdiff