1# $Id: /mirror/gungho/lib/Gungho/Component/Authentication.pm 1657 2007-04-10T02:26:11.598323Z lestrrat  $
2#
3# Copyright (c) 2007 Daisuke Maki <daisuke@endeworks.jp>
4# all rights reserved.
5
6package Gungho::Component::Authentication;
7use strict;
8use warnings;
9use base qw(Gungho::Component);
10use Carp qw(croak);
11use HTTP::Status();
12use HTTP::Headers::Util();
13
14sub authenticate
15{
16    croak ref($_[0]) . "::authenticate() unimplemented";
17}
18
19sub check_authentication_challenge
20{
21    my ($c, $req, $res) = @_;
22
23    my $handled = 0;
24
25    # Check if there was a Auth challenge. If yes and Gungho is configured
26    # to support authentication, then do the auth magic
27    my $code = $res->code;
28
29    if ( $code == &HTTP::Status::RC_UNAUTHORIZED ||
30         $code == &HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED )
31    {
32        my $proxy = ($code == &HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED);
33        my $ch_header = $proxy ? "Proxy-Authenticate" : "WWW-Authenticate";
34        my @challenge = $res->header($ch_header);
35
36        if (! @challenge) {
37            $c->log->debug("Response from " . $req->uri . " returned with code = $code, but is missing Authenticate header");
38            $res->header("Client-Warning" => "Missing Authenticate header");
39            goto DONE;
40        }
41CHALLENGE:
42        for my $challenge (@challenge) {
43            $challenge =~ tr/,/;/; # "," is used to separate auth-params!!
44            ($challenge) = HTTP::Headers::Util::split_header_words($challenge);
45            my $scheme = lc(shift(@$challenge));
46            shift(@$challenge); # no value
47            $challenge = { @$challenge };  # make rest into a hash
48            for (keys %$challenge) {       # make sure all keys are lower case
49                $challenge->{lc $_} = delete $challenge->{$_};
50            }
51
52            unless ($scheme =~ /^([a-z]+(?:-[a-z]+)*)$/) {
53                $c->log->debug("Response from " . $req->uri . " returned with code = $code, bad authentication scheme '$scheme'");
54                $res->header("Client-Warning" => "Bad authentication scheme '$scheme'");
55                goto DONE;
56            }
57            $scheme = ucfirst $1;  # untainted now
58
59            if (! $c->has_feature("Authentication::$scheme")) {
60                $c->log->debug("Response from " . $req->uri . " returned with code = $code, but authentication scheme '$scheme' is unsupported");
61                goto DONE;
62            }
63
64            # now attempt to authenticate
65            return $c->authenticate($proxy, $challenge, $req, $res);
66        }
67    }
68
69DONE:
70    return $handled;
71}
72
731;
74
75__END__
76
77=head1 NAME
78
79Gungho::Component::Authentication - Base Class For WWW Authentication
80
81=head1 SYNOPSIS
82
83   package MyAuth;
84   use base qw(Gungho::Component::Authentication);
85
86=head1 DESCRIPTION
87
88Gungho::Component::Authentication provides the base mechanism to detect
89and authenticate WWW Authentication responses.
90
91Subclasses must override the authenticate() method.
92
93=head1 METHODS
94
95=head2 authenticate($is_proxy, $auth_params, $request, $response)
96
97Should authenticate the request, and do any re-dispatching if need be.
98Should return 1 if the request has been redispatched.
99
100=head2 check_authentication_challenge($c, $req, $res)
101
102Checks the given request/response for a WWW Authentication challenge, and
103re-dispatches the request if need be.
104
105Returns 1 if the request has been redispatched (in which case your engine
106class should not forward this response to handle_response()), 0 otherwise.
107
108=cut
109