# $Id: /mirror/gungho/lib/Gungho/Component/Authentication.pm 1657 2007-04-10T02:26:11.598323Z lestrrat $
#
# Copyright (c) 2007 Daisuke Maki <daisuke@endeworks.jp>
# all rights reserved.
package Gungho::Component::Authentication;
use strict;
use warnings;
use base qw(Gungho::Component);
use Carp qw(croak);
use HTTP::Status();
use HTTP::Headers::Util();
sub authenticate
{
croak ref($_[0]) . "::authenticate() unimplemented";
}
sub check_authentication_challenge
{
my ($c, $req, $res) = @_;
my $handled = 0;
# Check if there was a Auth challenge. If yes and Gungho is configured
# to support authentication, then do the auth magic
my $code = $res->code;
if ( $code == &HTTP::Status::RC_UNAUTHORIZED ||
$code == &HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED )
{
my $proxy = ($code == &HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED);
my $ch_header = $proxy ? "Proxy-Authenticate" : "WWW-Authenticate";
my @challenge = $res->header($ch_header);
if (! @challenge) {
$c->log->debug("Response from " . $req->uri . " returned with code = $code, but is missing Authenticate header");
$res->header("Client-Warning" => "Missing Authenticate header");
goto DONE;
}
CHALLENGE:
for my $challenge (@challenge) {
$challenge =~ tr/,/;/; # "," is used to separate auth-params!!
($challenge) = HTTP::Headers::Util::split_header_words($challenge);
my $scheme = lc(shift(@$challenge));
shift(@$challenge); # no value
$challenge = { @$challenge }; # make rest into a hash
for (keys %$challenge) { # make sure all keys are lower case
$challenge->{lc $_} = delete $challenge->{$_};
}
unless ($scheme =~ /^([a-z]+(?:-[a-z]+)*)$/) {
$c->log->debug("Response from " . $req->uri . " returned with code = $code, bad authentication scheme '$scheme'");
$res->header("Client-Warning" => "Bad authentication scheme '$scheme'");
goto DONE;
}
$scheme = ucfirst $1; # untainted now
if (! $c->has_feature("Authentication::$scheme")) {
$c->log->debug("Response from " . $req->uri . " returned with code = $code, but authentication scheme '$scheme' is unsupported");
goto DONE;
}
# now attempt to authenticate
return $c->authenticate($proxy, $challenge, $req, $res);
}
}
DONE:
return $handled;
}
1;
__END__
=head1 NAME
Gungho::Component::Authentication - Base Class For WWW Authentication
=head1 SYNOPSIS
package MyAuth;
use base qw(Gungho::Component::Authentication);
=head1 DESCRIPTION
Gungho::Component::Authentication provides the base mechanism to detect
and authenticate WWW Authentication responses.
Subclasses must override the authenticate() method.
=head1 METHODS
=head2 authenticate($is_proxy, $auth_params, $request, $response)
Should authenticate the request, and do any re-dispatching if need be.
Should return 1 if the request has been redispatched.
=head2 check_authentication_challenge($c, $req, $res)
Checks the given request/response for a WWW Authentication challenge, and
re-dispatches the request if need be.
Returns 1 if the request has been redispatched (in which case your engine
class should not forward this response to handle_response()), 0 otherwise.
=cut