oracular (3) CGI::Tiny::Cookbook.3pm.gz
NAME
CGI::Tiny::Cookbook - Recipes for advanced CGI::Tiny usage
DESCRIPTION
CGI::Tiny is a minimal interface to the CGI protocol, but common tasks can be simplified with the use of
other CPAN modules and techniques.
RECIPES
Dependencies
CGI scripts which have dependencies, including CGI::Tiny itself, must be run using the perl which those
dependencies have been installed to, and with access to any nonstandard library installation locations
(such as local::lib or Carton).
Since CGI scripts run in the CGI server's environment, which is usually different from your user's
environment, this means that:
• The CGI script shebang should be an absolute path to the appropriate perl executable.
#!/usr/bin/perl
#!/opt/perl/bin/perl
#!/home/youruser/perl5/perlbrew/perls/perl-5.34.0/bin/perl
• Nonstandard library locations where dependencies are installed must either be added to the "PERL5LIB"
environment variable in the CGI server's environment, or added within the CGI script such as with lib
or lib::relative.
# Apache
SetEnv PERL5LIB /home/youruser/perl5/lib/perl5
# Within CGI script
use lib '/home/youruser/perl5/lib/perl5';
# Relative to CGI script
use lib::relative 'local/lib/perl5';
Fatpacking
App::FatPacker can be used to pack CGI::Tiny, as well as any other pure-perl dependencies, into a CGI
script so that it can be deployed to other systems without having to install the dependencies there. As a
bonus, this means the script doesn't have to load those modules separately from disk on every execution.
Just keep in mind that the script will have to be repacked to update those dependencies, and CGI scripts
greatly benefit from efficient XS tools which cannot be packed this way.
$ fatpack pack script.source.cgi > script.cgi
To pack in optional modules, such as JSON support for Perls older than 5.14:
$ fatpack trace --use=JSON::PP script.source.cgi
$ fatpack packlists-for $(cat fatpacker.trace) > packlists
$ fatpack tree $(cat packlists)
$ fatpack file script.source.cgi > script.cgi
JSON
CGI::Tiny has built in support for parsing and rendering JSON content with JSON::PP. CGI scripts that
deal with JSON content will greatly benefit from installing Cpanel::JSON::XS version 4.09 or newer for
efficient encoding and decoding, which will be used automatically if available.
Templating
HTML and XML responses are most easily managed with templating. A number of CPAN modules provide this
capability.
Text::Xslate is an efficient template engine designed for HTML/XML with built-in disk caching.
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use CGI::Tiny;
use Text::Xslate;
use Data::Section::Simple 'get_data_section';
cgi {
my $cgi = $_;
# from templates/
my $tx = Text::Xslate->new(path => ['templates']);
# or from __DATA__
my $tx = Text::Xslate->new(path => [get_data_section]);
my $foo = $cgi->query_param('foo');
$cgi->render(html => $tx->render('index.tx', {foo => $foo}));
};
__DATA__
@@ index.tx
<html><body><h1><: $foo :></h1></body></html>
Mojo::Template is a lightweight HTML/XML template engine in the Mojo toolkit.
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use CGI::Tiny;
use Mojo::Template;
use Mojo::File 'curfile';
use Mojo::Loader 'data_section';
cgi {
my $cgi = $_;
my $mt = Mojo::Template->new(auto_escape => 1, vars => 1);
my $foo = $cgi->query_param('foo');
# from templates/
my $template_path = curfile->sibling('templates', 'index.html.ep');
my $output = $mt->render_file($template_path, {foo => $foo});
# or from __DATA__
my $template = data_section __PACKAGE__, 'index.html.ep';
my $output = $mt->render($template, {foo => $foo});
$cgi->render(html => $output);
};
__DATA__
@@ index.html.ep
<html><body><h1><%= $foo %></h1></body></html>
Files
Modules like Path::Tiny and MIME::Types can help with file responses. Be aware that Perl and some
operating systems work with filenames in encoded bytes (usually UTF-8), but this module works with
parameters in Unicode characters, so non-ASCII filenames make things trickier.
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use CGI::Tiny;
use Path::Tiny;
use MIME::Types;
use Unicode::UTF8 qw(encode_utf8 decode_utf8);
cgi {
my $cgi = $_;
my $filename = $cgi->query_param('filename');
unless (length $filename) {
$cgi->set_response_status(404)->render(text => 'Not Found');
exit;
}
# get files from public/ next to cgi-bin/
my $public_dir = path(__FILE__)->realpath->parent->sibling('public');
my $encoded_filename = encode_utf8 $filename;
my $filepath = $public_dir->child($encoded_filename);
# ensure file exists, is readable, and is not a directory
unless (-r $filepath and !-d _) {
$cgi->set_response_status(404)->render(text => 'Not Found');
exit;
}
# ensure file path doesn't escape the public/ directory
unless ($public_dir->subsumes($filepath->realpath)) {
$cgi->set_response_status(404)->render(text => 'Not Found');
exit;
}
my $basename = decode_utf8 $filepath->basename;
my $mime = MIME::Types->new->mimeTypeOf($basename);
$cgi->set_response_type($mime->type) if defined $mime;
$cgi->set_response_disposition(attachment => $basename)->render(file => $filepath);
};
Cookies
Cookie values should only consist of ASCII characters and may not contain any control characters, space
characters, or the characters "",;\". More complex strings can be encoded to UTF-8 and base64 for
transport.
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use CGI::Tiny;
use Unicode::UTF8 qw(decode_utf8 encode_utf8);
use MIME::Base64 qw(decode_base64 encode_base64);
cgi {
my $cgi = $_;
my $value = $cgi->param('cookie_value');
unless (defined $value) {
my $cookie = $cgi->cookie('unicode');
$value = decode_utf8 decode_base64 $cookie if defined $cookie;
}
if (defined $value) {
my $encoded_value = encode_base64 encode_utf8($value), '';
$cgi->add_response_cookie(unicode => $encoded_value, Path => '/');
$cgi->render(text => "Set cookie value: $value");
} else {
$cgi->render(text => "No cookie value set");
}
};
Data structures can be encoded to JSON and base64 for transport.
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use CGI::Tiny;
use Cpanel::JSON::XS qw(decode_json encode_json);
use MIME::Base64 qw(decode_base64 encode_base64);
cgi {
my $cgi = $_;
my $key = $cgi->param('cookie_key');
my $hashref;
if (defined $key) {
$hashref->{$key} = $cgi->param('cookie_value');
} else {
my $cookie = $cgi->cookie('hash');
$hashref = decode_json decode_base64 $cookie if defined $cookie;
$key = (keys %$hashref)[0] if defined $hashref;
}
if (defined $hashref) {
my $encoded_value = encode_base64 encode_json($hashref), '';
$cgi->add_response_cookie(hash => $encoded_value, Path => '/');
$cgi->render(text => "Set cookie hash key $key: $hashref->{$key}");
} else {
$cgi->render(text => "No cookie value set");
}
};
Sessions
Regardless of the session mechanism, login credentials should only be sent over HTTPS, and passwords
should be stored on the server using a secure one-way hash, such as with Crypt::Passphrase.
Basic authentication <https://en.wikipedia.org/wiki/Basic_access_authentication> has historically been
used to provide a simplistic login session mechanism which relies on the client to send the credentials
with every subsequent request in that browser session. However, it does not have a reliable logout or
session expiration mechanism.
Basic authentication can be handled by the CGI server itself (e.g. Apache
<https://httpd.apache.org/docs/2.4/howto/auth.html>), which restricts access to a directory or location
to authenticated users, and passes AUTH_TYPE and REMOTE_USER with the authenticated CGI requests.
If you want to instead handle Basic authentication directly in the CGI script, you may need to configure
the CGI server to forward the "Authorization" header (e.g. Apache
<https://stackoverflow.com/q/17018586/5848200>), as it is commonly stripped from the CGI request.
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use CGI::Tiny;
use MIME::Base64 'decode_base64';
use Unicode::UTF8 'decode_utf8';
sub verify_password { my ($user, $pass) = @_; ... }
cgi {
my $cgi = $_;
my $authed_user;
if (defined(my $auth = $cgi->header('Authorization'))) {
if (my ($hash) = $auth =~ m/^Basic (\S+)/i) {
my ($user, $pass) = split /:/, decode_utf8(decode_base64($hash)), 2;
$authed_user = $user if verify_password($user, $pass);
}
}
unless (defined $authed_user) {
$cgi->add_response_header('WWW-Authenticate' => 'Basic realm="My Website", charset="UTF-8"');
$cgi->set_response_status(401)->render;
exit;
}
$cgi->render(text => "Welcome, $authed_user!");
};
A more sophisticated and modern login session mechanism is to store a session cookie in the client,
associated with a server-side session stored in a file or database. Login credentials only need to be
validated once per session, and subsequently the session ID stored in the cookie will be sent by the
client with each request. This type of session can be ended by expiring the session cookie and
invalidating the session data on the server.
Some HTTP session management modules exist on CPAN, but the author has not yet discovered any that are
suitable for use with CGI::Tiny. In lieu of a generalized mechanism, session data can be stored to and
retrieved from your database of choice manually.
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use CGI::Tiny;
use Text::Xslate;
use Data::Section::Simple 'get_data_section';
sub verify_password { my ($user, $pass) = @_; ... }
sub store_new_session { my ($user) = @_; ... }
sub get_session_user { my ($session_id) = @_; ... }
sub invalidate_session { my ($session_id) = @_; ... }
cgi {
my $cgi = $_;
my $tx = Text::Xslate->new(path => [get_data_section]);
my ($authed_user, $session_id);
if ($cgi->path eq '/login') {
if ($cgi->method eq 'GET' or $cgi->method eq 'HEAD') {
$cgi->render(html => $tx->render('login.tx', {login_failed => 0}));
exit;
} elsif ($cgi->method eq 'POST') {
my $user = $cgi->body_param('login_user');
my $pass = $cgi->body_param('login_pass');
if (verify_password($user, $pass)) {
$session_id = store_new_session($user);
$authed_user = $user;
} else {
$cgi->render(html => $tx->render('login.tx', {login_failed => 1}));
exit;
}
}
} elsif (defined($session_id = $cgi->cookie('myapp_session'))) {
if ($cgi->path eq '/logout') {
invalidate_session($session_id);
# expire session cookie
$cgi->add_response_cookie(myapp_session => $session_id, 'Max-Age' => 0, Path => '/', HttpOnly => 1);
$cgi->render(redirect => $cgi->script_name . '/login');
exit;
} else {
$authed_user = get_session_user($session_id);
}
}
unless (defined $authed_user) {
$cgi->render(redirect => $cgi->script_name . '/login');
exit;
}
# set/refresh session cookie
$cgi->add_response_cookie(myapp_session => $session_id, 'Max-Age' => 3600, Path => '/', HttpOnly => 1);
$cgi->render(text => "Welcome, $authed_user!");
};
__DATA__
@@ login.tx
<html>
<head>
<title>Login</title>
</head>
<body>
<form method="post">
<input type="text" name="login_user" placeholder="Username">
<input type="password" name="login_pass" placeholder="Password">
<button type="submit">Login</button>
</form>
: if $login_failed {
<p>Login failed</p>
: }
</body>
</html>
Logging
CGI scripts can usually log errors directly to STDERR with the "warn" function, and rely on the CGI
server to log them to a file, but you will likely need to encode errors to UTF-8 if you expect them to
contain non-ASCII text.
Minimal loggers like Log::Any can also be used to redirect errors and warnings to a file or other logging
mechanism specific to the CGI script, encode them to bytes automatically, and also log debugging
information when the log level is set to "debug". Just make sure the CGI server has permission to create
and write to the logging target.
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use CGI::Tiny;
use Log::Any;
use Log::Any::Adapter
{category => 'cgi-script'}, # only log our category here
File => '/path/to/log/file.log',
binmode => ':encoding(UTF-8)',
log_level => $ENV{MYCGI_LOG_LEVEL} || 'info';
my $log = Log::Any->get_logger(category => 'cgi-script');
local $SIG{__WARN__} = sub {
my ($warning) = @_;
chomp $warning;
$log->warn($warning);
};
cgi {
my $cgi = $_;
$cgi->set_error_handler(sub {
my ($cgi, $error, $rendered) = @_;
chomp $error;
$log->error($error);
});
# only logged if MYCGI_LOG_LEVEL=debug set in CGI server environment
$log->debugf('Method: %s, Path: %s, Query: %s', $cgi->method, $cgi->path, $cgi->query);
my $number = $cgi->param('number');
die "Excessive number\n" if abs($number) > 1000;
my $doubled = $number * 2;
$cgi->render(text => "Doubled: $doubled");
};
Routing
Web applications use routing to serve multiple types of requests from one application. Routes::Tiny can
be used to organize this with CGI::Tiny, using "REQUEST_METHOD" and "PATH_INFO" (which is the URL path
after the CGI script name).
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use CGI::Tiny;
use Routes::Tiny;
my %dispatch = (
foos => sub {
my ($cgi) = @_;
my $method = $cgi->method;
$cgi->render(text => "$method foos");
},
get_foo => sub {
my ($cgi, $captures) = @_;
my $id = $captures->{id};
$cgi->render(text => "Retrieved foo $id");
},
put_foo => sub {
my ($cgi, $captures) = @_;
my $id = $captures->{id};
$cgi->render(text => "Stored foo $id");
},
);
cgi {
my $cgi = $_;
my $routes = Routes::Tiny->new;
# /script.cgi/foo
$routes->add_route('/foo', name => 'foos');
# /script.cgi/foo/42
$routes->add_route('/foo/:id', method => 'GET', name => 'get_foo');
$routes->add_route('/foo/:id', method => 'PUT', name => 'put_foo');
if (defined(my $match = $routes->match($cgi->path, method => $cgi->method))) {
$dispatch{$match->name}->($cgi, $match->captures);
} else {
$cgi->set_response_status(404)->render(text => 'Not Found');
}
};
AUTHOR
Dan Book <dbook@cpan.org>
COPYRIGHT AND LICENSE
This software is Copyright (c) 2021 by Dan Book.
This is free software, licensed under:
The Artistic License 2.0 (GPL Compatible)
SEE ALSO
CGI::Tiny