<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Apache::AuthzAge;
use strict;
use Apache::Constants ':common';
use NDBM_File;
use Fcntl '&amp;O_RDONLY';

my $Flags = O_RDONLY;
 
sub handler {
    my($r) = @_;
    return OK unless $r-&gt;is_initial_req; #only the first internal request
    my $reqs_arr = $r-&gt;requires;
    return OK unless $reqs_arr;

    my $dbm_file = $r-&gt;dir_config("UserAgeFile") or
	return DECLINED;
    my %Age;
    unless(tie(%Age =&gt; 'NDBM_File', $dbm_file, $Flags, undef)) {
	$r-&gt;log_reason("Can't open $dbm_file $!", $r-&gt;uri);
	return SERVER_ERROR;
    }

    my($reqs, $restricted, $require, $min_age);
    my $user = $r-&gt;connection-&gt;user;

    foreach $reqs (@$reqs_arr) {
	($require, $min_age) = split /\s+/, $reqs-&gt;{requirement}, 2;
	next unless $require eq "age";
	$restricted++; 
	return OK if $Age{$user} &gt;= $min_age; 
    }

    return OK unless $restricted;
    $r-&gt;log_reason("User $user younger than $min_age", $r-&gt;uri);
    $r-&gt;note_basic_auth_failure;
    return FORBIDDEN;
}

1;

__END__

=head1 NAME

Apache::AuthzAge - Authorize based on age

=head1 SYNOPSIS

 #access control directives

 #use standard authentication modules
 AuthName SomeRealm
 Auth[DBM]UserFile /path/to/password/file
 
 PerlAuthzHandler Apache::AuthzAge
 PerlSetVar       UserAgeFile  /path/to/dbm_file

 #user must be at least 21
 &lt;Limit GET&gt;
 require age 21
 &lt;/Limit&gt;

=head1 DESCRIPTION

Decide if an authenticated user is authorized to complete a request
based on age.  

B&lt;UserAgeFile&gt; is a dbm file consisting of I&lt;username&gt; = I&lt;age&gt; value 
pairs.

=head1 SEE ALSO

Apache(3)

=head1 AUTHOR

Doug MacEachern &lt;dougm@osf.org&gt;




</pre></body></html>