Apache::GenericAuthen 0.01

[japhy]

Category:

Web Stuff

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<[e-mail]>

=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