File: Cookbook.pod

package info (click to toggle)
libcgi-tiny-perl 1.003-1
links: PTS, VCS
area: main
in suites: forky, sid, trixie
size: 516 kB
sloc: perl: 1,307; makefile: 2
file content (516 lines) | stat: -rw-r--r-- 15,397 bytes
=pod

=encoding UTF-8

=head1 NAME

CGI::Tiny::Cookbook - Recipes for advanced CGI::Tiny usage

=head1 DESCRIPTION

L<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.

=head1 RECIPES

=head2 Dependencies

CGI scripts which have dependencies, including CGI::Tiny itself, must be run
using the F<perl> which those dependencies have been installed to, and with
access to any nonstandard library installation locations (such as L<local::lib>
or L<Carton>).

Since CGI scripts run in the CGI server's environment, which is usually
different from your user's environment, this means that:

=over

=item *

The CGI script shebang should be an absolute path to the appropriate F<perl>
executable.

  #!/usr/bin/perl

  #!/opt/perl/bin/perl

  #!/home/youruser/perl5/perlbrew/perls/perl-5.34.0/bin/perl

=item *

Nonstandard library locations where dependencies are installed must either be
added to the C<PERL5LIB> environment variable in the CGI server's environment,
or added within the CGI script such as with L<lib> or L<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';

=back

=head2 Fatpacking

L<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

=head2 JSON

CGI::Tiny has built in support for parsing and rendering JSON content with
L<JSON::PP>. CGI scripts that deal with JSON content will greatly benefit from
installing L<Cpanel::JSON::XS> version C<4.09> or newer for efficient encoding
and decoding, which will be used automatically if available.

=head2 Templating

HTML and XML responses are most easily managed with templating. A number of
CPAN modules provide this capability.

L<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>

L<Mojo::Template> is a lightweight HTML/XML template engine in the L<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>

=head2 Files

Modules like L<Path::Tiny> and L<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);
  };

=head2 Cookies

Cookie values should only consist of ASCII characters and may not contain any
control characters, space characters, or the characters C<",;\>. More complex
strings can be encoded to UTF-8 and L<base64|MIME::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");
    }
  };

=head2 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 L<Crypt::Passphrase>.

L<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.
L<Apache|https://httpd.apache.org/docs/2.4/howto/auth.html>), which restricts
access to a directory or location to authenticated users, and passes
L<AUTH_TYPE|CGI::Tiny/"auth_type"> and L<REMOTE_USER|CGI::Tiny/"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 C<Authorization> header
(e.g. L<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>

=head2 Logging

CGI scripts can usually log errors directly to STDERR with the C<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 L<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 C<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");
  };

=head2 Routing

Web applications use routing to serve multiple types of requests from one
application. L<Routes::Tiny> can be used to organize this with CGI::Tiny, using
C<REQUEST_METHOD> and C<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');
    }
  };

=head1 AUTHOR

Dan Book <dbook@cpan.org>

=head1 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)

=head1 SEE ALSO

L<CGI::Tiny>