<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">=pod

Date: Mon, 9 Jun 1997 19:25:38 +0200
Message-Id: &lt;199706091725.TAA25746@anna.in-berlin.de&gt;
From: "Andreas J. Koenig" &lt;k@anna.in-berlin.de&gt;
To: Doug MacEachern &lt;dougm@osf.org&gt;
CC: MODPERL@LISTPROC.ITRIBE.NET
In-reply-to: &lt;199706082250.SAA01428@postman.opengroup.org&gt; (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: koenig@franz.ww.tu-berlin.de
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&lt;---------------
=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-&gt;is_initial_req; #only the first internal request
    my($res, $sent_pw) = $r-&gt;get_basic_auth_pw;
    # warn "res[$res]sent_pw[$sent_pw]";
    return $res if $res; #decline if not Basic

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

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

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

    # The famous PAUSE case-insensitive authentification:
    unless ($user eq uc $user or $u-&gt;exists($user)){
	$user = uc $user;
	$r-&gt;connection-&gt;user($user);
    }
    my $crypt_pw  = $u-&gt;password($user);
    my($expect) = crypt($sent_pw,$crypt_pw);
    unless ($u-&gt;exists($user) and $expect eq $crypt_pw) {
	$r-&gt;log_reason("Either user[$user] or passwd wrong. crypt from passwd[$crypt_pw] crypt from sent[$expect]", $r-&gt;uri);
	$r-&gt;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
&lt;Limit GET POST&gt;
require valid-user
&lt;/Limit&gt;

In access.conf we find:

&lt;Location /perl/user&gt;
PerlAuthenHandler PAUSE::Authen
&lt;/Location&gt;

=cut
</pre></body></html>