>>>>> "Bill" == Bill Jones <[EMAIL PROTECTED]> writes:
>> From: [EMAIL PROTECTED] (Randal L. Schwartz)
>> The docs hint that I can use whatever I would put after ErrorDocument
>> as the arg to custom_response, but also suggest that I can put "a
>> module" there. Does that mean it's the same style of argument as a
-> pushhandler(), where I can also put a coderef?
Bill> In Chapter Nine, there are other possibilities. Would you wish to:
Bill> set_handlers()
No, that's not going to work. If I push a content handler, but then
error out, it'll go to the *error* handler, not the content handler.
And for those following along, after further study in the source, it
looks like custom_response can be only one of three things: a string,
an internal URL (internal redirect) or an external URL (external
redirect on error). Same thing as a "ErrorDocument" directive.
So, I'm punting. When I get an error, I have to redirect to a URL,
which then has to start all over figuring out why they were sent
there. Which is not totally bad, because I have to ask the user some
questions in a form, and I need to reevaluate why they might be there
on the return trip anyway in case the world has changed out from under
me.
I *am* generating the URL dynamically though... check this out so far.
Basically, I want to let an area be visited by my friends, but have
each of them generate a unique user/password without me intervening.
So, I set up a file Friends that looks like:
[EMAIL PROTECTED] programs,pictures
[EMAIL PROTECTED] programs
and then an .htaccess that looks like:
PerlAuthenHandler Stonehenge::RestrictToList
AuthName Friends
AuthType Basic
require programs
and then that triggers the handler, which initially will auth-error
out to the CGI I'm still writing. The CGI will interact to get a
email addr, username, and password, and then email a URL-to-visit as a
confirmation. (A password cannot be mailed to an already visited
user, or to a user not on the list, so we have very little mischief
possible. Someone with access to the mailing list could pre-trigger
the confirmation messages, but that'd be pretty visible.) Prior to
confirmation, the CGI updates the file to:
[EMAIL PROTECTED] programs,pictures billuser 118cdaPNTw2.2-128374kfhasf7s8d
[EMAIL PROTECTED] programs
where 118... is the crypted selected passwd, and 1283... is the secret
in the URL that must be visited (mailed to [EMAIL PROTECTED]). When that
URL of /cgi/confirm?secret=1283... is visited, the file is updated to:
[EMAIL PROTECTED] programs,pictures billuser 118cdaPNTw2.2
[EMAIL PROTECTED] programs
and then the handler will let bill in as billuser, but not doug,
because he's not gone through the process yet. Here's the handler
currently. (And yes, this is for my next WebTechniques column... :)
## PerlAuthenHandler Stonehenge::RestrictToList
package Stonehenge::RestrictToList;
use strict;
use vars qw($VERSION);
$VERSION = (qw$Revision: 1.2 $ )[-1];
## config
my $DIR = "/home/merlyn/Web/RestrictToList";
## end config
use Apache::Constants qw(:common);
use Apache::URI;
use Apache::File;
sub handler {
use Stonehenge::Reload; goto &handler if Stonehenge::Reload->reload_me;
my $r = shift;
my $log = $r->log;
my $sent_pw = do {
my ($result,$pw) = $r->get_basic_auth_pw;
return $result unless $result == OK;
$pw;
};
my $sent_user = $r->connection->user;
my $auth_name = $r->auth_name;
my $db_handle = do {
my $name = $auth_name;
$name =~ tr/A-Za-z0-9//cd;
$name = "$DIR/$name";
Apache::File->new("<$name") or do {
$r->note_basic_auth_failure;
$r->log_reason("no database for $auth_name ($name)");
return SERVER_ERROR;
};
};
{
my $error_uri = Apache::URI->parse($r, "/cgi/restricttolist");
$error_uri->query(join "", "realm=",
map "%$_", unpack("H*",$auth_name) =~ /(..)/g);
$r->custom_response(AUTH_REQUIRED, $error_uri->unparse);
}
while (<$db_handle>) {
my ($email, $keys, $user, $pw) = split;
next unless $user and $user eq $sent_user;
if ($pw eq crypt($sent_pw,$pw)) {
$r->push_handlers
(PerlAuthzHandler => sub {
my %keys = map { $_, 1 } split /\W+/, $keys;
ENTRY:
for my $entry (@{$r->requires}) {
## entries are or'ed, locks are and'ed
my $op = $entry->{requirement};
return OK if $op eq 'valid-user';
my @locks = split /\W+/, $op;
for my $lock (@locks) {
next ENTRY unless $keys{$lock};
}
return OK; # the someone we know is OK here
}
$r->note_basic_auth_failure;
$r->log_reason("user $user not keyed for ", $r->uri);
return AUTH_REQUIRED;
});
return OK; # they are somebody we know
}
$r->note_basic_auth_failure;
$r->log_reason("password $sent_pw not valid for $user");
return AUTH_REQUIRED;
}
$r->note_basic_auth_failure;
$r->log_reason("username $sent_user not recognized");
return AUTH_REQUIRED;
}
1;
--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<[EMAIL PROTECTED]> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!
