Category: | Web Stuff |
Author/Contact Info | japhy
PLEASE email or /msg me with your ideas, suggestions, criticisms, comments, etc. I'll be rele |
Description: | Half authen/authz tutorial, half authen/authz base class. For people who want to write their own Apache authen/authz modules in Perl, but don't know how. |
package Apache::GenericAuthen; use Apache::Constants ':common'; use strict; our $VERSION = '0.01'; our %P; sub handler { my $R = shift; my ($resp, $passwd, $user); ($P{$R}) = $R->get_handlers('PerlAuthenHandler')->[0] =~ /(.*)::/; ($resp, $passwd) = $R->get_basic_auth_pw; return $resp if $resp; $user = $R->connection->user; return $P{$R}->_auth_required( $R, "No Username Given", _need_username => ($R) ) unless $P{$R}->_given_username($user); return $P{$R}->_auth_required( $R, "User $user Unknown", _bad_username => ($R) ) unless $P{$R}->_valid_username($user); return $P{$R}->_auth_required( $R, "Invalid Password for $user", _bad_password => ($R) ) unless $P{$R}->_valid_password($user, $passwd); $R->push_handlers(PerlAuthzHandler => $P{$R}->can('authz')) unless @{ $R->get_handlers("PerlAuthzHandler") || []}; return OK; } sub authz { my ($R) = @_; my $req = $R->requires; my $user = $R->connection->user; return OK unless $req; return OK if $P{$R}->rules($R); return $P{$R}->_auth_required( $R, "$user Not Authorized", _not_auth => ($R) ); } sub rules { my ($class, $R) = @_; my $req = $R->requires; my $user = $R->connection->user; my $ok = 0; RULE: for my $rule (@$req) { my ($how, @args) = split ' ', $rule->{requirement}; if ($how eq 'valid-user') { $ok = 1; next RULE; } elsif ($how eq 'user') { for (@args) { $ok = 1, next RULE if $_ eq $user; } } } return $ok; } sub _auth_required { my ($class, $r, $reason, $resp, @args) = @_; $r->custom_response(AUTH_REQUIRED, $resp->(@args)) if $resp and $resp = $P{$r}->can($resp); $r->log_reason("$P{$r} - $reason", $r->uri) if $reason; $r->note_basic_auth_failure; return AUTH_REQUIRED; } sub _given_username { length $_[1] } sub _valid_username { 1 } sub _valid_password { 1 } sub _need_username { "You need to enter a username." } sub _bad_username { "Your username was not found." } sub _bad_password { "Your password not correct." } sub _not_auth { "You are not authorized." } 1; __END__ =head1 NAME Apache::GenericAuthen - Base class for custom authen/authz handlers =head1 SYNOPSIS # in your httpd.conf <Directory /foo/bar> # This is the standard authentication stuff AuthName "Some Realm Name" AuthType Basic PerlAuthenHandler Apache::MyAuthen require valid-user </Directory> # Apache::MyAuthen package Apache::MyAuthen; use base 'Apache::GenericAuthen'; use Apache::Constants ':common'; use Digest::MD5 'md5_hex'; use DBI; use DBD::xxx; my $dbh = DBI->connect(...); sub _valid_username { my ($user) = @_; my $sth = $dbh->prepare(q{ SELECT * FROM users WHERE username = ? }); $sth->execute($user); return $sth->fetchrow_array ? 1 : 0; } sub _valid_password { my ($user, $pass) = @_; my $sth = $dbh->prepare(q{ SELECT * FROM users WHERE username = ? and password = ? }); $sth->execute($user, md5_hex($pass)); return $sth->fetchrow_array ? 1 : 0; } =head1 DESCRIPTION This is a base class for creating an authentication and/or authorization module for Apache. This module takes care of the general structure; you sub-class it and provide specifics. This module only supports basic authentication, not digest. =head1 USAGE =head2 Authentication I<Authentication> is the process of determining whether the user is who he says he is. In this case, it involves asking for a username and password. Apache::GenericAuthen does three things to authenticate. First, it makes sure a username was sent. Second, it makes sure that username is valid. Third, it checks the password given for the username. These three checks are made by three separate methods, any of which can be overridden. =over 4 =item $class->_given_username($username) Should return true if $username is not empty. The default method checks if $username has length. =item $class->_valid_username($username) Should return true if $username is valid. The default method is just to return 1. =item $class->_valid_password($username, $password) Should return true if $password is the correct password for $username. The default method is just to return 1. =back You should probably override _valid_password(), but the other two methods are usually fine as is. When these methods return false, an C<AUTH_REQUIRED> response is sent, and you can provide a custom error message. The methods below should return a string with the message. =over 4 =item $class->_need_username($R) Called if the username is empty. The Apache Request object is passed to it. The default message is "You need to enter a username." =item $class->_bad_username($R) Called if the username is invalid. The Apache Request object is passed to it. To get the username from the Request object, use: my $user = $R->connection->user; The default message is "Your username was not found." =item $class->_bad_password($R) Called if the password is invalid. The Apache Request object is passed to it. To get the username and password from the Request object, use: my $user = $R->connection->user; my $passwd = ($R->get_basic_auth_pw)[1]; The default message is "Your password not correct." =head2 Authorization I<Authorization> is the process of determining if a user is allowed to access specific content. It assumes the user has been authenticated, and deals with security and permissions. You use the B<require> Apache directive to create authorization rules. The syntax usually used is: # lets any authenticated user in Require valid-user # lets users usr1 or usr2 in Require user usr1 usr2 # lets users in group "alpha" in Require group alpha Apache::GenericAuthen lets you define your own syntax. For example, if you want to allow everyone in group 'alpha', but deny 'foo' (who is in group 'alpha'), then you could write: Require group alpha Require deny user foo and the supporting rules() method: sub rules { my ($class, $R) = @_; my $req = $R->requires; my $user = $R->connection->user; my $ok = 0; RULE: for my $rule (@$req) { my ($how, @args) = split ' ', $rule->{requirement}; my $deny = 0; if ($how eq 'deny') { $deny = 1; $how = shift @args; } if ($how eq 'group') { # assume this function exists $ok = user_in_group($user, @args); next RULE; } elsif ($how eq 'user') { for (@args) { $ok = 1, next RULE if $_ eq $user; } } } continue { $ok = !$ok if $deny; } return $ok; } You could also create a syntax like Require group alpha !user=foo and write your user_in_group() function accordingly. The syntax is entirely up to you. Apache::GenericAuthen only supports C<valid-user> and C<user>. When the time for authorization comes, the authz() function is called, and it receives the Apache Request object. It calls the rules() method, which parses the Require rules and returns true or false, signifying whether the user is authorized. If it returns false, the _not_auth() method is called: =over 4 =item $class->_not_auth($R) Called if the username is not authorized. The Apache Request object is passed to it. To get the requirements and the username from the Request object, use: my $req = $R->requires; my $user = $R->connection->user; The default error message is "You are not authorized." =back =head2 AuthUserFile and AuthGroupFile To set these variables, you must use the C<PerlSetVar> directive; otherwise, the values you set cannot be accessed from the module. <Directory "C:/apache/htdocs/X"> AuthName "GenericAuthen Test" AuthType Basic PerlAuthenHandler Apache::GenericAuthen PerlSetVar AuthGroupFile "C:/apache/x-groups" # you could create support for set notation # this would allow users... # who are in group 'techie' # and group 'boss' # and not in group 'manager' Require group +techie &boss -manager </Directory> =head1 EXTENSIONS Here are some code samples and ideas to help you along. =head2 Addtional C<Require> Ideas Here is an implementation of group set notation as shown above: sub groups_to_hash { my ($R, $groups) = @_; my $file = $R->dir_config('AuthGroupFile'); return unless -e $file; open F, "< $file" or die "can't read $file: $!"; while (<F>) { # assume 'group usr1 usr2 usr3 ...' my ($grp, @usrs) = split; @{ $groups->{$grp} }{@usrs} = (); } close F; } sub rules { my ($class, $R) = @_; my $req = $R->requires; my $user = $R->connection->user; my $ok = 0; my %groups; groups_to_hash($R, \%groups); RULE: for my $rule (@$req) { my ($how, @args) = split ' ', $rule->{requirement}; # other $how-handlers omitted if ($how eq 'group') { for (@args) { my $mode = substr($_, 0, 1, ""); if ($mode eq '+') { $ok = 1 if exists $groups{$_}{$user}; } elsif ($mode eq '&') { $ok = 0 if !exists $groups{$_}{$user}; } elsif ($mode eq '-') { $ok = 0 if exists $groups{$_}{$user}; } elsif ($mode eq '!') { $ok = 1 if !exists $groups{$_}{$user}; } } } } return $ok; } =head1 AUTHOR Jeff C<japhy> Pinyan F<japhy@perlmonk.org> =head1 COPYRIGHT Copyright (c) 2004 Jeff Pinyan This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut |
Back to
Code Catacombs