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