blob: 7ccf98ac7145a934d1c4167444d2f2ef2ada764e (
plain)
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
|
#!/usr/bin/perl
use strict;
use warnings FATAL => 'all';
use CGI ();
my $LOGIN = '/login';
my $LOGOUT = '/logout';
my $AUTH_COOKIE = 'the-test-cookie';
my $q = new CGI;
my $cookie = $q->cookie($AUTH_COOKIE);
my ($user, $name);
if ($cookie and $cookie =~ /^ok:(\S+)$/) {
$user = $1;
$name = CGI::escapeHTML($user);
}
my @nav;
print "Content-Type: text/html; charset=UTF-8\n";
print "Pragma: no-cache\n";
my $title = "Application";
my $body = "This is a test application; public view, not much to see.";
if (defined $user) {
$title .= " authenticated ($name)";
$body = "Test application; logged in as user $name."
. " There is much more content for authenticated users." x 10;
}
sub logout {
print "Set-Cookie: $AUTH_COOKIE=xx; path=$ENV{SCRIPT_NAME}\n";
print "Refresh: 3; URL=$ENV{SCRIPT_NAME}\n";
$title = "Logged out";
$body = 'Successfully logged out. You will be redirected to the '
. qq!<a href="$ENV{SCRIPT_NAME}">home page</a>!;
}
sub login {
if (defined $user) {
print "Refresh: 3; URL=$ENV{SCRIPT_NAME}\n";
$title = "Already logged in";
$body = "You are already logged in as user $name.\n";
return;
}
$title = "Log in to application";
my $login = $q->param('login');
my $password = $q->param('password');
my $error = '';
if (defined $login) {
my $re = qr/^[-a-zA-Z0-9_.]+$/;
if ($login eq '' or not $login =~ $re) {
$error = '<p>Login has to be nonempty, full characters</p>';
} elsif (not defined $password or not $password =~ $re) {
$error = '<p>Password has to be nonempty</p>';
} elsif ($password ne reverse($login)) {
$error = '<p>Password has to be reverse login</p>';
} else {
print "Set-Cookie: $AUTH_COOKIE=ok:$login; path=$ENV{SCRIPT_NAME}\n";
print "Refresh: 3; URL=$ENV{SCRIPT_NAME}\n";
$title = 'Logged in';
$body = 'You will be redirected to the '
. qq!<a href="$ENV{SCRIPT_NAME}">home page</a>!;
return;
}
}
no warnings 'uninitialized';
$body = <<"EOS";
$error
<form method="POST">
<dl>
<dt>Login:</dt>
<dd><input type="text" name="login" value="@{[ CGI::escapeHTML($login) ]}" />
<dt>Password:</dt>
<dd><input type="password" name="password" />
<dt><input type="submit" name="go" value="Log in" /></dt>
</dl>
</form>
EOS
}
if (defined $ENV{PATH_INFO}) {
if ($ENV{PATH_INFO} eq $LOGIN) {
login();
push @nav, qq!<a href="$ENV{SCRIPT_NAME}">Back to application</a>!;
} elsif ($ENV{PATH_INFO} eq $LOGOUT) {
logout();
push @nav, qq!<a href="$ENV{SCRIPT_NAME}">Back to application</a>!;
}
}
if (not @nav) {
push @nav, (defined $user
? qq!<a href="$ENV{SCRIPT_NAME}$LOGOUT">Log out</a>!
: qq!<a href="$ENV{SCRIPT_NAME}$LOGIN">Log in</a>!);
}
print <<"EOS";
<html>
<head>
<title>$title</title>
</head>
<body>
<h1>$title</h1>
<p>$body</p>
<hr/>
<p>@nav</p>
<!--
<hr/>
<pre>@{[ join "\n", map CGI::escapeHTML("$_=$ENV{$_}"), sort keys %ENV ]}
</pre>
-->
</body>
</html>
EOS
|
