diff options
| author | Jan Pazdziora <jpazdziora@redhat.com> | 2014-01-07 23:10:58 -0500 |
|---|---|---|
| committer | Jan Pazdziora <jpazdziora@redhat.com> | 2014-01-07 23:10:58 -0500 |
| commit | 0597e0ca507e70d2859010ae9bcff5e8cdd2293b (patch) | |
| tree | 737eda682bed69cfe1517a14ab4eac24cc21409b /app.cgi | |
| parent | 30be3f9accf36e363f9bd479f5527261ba44f0c5 (diff) | |
| download | CGI-sessions-0597e0ca507e70d2859010ae9bcff5e8cdd2293b.tar.gz CGI-sessions-0597e0ca507e70d2859010ae9bcff5e8cdd2293b.tar.xz CGI-sessions-0597e0ca507e70d2859010ae9bcff5e8cdd2293b.zip | |
Application which allows cookie-based login and logout.
Diffstat (limited to 'app.cgi')
| -rwxr-xr-x | app.cgi | 99 |
1 files changed, 94 insertions, 5 deletions
@@ -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 |