=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