From 0597e0ca507e70d2859010ae9bcff5e8cdd2293b Mon Sep 17 00:00:00 2001
From: Jan Pazdziora <jpazdziora@redhat.com>
Date: Tue, 7 Jan 2014 23:10:58 -0500
Subject: Application which allows cookie-based login and logout.

---
 README  | 17 +++++++++++
 app.cgi | 99 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 111 insertions(+), 5 deletions(-)
 create mode 100644 README

diff --git a/README b/README
new file mode 100644
index 0000000..1368955
--- /dev/null
+++ b/README
@@ -0,0 +1,17 @@
+
+Example CGI application which supports HTTP cookie sessions together
+with login form and logout page. It is intentionally written in simple
+perl with the CGI.pm module only used to parse POST values and HTTP
+cookie values, to make it easy to tweak and explore.
+
+If the script is placed to /var/www/app/app.cgi, the following Apache
+httpd directive will enable it on http://server-name/application
+location:
+
+	ScriptAlias /application /var/www/app/app.cgi
+
+The script uses HTTP cookie the-test-cookie to either have value
+ok:login to mean user login is logged in, or value xx to mean the user
+has logged out. Links to the login and logout pages are shown at the
+bottom of the page.
+
diff --git a/app.cgi b/app.cgi
index fdf765f..7ccf98a 100755
--- a/app.cgi
+++ b/app.cgi
@@ -4,23 +4,112 @@ 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>Application</title>
+    <title>$title</title>
   </head>
   <body>
-    <h1>Application</h1>
-    <p>
-    This is a test application.
-    </p>
+    <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
-- 
cgit