view release on metacpan or  search on metacpan

contrib/AuthDigestDBI.pm  view on Meta::CPAN

    # Unless the cache or the CleanupHandler is disabled, the CleanupHandler is initiated 
    # if the last run was more than $CleanupTime seconds before. 
    # Note, that it runs after the request, hence it cleans also the authorization entries 
    if ($CacheTime and $CleanupTime >= 0) {
        my $diff = time - substr($Cache, 0, index($Cache, "$;"));
        print STDERR "$prefix secs since last CleanupHandler: $diff, CleanupTime: $CleanupTime \n" if $Apache::AuthDigestDBI::DEBUG > 1;
        if ($diff > $CleanupTime and Apache->can('push_handlers')) {
            print STDERR "$prefix push PerlCleanupHandler \n" if $Apache::AuthDigestDBI::DEBUG > 1;
            Apache->push_handlers("PerlCleanupHandler", \&cleanup);
        }
    }

    printf STDERR "$prefix return OK\n" if $Apache::AuthDigestDBI::DEBUG > 1;
    return OK;
}


# authorization handler, it is called immediately after the authentication

sub authz {

    my ($r) = @_;
    my ($key, $val, $dbh);

    my ($prefix) = "$$ Apache::AuthDigestDBI::authz ";

    if ($Apache::AuthDigestDBI::DEBUG > 1) {
        my ($type) = '';
        $type .= 'initial ' if $r->is_initial_req;
        $type .= 'main'     if $r->is_main;
        print STDERR "==========\n$prefix request type = >$type< \n";
    }

    return OK unless $r->is_initial_req; # only the first internal request

    my ($user_result)  = DECLINED;
    my ($group_result) = DECLINED;

    # get username
    my ($user_sent) = $r->connection->user;
    print STDERR "$prefix user sent = >$user_sent<\n" if $Apache::AuthDigestDBI::DEBUG > 1 ;

    # here we could read the configuration, but we re-use the configuration from the authentication

    # parse connect attributes, which may be tilde separated lists
    my @data_sources = split(/~/, $Attr->{data_source});
    my @usernames    = split(/~/, $Attr->{username});
    my @passwords    = split(/~/, $Attr->{password});
    $data_sources[0] = '' unless $data_sources[0]; # use ENV{DBI_DSN} if not defined

    # if not configured decline
    unless ($Attr->{pwd_table} && $Attr->{uid_field} && $Attr->{grp_field}) {
        printf STDERR "$prefix not configured, return DECLINED\n" if $Apache::AuthDigestDBI::DEBUG > 1;
        return DECLINED;
    }

    # do we want Windows-like case-insensitivity?
    $user_sent = lc($user_sent) if $Attr->{uidcasesensitive} eq "off";

    # select code to return if authorization is denied:
    my $authz_denied= $Attr->{expeditive} eq 'on' ? FORBIDDEN : AUTH_REQUIRED;

    # check if requirements exists
    my ($ary_ref) = $r->requires;
    unless ($ary_ref) {
        if ($Attr->{authoritative} eq 'on') {
            $r->log_reason("user $user_sent denied, no access rules specified (DBI-Authoritative)", $r->uri);
            $r->note_basic_auth_failure if $authz_denied == AUTH_REQUIRED;
            return $authz_denied;
        }
        printf STDERR "$prefix no requirements and not authoritative, return DECLINED\n" if $Apache::AuthDigestDBI::DEBUG > 1;
        return DECLINED;
    }

    # iterate over all requirement directives and store them according to their type (valid-user, user, group)
    my($hash_ref, $valid_user, $user_requirements, $group_requirements);
    foreach $hash_ref (@$ary_ref) {
        while (($key,$val) = each %$hash_ref) {
            last if $key eq 'requirement';
        }
        $val =~ s/^\s*require\s+//;
        # handle different requirement-types
        if ($val =~ /valid-user/) {
            $valid_user = 1;
        } elsif ($val =~ s/^user\s+//go) {
            $user_requirements .= " $val";
        } elsif ($val =~ s/^group\s+//go) {
            $group_requirements .= " $val";
        }
    }
    $user_requirements  =~ s/^ //go;
    $group_requirements =~ s/^ //go;
    print STDERR "$prefix requirements: valid-user=>$valid_user< user=>$user_requirements< group=>$group_requirements< \n"  if $Apache::AuthDigestDBI::DEBUG > 1;

    # check for valid-user
    if ($valid_user) {
        $user_result = OK;
        print STDERR "$prefix user_result = OK: valid-user\n" if $Apache::AuthDigestDBI::DEBUG > 1;
    }

    # check for users
    if ($user_result != OK && $user_requirements) {
        $user_result = AUTH_REQUIRED;
        my $user_required;
        foreach $user_required (split /\s+/, $user_requirements) {
            if ($user_required eq $user_sent) {
                print STDERR "$prefix user_result = OK for $user_required \n" if $Apache::AuthDigestDBI::DEBUG > 1;
                $user_result = OK;
                last;
           }
        }
    }

    # check for groups
    if ($user_result != OK && $group_requirements) {
        $group_result = AUTH_REQUIRED;
        my ($group, $group_required);

        # check whether the user is cached but consider that the group possibly has changed
        my $groups = '';
        if ($CacheTime) { # do we use the cache ?