[catagits/Catalyst-Authentication-Credential-HTTP.git] / lib / Catalyst / Plugin / Authentication / Credential / HTTP.pm

#!/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.10";

sub authenticate_http {
    my ( $c, @args ) = @_;

    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 ) = @_;

    my $store = $opts{store} || $c->config->{authentication}{http}{store} || return;

    return ref $store
        ? $store
        : $c->get_auth_store($store);
}

sub authenticate_basic {
    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;

        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, %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};

        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->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;

        unless ( $user = $opts{user} ) {
            if ( my $store = $c->get_http_auth_store(%opts) || $c->default_auth_store ) {
                $user = $store->get_user($username);
            }
        }

        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_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 ) = @_;

    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);
    $c->res->content_type('text/plain');
    $c->res->body($c->config->{authentication}{http}{authorization_required_message} || 
                  $opts{authorization_required_message} || 
                  'Authorization required.');

    # *DONT* short circuit
    my $ok;
    $ok++ if $c->_create_digest_auth_response(\%opts);
    $ok++ if $c->_create_basic_auth_response(\%opts);

    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;
    }

    return;
}

sub _create_basic_auth_response {
    my ( $c, $opts ) = @_;
    
    return unless $c->_is_http_auth_type('basic');

    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} ) {
        return 'realm=' . String::Escape::qprintable($realm);
    } else {
        return;
    }
}

sub _build_auth_header_domain {
    my ( $c, $opts ) = @_;

    if ( my $domain = $opts->{domain} ) {
        Catalyst::Exception->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 );

        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),
    );
}

sub _build_basic_auth_header {
    my ( $c, $opts ) = @_;
    return $c->_join_auth_header_parts( Basic => $c->_build_auth_header_common( $opts ) );
}

sub _build_digest_auth_header {
    my ( $c, $opts ) = @_;

    my $nonce = $c->_digest_auth_nonce($opts);

    my $key = __PACKAGE__ . '::opaque:' . $nonce->opaque;
   
    $c->store_digest_authorization_nonce( $key, $nonce );

    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';

    my $nonce   = $package->new;

    if ( my $algorithm = $opts->{algorithm} || $c->config->{authentication}{http}{algorithm}) { 
        $nonce->algorithm( $algorithm );
    }

    return $nonce;
}

sub _join_auth_header_parts {
    my ( $c, $type, @parts ) = @_;
    return "$type " . join(", ", @parts );
}

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 Catalyst.

=head1 SYNOPSIS

    use Catalyst qw/
        Authentication
        Authentication::Store::Minimal
        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<Catalyst::Plugin::Authentication>. Both basic and digest authentication
are currently supported.

When authentication is required, this module sets a status of 401, and
the body of the response to 'Authorization required.'. To override
this and set your own content, check for the C<< $c->res->status ==
401 >> in your C<end> action, and change the body accordingly.

=head2 TERMS

=over 4

=item Nonce

A nonce is a one-time value sent with each digest authentication
request header. The value must always be unique, so per default the
last value of the nonce is kept using L<Catalyst::Plugin::Cache>. To
change this behaviour, override the
C<store_digest_authorization_nonce> and
C<get_digest_authorization_nonce> methods as shown below.

=back

=head1 METHODS

=over 4

=item authorization_required %opts

Tries to C<authenticate_http>, and if that fails calls
C<authorization_required_response> and detaches the current action call stack.

This method just passes the options through untouched.

=item authenticate_http %opts

Looks inside C<< $c->request->headers >> and processes the digest and basic
(badly named) authorization header.

This will only try the methods set in the configuration. First digest, then basic.

See the next two methods for what %opts can contain.

=item authenticate_basic %opts

=item authenticate_digest %opts

Try to authenticate one of the methods without checking if the method is
allowed in the configuration.

%opts can contain C<store> (either an object or a name), C<user> (to disregard
%the username from the header altogether, overriding it with a username or user
%object).

=item authorization_required_response %opts

Sets C<< $c->response >> to the correct status code, and adds the correct
header to demand authentication data from the user agent.

Typically used by C<authorization_required>, but may be invoked manually.

%opts can contain C<realm>, C<domain> and C<algorithm>, which are used to build
%the digest header.

=item store_digest_authorization_nonce $key, $nonce

=item get_digest_authorization_nonce $key

Set or get the C<$nonce> object used by the digest auth mode.

You may override these methods. By default they will call C<get> and C<set> on
C<< $c->cache >>.

=item get_http_auth_store %opts

=back

=head1 CONFIGURATION

All configuration is stored in C<< YourApp->config->{authentication}{http} >>.

This should be a hash, and it can contain the following entries:

=over 4

=item store

Either a name or an object -- the default store to use for HTTP authentication.

=item type

Can be either C<any> (the default), C<basic> or C<digest>.

This controls C<authorization_required_response> and C<authenticate_http>, but
not the "manual" methods.

=item authorization_required_message

Set this to a string to override the default body content "Authorization required."

=back

=head1 RESTRICTIONS

When using digest authentication, this module will only work together
with authentication stores whose User objects have a C<password>
method that returns the plain-text password. It will not work together
with L<Catalyst::Authentication::Store::Htpasswd>, or
L<Catalyst::Plugin::Authentication::Store::DBIC> stores whose
C<password> methods return a hashed or salted version of the password.

=head1 AUTHORS

Yuval Kogman, C<nothingmuch@woobling.org>

Jess Robinson

Sascha Kiefer C<esskar@cpan.org>

=head1 SEE ALSO

RFC 2617 (or its successors), L<Catalyst::Plugin::Cache>, L<Catalyst::Plugin::Authentication>

=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
Commit	Line	Data
d99b7693	1	#!/usr/bin/perl
d99b7693	2
a14203f8	3	package Catalyst::Plugin::Authentication::Credential::HTTP;
d99b7693	4	use base qw/Catalyst::Plugin::Authentication::Credential::Password/;
	5
	6	use strict;
	7	use warnings;
	8
	9	use String::Escape ();
	10	use URI::Escape ();
	11	use Catalyst ();
	12	use Digest::MD5 ();
	13
	14	our $VERSION = "0.10";
	15
	16	sub authenticate_http {
	17	my ( $c, @args ) = @_;
	18
	19	return 1 if $c->_is_http_auth_type('digest') && $c->authenticate_digest(@args);
	20	return 1 if $c->_is_http_auth_type('basic') && $c->authenticate_basic(@args);
	21	}
	22
	23	sub get_http_auth_store {
	24	my ( $c, %opts ) = @_;
	25
	26	my $store = $opts{store} \|\| $c->config->{authentication}{http}{store} \|\| return;
	27
	28	return ref $store
	29	? $store
	30	: $c->get_auth_store($store);
	31	}
	32
	33	sub authenticate_basic {
	34	my ( $c, %opts ) = @_;
	35
	36	$c->log->debug('Checking http basic authentication.') if $c->debug;
	37
	38	my $headers = $c->req->headers;
	39
	40	if ( my ( $username, $password ) = $headers->authorization_basic ) {
	41
	42	my $user;
	43
	44	unless ( $user = $opts{user} ) {
	45	if ( my $store = $c->get_http_auth_store(%opts) ) {
	46	$user = $store->get_user($username);
	47	} else {
	48	$user = $username;
	49	}
	50	}
	51
	52	return $c->login( $user, $password );
	53	}
	54
	55	return 0;
	56	}
	57
	58	sub authenticate_digest {
	59	my ( $c, %opts ) = @_;
	60
	61	$c->log->debug('Checking http digest authentication.') if $c->debug;
	62
	63	my $headers = $c->req->headers;
	64	my @authorization = $headers->header('Authorization');
	65	foreach my $authorization (@authorization) {
	66	next unless $authorization =~ m{^Digest};
	67
68	my %res = map {
69	my @key_val = split /=/, $_, 2;
70	$key_val[0] = lc $key_val[0];
71	$key_val[1] =~ s{"}{}g; # remove the quotes
72	@key_val;
73	} split /,\s?/, substr( $authorization, 7 ); #7 == length "Digest "
74
75	my $opaque = $res{opaque};
76	my $nonce = $c->get_digest_authorization_nonce( __PACKAGE__ . '::opaque:' . $opaque );
77	next unless $nonce;
78
79	$c->log->debug('Checking authentication parameters.')
80	if $c->debug;
81
82	my $uri = '/' . $c->request->path;
83	my $algorithm = $res{algorithm} \|\| 'MD5';
84	my $nonce_count = '0x' . $res{nc};
85
86	my $check = $uri eq $res{uri}
87	&& ( exists $res{username} )
88	&& ( exists $res{qop} )
89	&& ( exists $res{cnonce} )
90	&& ( exists $res{nc} )
91	&& $algorithm eq $nonce->algorithm
92	&& hex($nonce_count) > hex( $nonce->nonce_count )
93	&& $res{nonce} eq $nonce->nonce; # TODO: set Stale instead
94
95	unless ($check) {
96	$c->log->debug('Digest authentication failed. Bad request.')
97	if $c->debug;
98	$c->res->status(400); # bad request
99	die $Catalyst::DETACH;
100	}
101
102	$c->log->debug('Checking authentication response.')
103	if $c->debug;
104
105	my $username = $res{username};
106	my $realm = $res{realm};
107
108	my $user;
109
110	unless ( $user = $opts{user} ) {
111	if ( my $store = $c->get_http_auth_store(%opts) \|\| $c->default_auth_store ) {
112	$user = $store->get_user($username);
113	}
114	}
115
116	unless ($user) { # no user, no authentication
117	$c->log->debug('Unknown user: $user.') if $c->debug;
118	return 0;
119	}
120
121	# everything looks good, let's check the response
122
123	# calculate H(A2) as per spec
124	my $ctx = Digest::MD5->new;
125	$ctx->add( join( ':', $c->request->method, $res{uri} ) );
126	if ( $res{qop} eq 'auth-int' ) {
127	my $digest =
128	Digest::MD5::md5_hex( $c->request->body ); # not sure here
129	$ctx->add( ':', $digest );
130	}
131	my $A2_digest = $ctx->hexdigest;
132
133	# the idea of the for loop:
134	# if we do not want to store the plain password in our user store,
135	# we can store md5_hex("$username:$realm:$password") instead
136	for my $r ( 0 .. 1 ) {
137
138	# calculate H(A1) as per spec
139	my $A1_digest = $r ? $user->password : do {
140	$ctx = Digest::MD5->new;
141	$ctx->add( join( ':', $username, $realm, $user->password ) );
142	$ctx->hexdigest;
143	};
144	if ( $nonce->algorithm eq 'MD5-sess' ) {
145	$ctx = Digest::MD5->new;
146	$ctx->add( join( ':', $A1_digest, $res{nonce}, $res{cnonce} ) );
147	$A1_digest = $ctx->hexdigest;
148	}
149
150	my $rq_digest = Digest::MD5::md5_hex(
151	join( ':',
152	$A1_digest, $res{nonce},
153	$res{qop} ? ( $res{nc}, $res{cnonce}, $res{qop} ) : (),
154	$A2_digest )
155	);
156
157	$nonce->nonce_count($nonce_count);
158	$c->cache->set( __PACKAGE__ . '::opaque:' . $nonce->opaque,
159	$nonce );
160
161	return $c->login( $user, $user->password )
162	if $rq_digest eq $res{response};
163	}
164	}
165
166	return 0;
167	}
168
169	sub _check_cache {
170	my $c = shift;
171
172	die "A cache is needed for http digest authentication."
173	unless $c->can('cache');
174	}
175
176	sub _is_http_auth_type {
177	my ( $c, $type ) = @_;
178
179	my $cfgtype = lc( $c->config->{authentication}{http}{type} \|\| 'any' );
180	return 1 if $cfgtype eq 'any' \|\| $cfgtype eq lc $type;
181	return 0;
182	}
183
184	sub authorization_required {
185	my ( $c, @args ) = @_;
186
187	return 1 if $c->authenticate_http(@args);
188
189	$c->authorization_required_response(@args);
190
191	die $Catalyst::DETACH;
192	}
193
194	sub authorization_required_response {
195	my ( $c, %opts ) = @_;
196
197	$c->res->status(401);
198	$c->res->content_type('text/plain');
199	$c->res->body($c->config->{authentication}{http}{authorization_required_message} \|\|
200	$opts{authorization_required_message} \|\|
201	'Authorization required.');
202
203	# DONT short circuit
204	my $ok;
205	$ok++ if $c->_create_digest_auth_response(\%opts);
206	$ok++ if $c->_create_basic_auth_response(\%opts);
207
208	unless ( $ok ) {
209	die 'Could not build authorization required response. '
210	. 'Did you configure a valid authentication http type: '
211	. 'basic, digest, any';
212	}
213	}
214
215	sub _add_authentication_header {
216	my ( $c, $header ) = @_;
217	$c->res->headers->push_header( 'WWW-Authenticate' => $header );
218	}
219
220	sub _create_digest_auth_response {
221	my ( $c, $opts ) = @_;
222
223	return unless $c->_is_http_auth_type('digest');
224
225	if ( my $digest = $c->_build_digest_auth_header( $opts ) ) {
226	$c->_add_authentication_header( $digest );
227	return 1;
228	}
229
230	return;
231	}
232
233	sub _create_basic_auth_response {
234	my ( $c, $opts ) = @_;
235
236	return unless $c->_is_http_auth_type('basic');
237
238	if ( my $basic = $c->_build_basic_auth_header( $opts ) ) {
239	$c->_add_authentication_header( $basic );
240	return 1;
241	}
242
243	return;
244	}
245
246	sub _build_auth_header_realm {
247	my ( $c, $opts ) = @_;
248
249	if ( my $realm = $opts->{realm} ) {
250	return 'realm=' . String::Escape::qprintable($realm);
251	} else {
252	return;
253	}
254	}
255
256	sub _build_auth_header_domain {
257	my ( $c, $opts ) = @_;
258
259	if ( my $domain = $opts->{domain} ) {
260	Catalyst::Exception->throw("domain must be an array reference")
261	unless ref($domain) && ref($domain) eq "ARRAY";
262
263	my @uris =
264	$c->config->{authentication}{http}{use_uri_for}
265	? ( map { $c->uri_for($_) } @$domain )
266	: ( map { URI::Escape::uri_escape($_) } @$domain );
267
268	return qq{domain="@uris"};
269	} else {
270	return;
271	}
272	}
273
274	sub _build_auth_header_common {
275	my ( $c, $opts ) = @_;
276
277	return (
278	$c->_build_auth_header_realm($opts),
279	$c->_build_auth_header_domain($opts),
280	);
281	}
282
283	sub _build_basic_auth_header {
284	my ( $c, $opts ) = @_;
285	return $c->_join_auth_header_parts( Basic => $c->_build_auth_header_common( $opts ) );
286	}
287
288	sub _build_digest_auth_header {
289	my ( $c, $opts ) = @_;
290
291	my $nonce = $c->_digest_auth_nonce($opts);
292
293	my $key = __PACKAGE__ . '::opaque:' . $nonce->opaque;
294
295	$c->store_digest_authorization_nonce( $key, $nonce );
a14203f8	296
d99b7693	297	return $c->_join_auth_header_parts( Digest =>
	298	$c->_build_auth_header_common($opts),
	299	map { sprintf '%s="%s"', $_, $nonce->$_ } qw(
	300	qop
	301	nonce
	302	opaque
	303	algorithm
	304	),
	305	);
	306	}
a14203f8	307
d99b7693	308	sub _digest_auth_nonce {
	309	my ( $c, $opts ) = @_;
	310
	311	my $package = __PACKAGE__ . '::Nonce';
	312
	313	my $nonce = $package->new;
	314
	315	if ( my $algorithm = $opts->{algorithm} \|\| $c->config->{authentication}{http}{algorithm}) {
	316	$nonce->algorithm( $algorithm );
	317	}
	318
	319	return $nonce;
	320	}
	321
	322	sub _join_auth_header_parts {
	323	my ( $c, $type, @parts ) = @_;
	324	return "$type " . join(", ", @parts );
	325	}
	326
	327	sub get_digest_authorization_nonce {
	328	my ( $c, $key ) = @_;
	329
	330	$c->_check_cache;
	331	$c->cache->get( $key );
	332	}
	333
	334	sub store_digest_authorization_nonce {
	335	my ( $c, $key, $nonce ) = @_;
	336
	337	$c->_check_cache;
	338	$c->cache->set( $key, $nonce );
	339	}
	340
	341	package Catalyst::Plugin::Authentication::Credential::HTTP::Nonce;
	342
	343	use strict;
	344	use base qw[ Class::Accessor::Fast ];
	345	use Data::UUID ();
	346
	347	our $VERSION = "0.01";
	348
	349	__PACKAGE__->mk_accessors(qw[ nonce nonce_count qop opaque algorithm ]);
	350
	351	sub new {
	352	my $class = shift;
	353	my $self = $class->SUPER::new(@_);
	354
	355	$self->nonce( Data::UUID->new->create_b64 );
	356	$self->opaque( Data::UUID->new->create_b64 );
	357	$self->qop('auth,auth-int');
	358	$self->nonce_count('0x0');
	359	$self->algorithm('MD5');
	360
	361	return $self;
	362	}
a14203f8	363
a14203f8	364	1;
a14203f8	365
a14203f8	366	__END__
a14203f8	367
a14203f8	368	=pod
a14203f8	369
a14203f8	370	=head1 NAME
a14203f8	371
a14203f8	372	Catalyst::Plugin::Authentication::Credential::HTTP - HTTP Basic and Digest authentication
53306b93	373	for Catalyst.
a14203f8	374
a14203f8	375	=head1 SYNOPSIS
a14203f8	376
a14203f8	377	use Catalyst qw/
a14203f8	378	Authentication
c7b3e379	379	Authentication::Store::Minimal
a14203f8	380	Authentication::Credential::HTTP
a14203f8	381	/;
a14203f8	382
d99b7693	383	__PACKAGE__->config->{authentication}{http}{type} = 'any'; # or 'digest' or 'basic'
	384	__PACKAGE__->config->{authentication}{users} = {
	385	Mufasa => { password => "Circle Of Life", },
	386	};
	387
	388	sub foo : Local {
	389	my ( $self, $c ) = @_;
	390
	391	$c->authorization_required( realm => "foo" ); # named after the status code ;-)
	392
	393	# either user gets authenticated or 401 is sent
	394
	395	do_stuff();
	396	}
	397
	398	# with ACL plugin
	399	__PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate_http });
	400
	401	sub end : Private {
	402	my ( $self, $c ) = @_;
	403
	404	$c->authorization_required_response( realm => "foo" );
	405	$c->error(0);
	406	}
	407
a14203f8	408	=head1 DESCRIPTION
a14203f8	409
d99b7693	410	This moduule lets you use HTTP authentication with
	411	L<Catalyst::Plugin::Authentication>. Both basic and digest authentication
	412	are currently supported.
	413
	414	When authentication is required, this module sets a status of 401, and
	415	the body of the response to 'Authorization required.'. To override
	416	this and set your own content, check for the C<< $c->res->status ==
	417	401 >> in your C<end> action, and change the body accordingly.
	418
	419	=head2 TERMS
	420
	421	=over 4
	422
	423	=item Nonce
	424
	425	A nonce is a one-time value sent with each digest authentication
	426	request header. The value must always be unique, so per default the
	427	last value of the nonce is kept using L<Catalyst::Plugin::Cache>. To
	428	change this behaviour, override the
	429	C<store_digest_authorization_nonce> and
	430	C<get_digest_authorization_nonce> methods as shown below.
	431
	432	=back
	433
	434	=head1 METHODS
	435
	436	=over 4
	437
	438	=item authorization_required %opts
	439
	440	Tries to C<authenticate_http>, and if that fails calls
	441	C<authorization_required_response> and detaches the current action call stack.
	442
	443	This method just passes the options through untouched.
	444
	445	=item authenticate_http %opts
	446
	447	Looks inside C<< $c->request->headers >> and processes the digest and basic
	448	(badly named) authorization header.
	449
	450	This will only try the methods set in the configuration. First digest, then basic.
	451
	452	See the next two methods for what %opts can contain.
	453
	454	=item authenticate_basic %opts
	455
	456	=item authenticate_digest %opts
	457
	458	Try to authenticate one of the methods without checking if the method is
	459	allowed in the configuration.
	460
	461	%opts can contain C<store> (either an object or a name), C<user> (to disregard
	462	%the username from the header altogether, overriding it with a username or user
	463	%object).
	464
	465	=item authorization_required_response %opts
	466
	467	Sets C<< $c->response >> to the correct status code, and adds the correct
	468	header to demand authentication data from the user agent.
	469
	470	Typically used by C<authorization_required>, but may be invoked manually.
	471
	472	%opts can contain C<realm>, C<domain> and C<algorithm>, which are used to build
	473	%the digest header.
474
475	=item store_digest_authorization_nonce $key, $nonce
476
477	=item get_digest_authorization_nonce $key
478
479	Set or get the C<$nonce> object used by the digest auth mode.
480
481	You may override these methods. By default they will call C<get> and C<set> on
482	C<< $c->cache >>.
483
484	=item get_http_auth_store %opts
485
486	=back
487
488	=head1 CONFIGURATION
489
490	All configuration is stored in C<< YourApp->config->{authentication}{http} >>.
491
492	This should be a hash, and it can contain the following entries:
493
494	=over 4
495
496	=item store
497
498	Either a name or an object -- the default store to use for HTTP authentication.
499
500	=item type
501
502	Can be either C<any> (the default), C<basic> or C<digest>.
503
504	This controls C<authorization_required_response> and C<authenticate_http>, but
505	not the "manual" methods.
506
507	=item authorization_required_message
508
509	Set this to a string to override the default body content "Authorization required."
510
511	=back
512
513	=head1 RESTRICTIONS
514
515	When using digest authentication, this module will only work together
516	with authentication stores whose User objects have a C<password>
517	method that returns the plain-text password. It will not work together
518	with L<Catalyst::Authentication::Store::Htpasswd>, or
519	L<Catalyst::Plugin::Authentication::Store::DBIC> stores whose
520	C<password> methods return a hashed or salted version of the password.
c7b3e379	521
a14203f8	522	=head1 AUTHORS
a14203f8	523
a14203f8	524	Yuval Kogman, C<nothingmuch@woobling.org>
a14203f8	525
a14203f8	526	Jess Robinson
a14203f8	527
a14203f8	528	Sascha Kiefer C<esskar@cpan.org>
a14203f8	529
c7b3e379	530	=head1 SEE ALSO
c7b3e379	531
d99b7693	532	RFC 2617 (or its successors), L<Catalyst::Plugin::Cache>, L<Catalyst::Plugin::Authentication>
c7b3e379	533
a14203f8	534	=head1 COPYRIGHT & LICENSE
a14203f8	535
a14203f8	536	Copyright (c) 2005-2006 the aforementioned authors. All rights
a14203f8	537	reserved. This program is free software; you can redistribute
a14203f8	538	it and/or modify it under the same terms as Perl itself.
a14203f8	539
a14203f8	540	=cut