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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
package Sample::Apache2::AuthCookieHandler;
use strict;
use utf8;
use Class::Load 'load_class';
use Apache2::Const qw(:common HTTP_FORBIDDEN);
use Apache2::AuthCookie;
use Apache2::RequestRec;
use Apache2::RequestIO;
use Apache2::Util;
use URI::Escape qw(uri_escape_utf8 uri_unescape);
use Encode qw(decode);
use vars qw(@ISA);
use Apache::Test;
use Apache::TestUtil;
if (have_min_apache_version('2.4.0')) {
load_class('Apache2_4::AuthCookie');
@ISA = qw(Apache2_4::AuthCookie);
}
else {
load_class('Apache2::AuthCookie');
@ISA = qw(Apache2::AuthCookie);
}
sub authen_cred ($$\@) {
my $self = shift;
my $r = shift;
my @creds = @_;
$r->server->log_error("authen_cred entry");
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 escaped credentials and delaying authentication.
return join ':', map { uri_escape_utf8($_) } @creds;
}
sub authen_ses_key ($$$) {
my ($self, $r, $cookie) = @_;
my ($user, $password) =
map { decode('UTF-8', uri_unescape($_)) }
split /:/, $cookie, 2;
$r->server->log_error("authen_ses_key entry");
$r->server->log_error("user=$user pass=$password cookie=$cookie");
if ($user eq 'programmer' && $password eq 'Hero') {
return $user;
}
elsif ($user eq 'some-user') {
return $user;
}
elsif ($user eq '0') {
return $user;
}
elsif ($user eq '程序员') { # programmer in chinese, at least according to google translate
return $user;
}
else {
return;
}
}
sub dwarf {
my $self = shift;
my $r = shift;
$r->server->log_error("dwarf entry");
my $user = $r->user;
$r->server->log_error("USER=$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;
|
