-#!/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
+package Catalyst::Plugin::Authentication::Credential::HTTP;
+use base qw/Catalyst::Authentication::Credential::HTTP/;
+
+our $VERSION = '0.11';
+
+# FIXME - Add a warning here?
+# FIXME - Is this package even needed?
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::Plugin::Authentication::Credential::HTTP - HTTP Basic and Digest authentication
+for Catalyst.
+
+=head1 SYNOPSIS
+
+ use Catalyst qw/
+ Authentication
+ Authentication::Store::Minimal
+ Authentication::Credential::HTTP
+ /;
+
+=head1 DESCRIPTION
+
+This module is deprecated. Please see L<Catalyst::Authentication::Credential::HTTP>
+
+=head1 AUTHORS
+
+Yuval Kogman, C<nothingmuch@woobling.org>
+
+Jess Robinson
+
+Sascha Kiefer C<esskar@cpan.org>
+
+Tomas Doran C<bobtfish@bobtfish.net>
+
+=head1 SEE ALSO
+
+L<Catalyst::Authentication::Credential::HTTP>.
+
+=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