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 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), 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), 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 is free software, licensed under:

The Artistic License 2.0 (GPL Compatible)

	Global
`s`	Focus search bar
`?`	Bring up this help dialog

	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)

	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse

	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)