Gender-Based Authorization

This module uses Text::GenderFromName to authorized based on user's apparent gender.

Configuration Entry

 <Location /ladies_only>
   AuthName "Ladies Only"
   AuthType Basic
   PerlAuthenHandler Apache::AuthAny
   PerlAuthzHandler  Apache::AuthzGender
   require gender F            # allow females
   require user Webmaster      # allow Webmaster
 </Location>

Script III.4.3: Apache::AuthZGender

 package Apache::AuthzGender;

 use strict;
 use Text::GenderFromName;
 use Apache::Constants ":common";

 my %G=('M'=>"male",'F'=>"female");

 sub handler {
     my $r = shift;
    
     return DECLINED unless my $requires = $r->requires;
     my $user = lc($r->connection->user);
     substr($user,0,1)=~tr/a-z/A-Z/;
     my $guessed_gender = uc(gender($user)) || 'M';

     my $explanation = <<END;
 <HTML><HEAD><TITLE>Unauthorized</TITLE></HEAD><BODY>
 <H1>You Are Not Authorized to Access This Page</H1>
 Access to this page is limited to:
 <OL>
 END

     foreach (@$requires) {
	 my ($requirement,@rest ) = split(/\s+/,$_->{requirement});
	 if (lc $requirement eq 'user') {
             foreach (@rest) { return OK if $user eq $_; }
	     $explanation .= "<LI>Users @rest.\n";
         } elsif (lc $requirement eq 'gender') {
	     foreach (@rest) { return OK if $guessed_gender eq uc $_; }
	     $explanation .= "<LI>People of the @G{@rest} persuasion.\n";
	 } elsif (lc $requirement eq 'valid-user') {
	     return OK;
	 }
     }

     $explanation .= "</OL></BODY></HTML>";
    
     $r->custom_response(AUTH_REQUIRED,$explanation);
     $r->note_basic_auth_failure;
     $r->log_reason("user $user: not authorized",$r->filename);
     return AUTH_REQUIRED;
 }

 1;
http://localhost/ladies_only/test_document.html
<< Previous
Contents >> Next >>

Lincoln D. Stein, lstein@cshl.org
Cold Spring Harbor Laboratory
Last modified: Thu Nov 4 07:28:58 EST 1999