perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0/t/hooks/TestHooks authen_basic.pm authen.pm
Date Sun, 08 Aug 2004 17:57:57 GMT
stas        2004/08/08 10:57:57

  Added:       t/hooks  authen_basic.t
               t/hooks/TestHooks authen_basic.pm
  Removed:     t/hooks  authen.t
               t/hooks/TestHooks authen.pm
  Log:
  s/authen/authen_basic/ as now we have authen_digest as well
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/hooks/authen_basic.t
  
  Index: authen_basic.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestRequest;
  
  plan tests => 4, need need_lwp, need_auth;
  
  my $location = "/TestHooks__authen_basic";
  
  sok {
      ! GET_OK $location;
  };
  
  sok {
      my $rc = GET_RC $location;
      $rc == 401;
  };
  
  sok {
      GET_OK $location, username => 'dougm', password => 'foo';
  };
  
  sok {
      ! GET_OK $location, username => 'dougm', password => 'wrong';
  };
  
  
  
  
  
  
  1.1                  modperl-2.0/t/hooks/TestHooks/authen_basic.pm
  
  Index: authen_basic.pm
  ===================================================================
  package TestHooks::authen_basic;
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Access ();
  
  use Apache::Const -compile => qw(OK HTTP_UNAUTHORIZED SERVER_ERROR);
  
  sub handler {
      my $r = shift;
  
      my($rc, $sent_pw) = $r->get_basic_auth_pw;
  
      return $rc if $rc != Apache::OK;
  
      my $user = $r->user;
  
      my $requirement = $r->requires->[0]->{requirement};
  
      return Apache::SERVER_ERROR unless $requirement eq 'valid-user';
  
      unless ($user eq 'dougm' and $sent_pw eq 'foo') {
          $r->note_basic_auth_failure;
          return Apache::HTTP_UNAUTHORIZED;
      }
  
      Apache::OK;
  }
  
  1;
  __DATA__
  <NoAutoConfig>
  <Location /TestHooks__authen_basic>
      require valid-user
      AuthType Basic
      AuthName simple
      PerlAuthenHandler TestHooks::authen_basic
      PerlResponseHandler Apache::TestHandler::ok1
      SetHandler modperl
  </Location>
  </NoAutoConfig>
  
  
  

Mime
View raw message