From: Yuval Kogman Date: Fri, 8 Sep 2006 08:31:04 +0000 (+0000) Subject: dos newlines to unix ones, so native can kick in X-Git-Tag: v0.11~14 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Authentication-Credential-HTTP.git;a=commitdiff_plain;h=a14203f823c2d4c90975bc55cb90b203d9577934 dos newlines to unix ones, so native can kick in --- diff --git a/lib/Catalyst/Plugin/Authentication/Credential/HTTP.pm b/lib/Catalyst/Plugin/Authentication/Credential/HTTP.pm index 1e50568..a114b06 100644 --- a/lib/Catalyst/Plugin/Authentication/Credential/HTTP.pm +++ b/lib/Catalyst/Plugin/Authentication/Credential/HTTP.pm @@ -1,343 +1,683 @@ -#!/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 = 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->_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, 'realm=' . 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"}; - } - - 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 ); - } - - return "$type " . join( ', ', @opts ); -} - -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 - /; - +#!/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 = 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->_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, 'realm=' . 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"}; + + } + + + + 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 ); + + } + + + + return "$type " . join( ', ', @opts ); + +} + + + +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 + }; + + + + 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/live_app_digest.t b/t/live_app_digest.t index e0e2ad4..c6ac1c7 100644 --- a/t/live_app_digest.t +++ b/t/live_app_digest.t @@ -54,40 +54,62 @@ $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; +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 $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 $ctx = Digest::MD5->new; + + $ctx->add( join( ':', $username, $realm, $password ) ); + my $A1_digest = $ctx->hexdigest; - $ctx = Digest::MD5->new; - $ctx->add( join( ':', $method, $uri ) ); + $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 ) - ); + 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"}; }