view release on metacpan or  search on metacpan

lib/CGI/Tiny/Cookbook.pod  view on Meta::CPAN

  #!/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;
    }