1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
package Sample::AuthCookieHandler;
use strict;
use Apache::Const qw(:common HTTP_FORBIDDEN);
use Apache::AuthCookie;
use Apache::RequestRec;
use Apache::RequestIO;
use vars qw($VERSION @ISA);
$VERSION = substr(q$Revision: 1.1 $, 10);
@ISA = qw(Apache::AuthCookie);
sub authen_cred ($$\@) {
my $self = shift;
my $r = shift;
my @creds = @_;
return if $creds[0] eq 'fail'; # simulate bad_credentials
# This would really authenticate the credentials
# and return the session key.
# Here I'm just using setting the session
# key to the credentials and delaying authentication.
#
# Similar to HTTP Basic Authentication, only not base 64 encoded
join(":", @creds);
}
sub authen_ses_key ($$$) {
my ($self, $r, $cookie) = @_;
my($user, $password) = split(/:/, $cookie);
$r->server->log_error("user=$user pass=$password cookie=$cookie");
if ($user eq "programmer" && $password eq "Hero") {
$user;
} elsif ($user eq "some-user") {
$user;
} else {
"";
}
}
sub dwarf {
my $self = shift;
my $r = shift;
my $user = $r->user;
if ("bashful doc dopey grumpy happy sleepy sneezy programmer"
=~ /\b$user\b/) {
# You might be thinking to yourself that there were only 7
# dwarves, that's because the marketing folks left out
# the often under appreciated "programmer" because:
#
# 10) He didn't hold 8 to 5 hours.
# 9) Sometimes forgot to shave several days at a time.
# 8) Was always buzzed on caffine.
# 7) Wasn't into heavy labor.
# 6) Prone to "swearing while he worked."
# 5) Wasn't as easily controlled as the other dwarves.
#
# 1) He posted naked pictures of Snow White to the Internet.
return OK;
}
return HTTP_FORBIDDEN;
}
sub login_form_handler {
my ($self, $r) = @_;
my $uri = $r->prev->uri;
my $args = $r->prev->args;
if ($args) {
$uri .= "?$args";
}
my $reason = $r->prev->subprocess_env('AuthCookieReason');
my $form = <<HERE;
<HTML>
<HEAD>
<TITLE>Enter Login and Password</TITLE>
</HEAD>
<BODY onLoad="document.forms[0].credential_0.focus();">
<FORM METHOD="POST" ACTION="/LOGIN">
<TABLE WIDTH=60% ALIGN=CENTER VALIGN=CENTER>
<TR><TD ALIGN=CENTER>
<H1>This is a secure document</H1>
</TD></TR>
<TR><TD ALIGN=LEFT>
<P>Failure reason: '$reason'. Please enter your login and password to authenticate.</P>
</TD>
<TR><TD>
<INPUT TYPE=hidden NAME=destination VALUE="$uri">
</TD></TR>
<TR><TD>
<TABLE ALIGN=CENTER>
<TR>
<TD ALIGN=RIGHT><B>Login:</B></TD>
<TD><INPUT TYPE="text" NAME="credential_0" SIZE=10 MAXLENGTH=10></TD>
</TR>
<TR>
<TD ALIGN=RIGHT><B>Password:</B></TD>
<TD><INPUT TYPE="password" NAME="credential_1" SIZE=8 MAXLENGTH=8></TD>
</TR>
<TR>
<TD COLSPAN=2 ALIGN=CENTER><INPUT TYPE="submit" VALUE="Continue"></TD>
</TR></TABLE>
</TD></TR></TABLE>
</FORM>
</BODY>
</HTML>
HERE
$r->no_cache(1);
$r->content_type('text/html');
my $len = length $form;
$r->headers_out->set('Content-length', $len);
$r->headers_out->set('Pragma', 'no-cache');
$r->print($form);
return OK;
}
1;
|
