=pod

Date: Mon, 9 Jun 1997 19:25:38 +0200
Message-Id: <[email protected]>
From: "Andreas J. Koenig" <[email protected]>
To: Doug MacEachern <[email protected]>
CC: [email protected]
In-reply-to: <[email protected]> (message from Doug
       MacEachern on Sun, 8 Jun 1997 18:50:16 -0400)
Subject: Re: How do I get Authen.pm to work?
Reply-to: [email protected]
X-UIDL: 0e08d50b2bd518afc44a1eb8a02c9563

[...]

Maybe you'd like to use the PAUSE::Authen module as an example. It's
actually used on the Perl Authors Upload Server in "production" code.

PAUSE::Authen implements a case-insensitive
authorization/authentification combination. If I cannot identify a
user from his userid, I give him a second chance on the uppercased
username and retry. On success I change his userid to the uppercase
one.

Maybe it helps somebody to get started. Here it goes....

---------8<---------------
=cut

package PAUSE::Authen;
use Apache ();
use strict;
use Apache::Constants qw(OK AUTH_REQUIRED DECLINED);
use HTTPD::UserAdmin;

sub handler {
   my($r) = @_;
   return OK unless $r->is_initial_req; #only the first internal request
   my($res, $sent_pw) = $r->get_basic_auth_pw;
   # warn "res[$res]sent_pw[$sent_pw]";
   return $res if $res; #decline if not Basic

   my $user = $r->connection->user;
   # warn "user[$user]";

   my $pw_file = $r->dir_config("AuthUserFile") || "/usr/local/etc/httpd/etc/passwd";
   # warn "AuthUserFile[$pw_file]";

   my $u = HTTPD::UserAdmin->new(
                                 DB      => $pw_file,
                                 DBType  => "Text",
                                 Server  => "apache",
                                 Locking => 0,
                                 Flags   => "r",
                                );

   # The famous PAUSE case-insensitive authentification:
   unless ($user eq uc $user or $u->exists($user)){
       $user = uc $user;
       $r->connection->user($user);
   }
   my $crypt_pw  = $u->password($user);
   my($expect) = crypt($sent_pw,$crypt_pw);
   unless ($u->exists($user) and $expect eq $crypt_pw) {
       $r->log_reason("Either user[$user] or passwd wrong. crypt from passwd[$crypt_pw] crypt from sent[$expect]", $r->uri);
       $r->note_basic_auth_failure;
       return AUTH_REQUIRED;
   }
   return OK;
}

1;

=head1 MEMO for PAUSE::Authen

In .htaccess we have:

PerlSetVar AuthUserFile /usr/local/etc/httpd/etc/passwd
AuthName PAUSE
AuthType Basic
<Limit GET POST>
require valid-user
</Limit>

In access.conf we find:

<Location /perl/user>
PerlAuthenHandler PAUSE::Authen
</Location>

=cut