"Fossies" - the Fresh Open Source Software Archive

Member "mod_perl-2.0.11/t/response/TestAPI/access2.pm" (5 Oct 2019, 3304 Bytes) of package /linux/www/apache_httpd_modules/mod_perl-2.0.11.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the last Fossies "Diffs" side-by-side code changes report for "access2.pm": 2.0.8_vs_2.0.9.

    1 # please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
    2 package TestAPI::access2;
    3 
    4 # testing $r->requires
    5 # in the POST test it returns:
    6 #
    7 #  [
    8 #    {
    9 #      'method_mask' => -1,
   10 #      'requirement' => 'user goo bar'
   11 #    },
   12 #    {
   13 #      'method_mask' => -1,
   14 #      'requirement' => 'group bar tar'
   15 #    }
   16 #    {
   17 #      'method_mask' => 4,
   18 #      'requirement' => 'valid-user'
   19 #    }
   20 #  ];
   21 #
   22 # otherwise it returns the same, sans the 'valid-user' entry
   23 #
   24 # also test:
   25 # - $r->some_auth_required when it's required
   26 # - $r->satisfies when Satisfy is set
   27 
   28 use strict;
   29 use warnings FATAL => 'all';
   30 
   31 use Apache2::Access ();
   32 use Apache2::RequestRec ();
   33 
   34 use Apache::TestTrace;
   35 
   36 use Apache2::Const -compile => qw(OK HTTP_UNAUTHORIZED SERVER_ERROR
   37                                  M_POST :satisfy);
   38 
   39 my $users  = "goo bar";
   40 my $groups = "bar tar";
   41 my %users = (
   42     goo => "goopass",
   43     bar => "barpass",
   44 );
   45 
   46 sub handler {
   47     my $r = shift;
   48     die '$r->some_auth_required failed' unless $r->some_auth_required;
   49 
   50     my $satisfies = $r->satisfies;
   51     die "wanted satisfies=" . Apache2::Const::SATISFY_ALL . ", got $satisfies"
   52         unless $r->satisfies() == Apache2::Const::SATISFY_ALL;
   53 
   54     my ($rc, $sent_pw) = $r->get_basic_auth_pw;
   55     return $rc if $rc != Apache2::Const::OK;
   56 
   57     # extract just the requirement entries
   58     my %require =
   59         map { my ($k, $v) = split /\s+/, $_->{requirement}, 2; ($k, $v||'') }
   60         @{ $r->requires };
   61     debug \%require;
   62 
   63     # silly (we don't check user/pass here), just checking when
   64     # the Limit options are getting through
   65     if ($r->method_number == Apache2::Const::M_POST) {
   66         if (exists $require{"valid-user"}) {
   67             return Apache2::Const::OK;
   68         }
   69         else {
   70             return Apache2::Const::SERVER_ERROR;
   71         }
   72     }
   73     else {
   74         # non-POST requests shouldn't see the Limit enclosed entry
   75         return Apache2::Const::SERVER_ERROR if exists $require{"valid-user"};
   76     }
   77 
   78     return Apache2::Const::SERVER_ERROR unless $require{user}  eq $users;
   79     return Apache2::Const::SERVER_ERROR unless $require{group} eq $groups;
   80 
   81     my $user = $r->user;
   82     my $pass = $users{$user} || '';
   83     unless (defined $pass and $sent_pw eq $pass) {
   84         $r->note_basic_auth_failure;
   85         return Apache2::Const::HTTP_UNAUTHORIZED;
   86     }
   87 
   88     Apache2::Const::OK;
   89 }
   90 
   91 1;
   92 __DATA__
   93 
   94 <NoAutoConfig>
   95 <IfModule mod_version.c>
   96 <IfVersion < 2.3.0>
   97 <Location /TestAPI__access2>
   98     PerlAuthenHandler TestAPI::access2
   99     PerlResponseHandler Apache::TestHandler::ok1
  100     SetHandler modperl
  101 
  102     <IfModule @ACCESS_MODULE@>
  103         # needed to test $r->satisfies
  104         Allow from All
  105     </IfModule>
  106     AuthType Basic
  107     AuthName "Access"
  108     Require user goo bar
  109     Require group bar tar
  110     <Limit POST>
  111        Require valid-user
  112     </Limit>
  113     Satisfy All
  114     <IfModule @AUTH_MODULE@>
  115         # htpasswd -mbc auth-users goo foo
  116         # htpasswd -mb auth-users bar mar
  117         # using md5 password so it'll work on win32 too
  118         AuthUserFile @DocumentRoot@/api/auth-users
  119         # group: user1 user2 ...
  120         AuthGroupFile @DocumentRoot@/api/auth-groups
  121     </IfModule>
  122 </Location>
  123 </IfVersion>
  124 </IfModule>
  125 </NoAutoConfig>