view release on metacpan or  search on metacpan

lib/Apache2/AuthAny/AuthzHandler.pm  view on Meta::CPAN

package Apache2::AuthAny::AuthzHandler;

use strict;
use Apache2::Const -compile => qw(OK DECLINED HTTP_UNAUTHORIZED);
use Data::Dumper qw(Dumper);

use Apache2::AuthAny::DB qw();
our $VERSION = '0.201';

sub handler {
    my $r = shift;

    my $cf = Apache2::Module::get_config('Apache2::AuthAny',
                                         $r->server,
                                         $r->per_dir_config) || {};

    my %require;
    foreach my $req (@{ $r->requires }) {
        my ($k, @v) = split /\s+/, $req->{requirement};
#        warn "\$k => $k, \@v => @v";
        unless ($k) {
            my $msg = "Configuration error. Lone Require";
            $r->log->error("Apache2::AuthAny::AuthzHandler: $msg");
            die $msg;
        }
        $k = lc($k);

        if ($k eq 'valid-user') {
            $require{'valid-user'} = 1;

        } elsif ($k eq 'identified-user') {
            $require{'identified-user'} = 1;

         } elsif ($k eq 'authenticated') {
             $require{'authenticated'} = 1;

         } elsif ($k eq 'session') {
             $require{'session'} = 1;

        } elsif ($k eq 'user') {
            foreach my $user (@v) {
                $require{user}{$user} = 1;
            }

        } elsif ($k eq 'role') {
            foreach my $role (@v) {
                push @{ $require{role} }, $role;
            }

        } else {
            my $msg = "invalid Require statement 'Require $req->{requirement}'";
            die "$msg";
        }
    }

#    warn Dumper(\%require);
    unless (%require) {
        my $msg = "Apache2::AuthAny::AuthzHandler: No 'Require'. WTF";
        $r->log->error($msg);
        die $msg;
        #return Apache2::Const::DECLINED;
    }

    my $user_permitted = 0;
    $r->log->info("Authz: %require: '" . Dumper(\%require) . "'");