#!/usr/bin/perl
# Copyright 2014 Jan Pazdziora
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
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:(.+)$/) {
$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!home page!;
}
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 $ENV{REMOTE_USER}) {
$login = $ENV{REMOTE_USER};
if (defined $ENV{REMOTE_USER_EMAIL}) {
$login .= ": $ENV{REMOTE_USER_EMAIL}";
}
my $n = join ' ', grep defined $_, map $ENV{$_},
'REMOTE_USER_FIRSTNAME', 'REMOTE_USER_LASTNAME';
if ($n ne '') {
$login = "$n ($login)";
}
} elsif (defined $login) {
my $re = qr/^[-a-zA-Z0-9_.]+$/;
if ($login eq '' or not $login =~ $re) {
$error = 'Login has to be nonempty, full characters
';
} elsif (not defined $password or not $password =~ $re) {
$error = 'Password has to be nonempty
';
} elsif ($password ne reverse($login)) {
$error = 'Password has to be reverse login
';
}
}
if (defined $login and $error eq '') {
print "Set-Cookie: $AUTH_COOKIE=ok:$login; path=$ENV{SCRIPT_NAME}\n";
print "Refresh: 3; URL=$ENV{SCRIPT_NAME}\n";
$title = 'Logged in as ' . CGI::escapeHTML($login);
$body = 'You will be redirected to the '
. qq!home page!;
return;
}
no warnings 'uninitialized';
$body = <<"EOS";
$error
EOS
}
if (defined $ENV{PATH_INFO}) {
if (substr($ENV{PATH_INFO}, 0, length($LOGIN)) eq $LOGIN) {
login();
push @nav, qq!Back to application!;
} elsif ($ENV{PATH_INFO} eq $LOGOUT) {
logout();
push @nav, qq!Back to application!;
}
}
if (not @nav) {
push @nav, (defined $user
? qq!Log out!
: qq!Log in!);
}
print <<"EOS";
$title
$title
$body
@nav
EOS