dougm 01/04/12 18:26:56 Added: t/hooks authz.t t/hooks/TestHooks authz.pm Log: add PerlAuthzHandler test Revision Changes Path 1.1 modperl-2.0/t/hooks/authz.t Index: authz.t =================================================================== use strict; use warnings FATAL => 'all'; use Apache::Test; use Apache::TestRequest; plan tests => 4, \&have_lwp; my $location = "/TestHooks::authz"; ok ! GET_OK $location; my $rc = GET_RC $location; ok $rc == 401; ok GET_OK $location, username => 'dougm', password => 'foo'; ok ! GET_OK $location, username => 'jobbob', password => 'whatever'; 1.1 modperl-2.0/t/hooks/TestHooks/authz.pm Index: authz.pm =================================================================== package TestHooks::authz; use strict; use warnings FATAL => 'all'; use Apache::Access (); use Apache::Const -compile => qw(OK AUTH_REQUIRED); sub auth_any { my $r = shift; my($res, $sent_pw) = $r->get_basic_auth_pw; return $res if $res != Apache::OK; unless($r->user and $sent_pw) { $r->note_basic_auth_failure; return Apache::AUTH_REQUIRED; } return Apache::OK; } sub handler { my $r = shift; my $user = $r->user; return Apache::AUTH_REQUIRED unless $user; my($u, @allowed) = split /\s+/, $r->requires->[0]->{requirement}; return Apache::AUTH_REQUIRED unless grep { $_ eq $user } @allowed; Apache::OK; } 1; __DATA__ require user dougm AuthType Basic AuthName simple PerlAuthenHandler TestHooks::authz::auth_any PerlResponseHandler Apache::TestHandler::ok1 SetHandler modperl