From: Yuval Kogman Date: Fri, 8 Sep 2006 08:31:16 +0000 (+0000) Subject: Refactor HTTP cred, part I X-Git-Tag: v0.11~13 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Authentication-Credential-HTTP.git;a=commitdiff_plain;h=ac92fd52e650f58ec34dfb078551854880b73d2e Refactor HTTP cred, part I --- diff --git a/Build.PL b/Build.PL index 18d2522..84d6cd1 100644 --- a/Build.PL +++ b/Build.PL @@ -1,6 +1,5 @@ use strict; use Module::Build; - my $build = Module::Build->new( create_makefile_pl => 'traditional', license => 'perl', @@ -19,4 +18,3 @@ my $build = Module::Build->new( sign => 0, ); $build->create_build_script; - diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP index 20d203b..ccca4a7 100644 --- a/MANIFEST.SKIP +++ b/MANIFEST.SKIP @@ -3,7 +3,6 @@ \bCVS\b ,v$ \B\.svn\b - # Avoid Makemaker generated and utility files. \bMakefile$ \bblib @@ -11,11 +10,9 @@ \bpm_to_blib$ \bblibdirs$ ^MANIFEST\.SKIP$ - # Avoid Module::Build generated and utility files. \bBuild$ \b_build - # Avoid temp and backup files. ~$ \.tmp$ diff --git a/lib/Catalyst/Plugin/Authentication/Credential/HTTP.pm b/lib/Catalyst/Plugin/Authentication/Credential/HTTP.pm index a114b06..b14e575 100644 --- a/lib/Catalyst/Plugin/Authentication/Credential/HTTP.pm +++ b/lib/Catalyst/Plugin/Authentication/Credential/HTTP.pm @@ -1,683 +1,441 @@ #!/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 (); - use Digest::MD5 (); - - our $VERSION = "0.05"; - - sub authenticate_http { + my ( $c, @args ) = @_; - my $c = shift; - - - - return $c->authenticate_digest || $c->authenticate_basic; - + 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 ) = @_; + $opts{store} || $c->config->{authentication}{http}{store}; +} sub authenticate_basic { - - my $c = shift; - - + 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; - if ( my ( $user, $password ) = $headers->authorization_basic ) { - - - - if ( my $store = $c->config->{authentication}{http}{store} ) { - - $user = $store->get_user($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 = shift; - - + 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}; - - - $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 ); - + 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; - - my $store = $c->config->{authentication}{http}{store} - + my $store = $opts{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 { - +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 ) = @_; - my ( $c, %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); - - + 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); + # *DONT* short circuit + my $ok; + $ok++ if $c->_create_digest_auth_response(\%opts); + $ok++ if $c->_create_basic_auth_response(\%opts); - - 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; - + 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; + } -sub build_authorization_required_response { + return; +} - my ( $c, $opts, $type ) = @_; +sub _create_basic_auth_response { + my ( $c, $opts ) = @_; + + return unless $c->_is_http_auth_type('basic'); - my @opts; + 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} ) { - - push @opts, 'realm=' . String::Escape::qprintable($realm); - + return 'realm=' . String::Escape::qprintable($realm); + } else { + return; } +} - +sub _build_auth_header_domain { + my ( $c, $opts ) = @_; 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"}; - + 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), + ); +} - if ( $type eq 'Digest' ) { - - my $package = __PACKAGE__ . '::Nonce'; - - my $nonce = $package->new; - - $nonce->algorithm( $c->config->{authentication}{http}{algorithm} - - || $nonce->algorithm ); - - +sub _build_basic_auth_header { + my ( $c, $opts ) = @_; + return $c->_join_auth_header_parts( Basic => $c->_build_auth_header_common ); +} - push @opts, 'qop="' . $nonce->qop . '"'; +sub _build_digest_auth_header { + my ( $c, $opts ) = @_; - push @opts, 'nonce="' . $nonce->nonce . '"'; + my $nonce = $c->_digest_auth_nonce($opts); - push @opts, 'opaque="' . $nonce->opaque . '"'; + my $key = __PACKAGE__ . '::opaque:' . $nonce->opaque; + + $c->_store_digest_authorization_nonce( $key, $nonce ); - push @opts, 'algorithm="' . $nonce->algorithm . '"'; + 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'; - $c->_check_cache; + my $nonce = $package->new; - $c->cache->set( __PACKAGE__ . '::opaque:' . $nonce->opaque, $nonce ); + my $algorithm = $opts->{algorithm} + || $c->config->{authentication}{http}{algorithm} + || $nonce->algorithm; - } + $nonce->algorithm( $algorithm ); + return $nonce; +} +sub _join_auth_header_parts { + my ( $c, $type, @parts ) = @_; + return "$type " . join(", ", @parts ); +} - return "$type " . join( ', ', @opts ); +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__ - - =pod - - =head1 NAME - - Catalyst::Plugin::Authentication::Credential::HTTP - HTTP Basic and Digest authentication - for Catlayst. - - =head1 SYNOPSIS - - use Catalyst qw/ - Authentication - Authentication::Store::Moose - 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 moduule lets you use HTTP authentication with - L. Both basic and digest authentication - are currently supported. - - =head1 METHODS - - =over 4 - - =item authorization_required - - Tries to C, and if that fails calls - C and detaches the current action call stack. - - =item authenticate_http - - 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 - - =head1 AUTHORS - - Yuval Kogman, C - - Jess Robinson - - Sascha Kiefer C - - =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 - diff --git a/t/basic.t b/t/basic.t index 2ba6ff8..7bee485 100644 --- a/t/basic.t +++ b/t/basic.t @@ -1,66 +1,47 @@ #!/usr/bin/perl - use strict; use warnings; - use Test::More tests => 12; 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" ); can_ok( $m, "authorization_required_response" ); - my $req = Test::MockObject->new; my $req_headers = HTTP::Headers->new; - $req->set_always( headers => $req_headers ); - my $res = Test::MockObject->new; - my $status; $res->mock(status => sub { $status = $_[1] }); - my $res_headers = HTTP::Headers->new; $res->set_always( headers => $res_headers ); - my $c = Test::MockObject::Extends->new( $m ); - my $cache = Test::MockObject->new; $cache->mock(set => sub { shift->{$_[0]} = $_[1] }); $cache->mock(get => sub { return shift->{$_[0]} }); $c->mock(cache => sub { $cache }); - my @login_info; $c->mock( login => sub { shift; @login_info = @_; 1 } ); $c->set_always( config => {} ); $c->set_always( req => $req ); $c->set_always( res => $res ); - ok( !$c->authenticate_http, "http auth fails without header"); - $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"; - $req_headers->clear; $c->clear; - throws_ok { $c->authorization_required; } qr/^ $Catalyst::DETACH $/x, "detached on no authorization required with bad auth"; - is( $status, 401, "401 status code" ); like( ($res_headers->header('WWW-Authenticate'))[0], qr/^Digest/, "WWW-Authenticate header set: digest"); like( ($res_headers->header('WWW-Authenticate'))[1], qr/^Basic/, "WWW-Authenticate header set: basic"); diff --git a/t/live_app.t b/t/live_app.t index 519bf0c..31ea9b7 100644 --- a/t/live_app.t +++ b/t/live_app.t @@ -1,60 +1,41 @@ #!/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"; plan tests => 4; } - use HTTP::Request; - { - package AuthTestApp; use Catalyst qw/ Authentication Authentication::Store::Minimal Authentication::Credential::HTTP /; - use Test::More; - our $users; - sub moose : Local { my ( $self, $c ) = @_; - $c->authorization_required; - $c->res->body( $c->user->id ); } __PACKAGE__->config->{authentication}{http}{type} = 'basic'; __PACKAGE__->config->{authentication}{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" ); - $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" ); - diff --git a/t/live_app_digest.t b/t/live_app_digest.t index c6ac1c7..c50bac2 100644 --- a/t/live_app_digest.t +++ b/t/live_app_digest.t @@ -1,10 +1,7 @@ #!/usr/bin/perl - use strict; use warnings; - use Test::More; - BEGIN { eval { require Test::WWW::Mechanize::Catalyst } or plan skip_all => @@ -14,11 +11,8 @@ BEGIN { "Catalyst::Plugin::Cache::FileCache is needed for this test"; plan tests => 4; } - use HTTP::Request; - { - package AuthTestApp; use Catalyst qw/ Authentication @@ -26,100 +20,59 @@ use HTTP::Request; 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 { - 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"}; } - 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" ); -