-#!/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 ();
-use Catalyst ();
-
-our $VERSION = "0.01";
-
-sub authenticate_http {
- my $c = shift;
-
- 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 );
- }
-}
-
-sub authorization_required {
- my ( $c, %opts ) = @_;
-
- return 1 if $c->authenticate_http;
-
- $c->authorization_required_response( %opts );
-
- die $Catalyst::DETACH;
-}
-
-sub authorization_required_response {
- my ( $c, %opts ) = @_;
-
- $c->res->status(401);
-
- my @opts;
-
- if ( my $realm = $opts{realm} ) {
- push @opts, sprintf 'realm=%s', String::Escape::qprintable($realm);
- }
-
- 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"};
- }
-
- $c->res->headers->www_authenticate(join " ", "Basic", @opts);
-}
-
-__PACKAGE__;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Catalyst::Plugin::Authentication::Credential::HTTP - HTTP Basic authentication
-for Catlayst.
-
-=head1 SYNOPSIS
-
- use Catalyst qw/
- Authentication
- Authentication::Store::Moose
- Authentication::Credential::HTTP
- /;
-
- 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 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!
-
-=head1 METHODS
-
-=over 4
-
-=item authorization_required
-
-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.
-
-=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
-
-=head1 AUTHORS
-
-Yuval Kogman, C<nothingmuch@woobling.org>
-
-Jess Robinson
-
-=head1 COPYRIGHT & LICENSE
-
- Copyright (c) 2005 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
-
+#!/usr/bin/perl\r
+\r
+package Catalyst::Plugin::Authentication::Credential::HTTP;\r
+use base qw/Catalyst::Plugin::Authentication::Credential::Password/;\r
+\r
+use strict;\r
+use warnings;\r
+\r
+use String::Escape ();\r
+use URI::Escape ();\r
+use Catalyst ();\r
+use Digest::MD5 ();\r
+\r
+our $VERSION = "0.02";\r
+\r
+sub authenticate_http {\r
+ my $c = shift;\r
+\r
+ return $c->authenticate_digest || $c->authenticate_basic;\r
+}\r
+\r
+sub authenticate_basic {\r
+ my $c = shift;\r
+\r
+ $c->log->debug('Checking http basic authentication.') if $c->debug;\r
+\r
+ my $headers = $c->req->headers;\r
+\r
+ if ( my ( $user, $password ) = $headers->authorization_basic ) {\r
+\r
+ if ( my $store = $c->config->{authentication}{http}{store} ) {\r
+ $user = $store->get_user($user);\r
+ }\r
+\r
+ return $c->login( $user, $password );\r
+ }\r
+\r
+ return 0;\r
+}\r
+\r
+sub authenticate_digest {\r
+ my $c = shift;\r
+\r
+ $c->log->debug('Checking http digest authentication.') if $c->debug;\r
+\r
+ my $headers = $c->req->headers;\r
+ my @authorization = $headers->header('Authorization');\r
+ foreach my $authorization (@authorization) {\r
+ next unless $authorization =~ m{^Digest};\r
+\r
+ $c->_check_cache;\r
+\r
+ my %res = map {\r
+ my @key_val = split /=/, $_, 2;\r
+ $key_val[0] = lc $key_val[0];\r
+ $key_val[1] =~ s{"}{}g; # remove the quotes\r
+ @key_val;\r
+ } split /,\s?/, substr( $authorization, 7 ); #7 == length "Digest "\r
+\r
+ my $opaque = $res{opaque};\r
+ my $nonce = $c->cache->get( __PACKAGE__ . '::opaque:' . $opaque );\r
+ next unless $nonce;\r
+\r
+ $c->log->debug('Checking authentication parameters.')\r
+ if $c->debug;\r
+\r
+ my $uri = '/' . $c->request->path;\r
+ my $algorithm = $res{algorithm} || 'MD5';\r
+ my $nonce_count = '0x' . $res{nc};\r
+\r
+ my $check = $uri eq $res{uri}\r
+ && ( exists $res{username} )\r
+ && ( exists $res{qop} )\r
+ && ( exists $res{cnonce} )\r
+ && ( exists $res{nc} )\r
+ && $algorithm eq $nonce->algorithm\r
+ && hex($nonce_count) > hex( $nonce->nonce_count )\r
+ && $res{nonce} eq $nonce->nonce; # TODO: set Stale instead\r
+\r
+ unless ($check) {\r
+ $c->log->debug('Digest authentication failed. Bad request.')\r
+ if $c->debug;\r
+ $c->res->status(400); # bad request\r
+ die $Catalyst::DETACH;\r
+ }\r
+\r
+ $c->log->debug('Checking authentication response.')\r
+ if $c->debug;\r
+\r
+ my $username = $res{username};\r
+ my $realm = $res{realm};\r
+\r
+ my $user;\r
+ my $store = $c->config->{authentication}{http}{store}\r
+ || $c->default_auth_store;\r
+ $user = $store->get_user($username) if $store;\r
+ unless ($user) { # no user, no authentication\r
+ $c->log->debug('Unknown user: $user.') if $c->debug;\r
+ return 0;\r
+ }\r
+\r
+ # everything looks good, let's check the response\r
+\r
+ # calculate H(A2) as per spec\r
+ my $ctx = Digest::MD5->new;\r
+ $ctx->add( join( ':', $c->request->method, $res{uri} ) );\r
+ if ( $res{qop} eq 'auth-int' ) {\r
+ my $digest =\r
+ Digest::MD5::md5_hex( $c->request->body ); # not sure here\r
+ $ctx->add( ':', $digest );\r
+ }\r
+ my $A2_digest = $ctx->hexdigest;\r
+\r
+ # the idea of the for loop:\r
+ # if we do not want to store the plain password in our user store,\r
+ # we can store md5_hex("$username:$realm:$password") instead\r
+ for my $r ( 0 .. 1 ) {\r
+\r
+ # calculate H(A1) as per spec\r
+ my $A1_digest = $r ? $user->password : do {\r
+ $ctx = Digest::MD5->new;\r
+ $ctx->add( join( ':', $username, $realm, $user->password ) );\r
+ $ctx->hexdigest;\r
+ };\r
+ if ( $nonce->algorithm eq 'MD5-sess' ) {\r
+ $ctx = Digest::MD5->new;\r
+ $ctx->add( join( ':', $A1_digest, $res{nonce}, $res{cnonce} ) );\r
+ $A1_digest = $ctx->hexdigest;\r
+ }\r
+\r
+ my $rq_digest = Digest::MD5::md5_hex(\r
+ join( ':',\r
+ $A1_digest, $res{nonce},\r
+ $res{qop} ? ( $res{nc}, $res{cnonce}, $res{qop} ) : (),\r
+ $A2_digest )\r
+ );\r
+\r
+ $nonce->nonce_count($nonce_count);\r
+ $c->cache->set( __PACKAGE__ . '::opaque:' . $nonce->opaque,\r
+ $nonce );\r
+\r
+ return $c->login( $user, $user->password )\r
+ if $rq_digest eq $res{response};\r
+ }\r
+ }\r
+\r
+ return 0;\r
+}\r
+\r
+sub _check_cache {\r
+ my $c = shift;\r
+\r
+ die "A cache is needed for http digest authentication."\r
+ unless $c->can('cache');\r
+}\r
+\r
+sub _is_auth_type {\r
+ my ( $c, $type ) = @_;\r
+\r
+ my $cfgtype = lc( $c->config->{authentication}{http}{type} || 'any' );\r
+ return 1 if $cfgtype eq 'any' || $cfgtype eq lc $type;\r
+ return 0;\r
+}\r
+\r
+sub authorization_required {\r
+ my ( $c, %opts ) = @_;\r
+\r
+ return 1 if $c->_is_auth_type('digest') && $c->authenticate_digest;\r
+ return 1 if $c->_is_auth_type('basic') && $c->authenticate_basic;\r
+\r
+ $c->authorization_required_response(%opts);\r
+\r
+ die $Catalyst::DETACH;\r
+}\r
+\r
+sub authorization_required_response {\r
+ my ( $c, %opts ) = @_;\r
+\r
+ $c->res->status(401);\r
+\r
+ my ( $digest, $basic );\r
+ $digest = $c->build_authorization_required_response( \%opts, 'Digest' )\r
+ if $c->_is_auth_type('digest');\r
+ $basic = $c->build_authorization_required_response( \%opts, 'Basic' )\r
+ if $c->_is_auth_type('basic');\r
+\r
+ die 'Could not build authorization required response. '\r
+ . 'Did you configure a valid authentication http type: '\r
+ . 'basic, digest, any'\r
+ unless $digest || $basic;\r
+\r
+ $c->res->headers->push_header( 'WWW-Authenticate' => $digest )\r
+ if $digest;\r
+ $c->res->headers->push_header( 'WWW-Authenticate' => $basic ) if $basic;\r
+}\r
+\r
+sub build_authorization_required_response {\r
+ my ( $c, $opts, $type ) = @_;\r
+ my @opts;\r
+\r
+ if ( my $realm = $opts->{realm} ) {\r
+ push @opts, 'realm=' . String::Escape::qprintable($realm);\r
+ }\r
+\r
+ if ( my $domain = $opts->{domain} ) {\r
+ Catalyst::Excpetion->throw("domain must be an array reference")\r
+ unless ref($domain) && ref($domain) eq "ARRAY";\r
+\r
+ my @uris =\r
+ $c->config->{authentication}{http}{use_uri_for}\r
+ ? ( map { $c->uri_for($_) } @$domain )\r
+ : ( map { URI::Escape::uri_escape($_) } @$domain );\r
+\r
+ push @opts, qq{domain="@uris"};\r
+ }\r
+\r
+ if ( $type eq 'Digest' ) {\r
+ my $package = __PACKAGE__ . '::Nonce';\r
+ my $nonce = $package->new;\r
+ $nonce->algorithm( $c->config->{authentication}{http}{algorithm}\r
+ || $nonce->algorithm );\r
+\r
+ push @opts, 'qop="' . $nonce->qop . '"';\r
+ push @opts, 'nonce="' . $nonce->nonce . '"';\r
+ push @opts, 'opaque="' . $nonce->opaque . '"';\r
+ push @opts, 'algorithm="' . $nonce->algorithm . '"';\r
+\r
+ $c->_check_cache;\r
+ $c->cache->set( __PACKAGE__ . '::opaque:' . $nonce->opaque, $nonce );\r
+ }\r
+\r
+ return "$type " . join( ', ', @opts );\r
+}\r
+\r
+package Catalyst::Plugin::Authentication::Credential::HTTP::Nonce;\r
+\r
+use strict;\r
+use base qw[ Class::Accessor::Fast ];\r
+use Data::UUID ();\r
+\r
+our $VERSION = "0.01";\r
+\r
+__PACKAGE__->mk_accessors(qw[ nonce nonce_count qop opaque algorithm ]);\r
+\r
+sub new {\r
+ my $class = shift;\r
+ my $self = $class->SUPER::new(@_);\r
+\r
+ $self->nonce( Data::UUID->new->create_b64 );\r
+ $self->opaque( Data::UUID->new->create_b64 );\r
+ $self->qop('auth,auth-int');\r
+ $self->nonce_count('0x0');\r
+ $self->algorithm('MD5');\r
+\r
+ return $self;\r
+}\r
+\r
+1;\r
+\r
+__END__\r
+\r
+=pod\r
+\r
+=head1 NAME\r
+\r
+Catalyst::Plugin::Authentication::Credential::HTTP - HTTP Basic authentication\r
+for Catlayst.\r
+\r
+=head1 SYNOPSIS\r
+\r
+ use Catalyst qw/\r
+ Authentication\r
+ Authentication::Store::Moose\r
+ Authentication::Credential::HTTP\r
+ /;\r
+\r
+ sub foo : Local {\r
+ my ( $self, $c ) = @_;\r
+\r
+ $c->authorization_required( realm => "foo" ); # named after the status code ;-)\r
+\r
+ # either user gets authenticated or 401 is sent\r
+\r
+ do_stuff();\r
+ }\r
+\r
+ # with ACL plugin\r
+ __PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate_http });\r
+\r
+ sub end : Private {\r
+ my ( $self, $c ) = @_;\r
+\r
+ $c->authorization_required_response( realm => "foo" );\r
+ $c->error(0);\r
+ }\r
+\r
+=head1 DESCRIPTION\r
+\r
+This moduule lets you use HTTP authentication with\r
+L<Catalyst::Plugin::Authentication>.\r
+\r
+Currently this module only supports the Basic scheme, but upon request Digest\r
+will also be added. Patches welcome!\r
+\r
+=head1 METHODS\r
+\r
+=over 4\r
+\r
+=item authorization_required\r
+\r
+Tries to C<authenticate_http>, and if that fails calls\r
+C<authorization_required_response> and detaches the current action call stack.\r
+\r
+=item authenticate_http\r
+\r
+Looks inside C<< $c->request->headers >> and processes the basic (badly named)\r
+authorization header.\r
+\r
+=item authorization_required_response\r
+\r
+Sets C<< $c->response >> to the correct status code, and adds the correct\r
+header to demand authentication data from the user agent.\r
+\r
+=back\r
+\r
+=head1 AUTHORS\r
+\r
+Yuval Kogman, C<nothingmuch@woobling.org>\r
+\r
+Jess Robinson\r
+\r
+=head1 COPYRIGHT & LICENSE\r
+\r
+ Copyright (c) 2005 the aforementioned authors. All rights\r
+ reserved. This program is free software; you can redistribute\r
+ it and/or modify it under the same terms as Perl itself.\r
+\r
+=cut\r
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+ eval { require Test::WWW::Mechanize::Catalyst }
+ or plan skip_all =>
+ "Test::WWW::Mechanize::Catalyst is needed for this test";
+ eval { require Catalyst::Plugin::Cache::FileCache }
+ or plan skip_all =>
+ "Catalyst::Plugin::Cache::FileCache is needed for this test";
+ plan tests => 4;
+}
+
+use HTTP::Request;
+
+{
+
+ package AuthTestApp;
+ use Catalyst qw/
+ Authentication
+ Authentication::Store::Minimal
+ Authentication::Credential::HTTP
+ Cache::FileCache
+ /;
+
+ use Test::More;
+
+ our $users;
+
+ sub moose : Local {
+ my ( $self, $c ) = @_;
+
+ $c->authorization_required( realm => 'testrealm@host.com' );
+
+ $c->res->body( $c->user->id );
+ }
+ __PACKAGE__->config->{authentication}{http}{type} = 'digest';
+ __PACKAGE__->config->{authentication}{users} = $users = {
+ Mufasa => { password => "Circle Of Life", },
+ };
+
+ __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 {\r
+ my @key_val = split /=/, $_, 2;\r
+ $key_val[0] = lc $key_val[0];\r
+ $key_val[1] =~ s{"}{}g; # remove the quotes\r
+ @key_val;\r
+} split /, /, substr( $www_auth, 7 ); #7 == length "Digest "
+
+$mech->content_lacks( "foo", "no output" );
+
+my $response = '';
+{
+ my $username = 'Mufasa';\r
+ my $password = 'Circle Of Life';\r
+ my $realm = $www_auth_params{realm};\r
+ my $nonce = $www_auth_params{nonce};\r
+ my $cnonce = '0a4f113b';\r
+ my $opaque = $www_auth_params{opaque};\r
+ my $nc = '00000001';\r
+ my $method = 'GET';\r
+ my $qop = 'auth';\r
+ my $uri = '/moose';
+
+ my $ctx = Digest::MD5->new;\r
+ $ctx->add( join( ':', $username, $realm, $password ) );\r
+ my $A1_digest = $ctx->hexdigest;
+
+ $ctx = Digest::MD5->new;\r
+ $ctx->add( join( ':', $method, $uri ) );\r
+ my $A2_digest = $ctx->hexdigest;
+
+ my $digest = Digest::MD5::md5_hex(\r
+ join( ':',\r
+ $A1_digest, $nonce, $qop ? ( $nc, $cnonce, $qop ) : (), $A2_digest )\r
+ );\r
+
+ $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( "Mufasa", "Mufasa output" );
+
projects / catagits/Catalyst-Authentication-Credential-HTTP.git / commitdiff