File Coverage

lib/App/Session/HTMLHidden.pm

Criterion	Covered	Total	%
statement	47	120	39.1
branch	12	54	22.2
condition	0	6	0.0
subroutine	9	10	90.0
pod	2	2	100.0
total	70	192	36.4

#############################################################################
## $Id: HTMLHidden.pm 13887 2010-04-06 13:36:42Z spadkins $
#############################################################################

package App::Session::HTMLHidden;
$VERSION = (q$Revision: 13887 $ =~ /(\d[\d\.]*)/)[0];  # VERSION numbers generated by svn

use App;
use App::Session;
@ISA = ( "App::Session" );

use strict;

use Data::Dumper;
use Storable qw(freeze thaw);
use Compress::Zlib;
use MIME::Base64;

# note: We may want to apply an HMAC (hashed message authentication code)
#       so that users cannot fiddle with the values.
#       We may also want to add IP address and timeout for security.
#       We may also want to add encryption so they can't even decode the data.
# use Digest::HMAC_MD5;
# use Crypt::CBC;

=head1 NAME

App::Session::HTMLHidden - a session whose state is maintained across
HTML requests by being embedded in an HTML  tag.

=head1 SYNOPSIS

   # ... official way to get a Session object ...
   use App;
   $session = App->session();
   $session = $session->session();   # get the session

   # any of the following named parameters may be specified
   $session = $session->session(
   );

   # ... alternative way (used internally) ...
   use App::Session::HTMLHidden;
   $session = App::Session->new();

=cut

#############################################################################
# CONSTANTS
#############################################################################

=head1 DESCRIPTION

A Session class models the sequence of events associated with a
use of the system.  These events may occur in different processes.
Yet the accumulated state of the session needs to be propagated from
one process to the next.

This Session::HTMLHidden maintains its state across
HTML requests by being embedded in an HTML  tag.
As a result, it requires no server-side storage, so the sessions
never need to time out.

=cut

#############################################################################
# CONSTRUCTOR METHODS
#############################################################################

=head1 Constructor Methods:

=cut

#############################################################################
# new()
#############################################################################

=head2 new()

The constructor is inherited from
L|App::Service/"new()">.

=cut

#############################################################################
# PUBLIC METHODS
#############################################################################

=head1 Public Methods:

=cut

#############################################################################
# get_session_id()
#############################################################################

=head2 get_session_id()

The get_session_id() returns the session_id of this particular session.
This session_id is unique for all time.  If a session_id does not yet
exist, one will be created.  The session_id is only created when first
requested, and not when the session is instantiated.

    * Signature: $session_id = $session->get_session_id();
    * Param:  void
    * Return: $session_id      string
    * Throws:
    * Since:  0.01

    Sample Usage:

    $session->get_session_id();

=cut

my $seq = 0;

sub get_session_id {
    &App::sub_entry if ($App::trace);
    my $self = shift;
    my $session_id = "embedded";
    &App::sub_exit($session_id) if ($App::trace);
    return($session_id);
}

#############################################################################
# html()
#############################################################################

=head2 html()

The html() method ...

    * Signature: $html = $session->html();
    * Param:  void
    * Return: $html      string
    * Throws:
    * Since:  0.01

    Sample Usage:

    $session->html();

=cut

sub html {
    &App::sub_entry if ($App::trace);
    my ($self) = @_;
    my ($sessiontext, $sessiondata, $html, $options);

    $sessiondata = $self->{store};
    $sessiontext = encode_base64(Compress::Zlib::memGzip(freeze($sessiondata)));

    my ($maxvarsize, $maxvarlines);
    $maxvarlines = 24;
    $maxvarsize = $maxvarlines*77;  # length of a MIME/Base64 line is (76 chars + newline)

    if (length($sessiontext) <= $maxvarsize) {
        $html = "";
    }
    else {
        my (@sessiontext, $i, $startidx, $endidx, $textchunk);
        @sessiontext = split(/\n/,$sessiontext);
        $i = 1;
        $startidx = 0;
        $endidx = $startidx+$maxvarlines-1;
        $textchunk = join("\n",@sessiontext[$startidx .. $endidx]);
        $html = "";
        while ($endidx < $#sessiontext) {
            $i++;
            $startidx += $maxvarlines;
            $endidx = $startidx+$maxvarlines-1;
            $endidx = $#sessiontext if ($endidx > $#sessiontext-1);
            $textchunk = join("\n",@sessiontext[$startidx .. $endidx]);
            $html .= "\n";
        }
    }
    $html .= "\n";

    $options = $self->{context}->options();
    if ($options && $options->{show_session}) {
        # Debugging Only
        my $d = Data::Dumper->new([ $sessiondata ], [ "session_store" ]);
        $d->Indent(1);
        $html .= "\n";
    }

    my $app = $options->{"app"};
    my $cookie_attribs = $options->{"app.Session.cookie_attribs"};
    if ($cookie_attribs) {
        my $cookiedata = {};
        foreach my $cookie_attrib (split(/[ ,;]+/, $cookie_attribs)) {
            if ($cookie_attrib =~ /^([^-]+)-(.+)$/) {
                $cookiedata->{$1}{$2} = $sessiondata->{SessionObject}{$1}{$2};
            }
            elsif ($cookie_attrib) {
                $cookiedata->{default}{$cookie_attrib} =
                    $sessiondata->{SessionObject}{default}{$cookie_attrib};
            }
        }

        my $cgi    = $self->{context}->request()->{cgi};
        my $secure = ($cgi->url() =~ /^https/) ? "; secure" : "";

        my $cookietext = MIME::Base64::encode(Compress::Zlib::memGzip(freeze($cookiedata)));
        $cookietext =~ s/\n//g;  # get rid of newlines (76 char lines)
        my $cookie_options = $options->{"app.Session.cookie_options"} || "$secure";
        my $headers = "Set-Cookie: app_session_${app}_persist=$cookietext$cookie_options\n";
        $self->{context}->set_header($headers);
    }

    &App::sub_exit($html) if ($App::trace);
    $html;
}

#############################################################################
# PROTECTED METHODS
#############################################################################

=head1 Protected Methods:

The following methods are intended to be called by subclasses of the
current class.

=cut

#############################################################################
# _init()
#############################################################################

=head2 _init()

The _init() method is called from within the constructor.

    * Signature: _init($named)
    * Param:     $named        {}    [in]
    * Return:    void
    * Throws:    App::Exception
    * Since:     0.01

    Sample Usage:

    $ref->_init($args);

The _init() method looks at the CGI variables in the request
and restores the session state information from the variable
named "app.sessiondata" (and "app.sessiondata[2..n]").

When the values of these variables are concatenated, they
form a Base64-encoded, gzipped, frozen multi-level hash of
session state data.  To retrieve the state data, the text
is therefore decoded, gunzipped, and thawed (a la Storable).

TODO: encrypt and MAC

=cut

sub _init {
    &App::sub_entry if ($App::trace);
    my ($self, $args) = @_;
    my ($cgi, $sessiontext, $store, $request);

    $self->{context} = $args->{context};
    $store = {};
    $cgi = $args->{cgi} if (defined $args);

    eval {
        $request = $self->{context}->request();
    };
    # ignore it if it fails

    if (!defined $cgi) {
        $cgi = $request->{cgi} if ($request);
    }

    if (defined $cgi) {
        $sessiontext = $cgi->param("app.sessiondata");
        if ($sessiontext) {
            my ($i, $textchunk);
            $i = 2;
            while (1) {
                $textchunk = $cgi->param("app.sessiondata${i}");
                last if (!$textchunk);
                $sessiontext .= $textchunk;
                $i++;
            }
            $store = thaw(Compress::Zlib::memGunzip(decode_base64($sessiontext)));
        }
    }

    if ($request) {
        my $options = $self->{context}{options};
        my $cookie_attribs = $options->{"app.Session.cookie_attribs"};
        if ($cookie_attribs) {
            my $cookiedata = {};

            my $app = $options->{"app"};
            my $cookietext = $cgi->cookie("app_session_${app}_persist");
            if ($cookietext) {
                $cookietext =~ s/ /\+/g;
                my $length = length($cookietext);
                my $pad = 4 - ($length % 4);
                $pad = 0 if ($pad == 4);
                $cookietext .= ("=" x $pad) if ($pad);
                $cookietext =~ s/(.{76})/$1\n/g;
                $cookietext .= "\n";
                #print "Session::Cookie->_init(): sessiontext = [\n$sessiontext\n]\n";
                $cookiedata = thaw(Compress::Zlib::memGunzip(MIME::Base64::decode($cookietext)));
            }

            foreach my $cookie_attrib (split(/[ ,;]+/, $cookie_attribs)) {
                if ($cookie_attrib =~ /^([^-]+)-(.+)$/) {
                    $store->{SessionObject}{$1}{$2} = $cookiedata->{$1}{$2};
                }
                elsif ($cookie_attrib) {
                    $store->{SessionObject}{default}{$cookie_attrib} =
                        $cookiedata->{default}{$cookie_attrib};
                }
            }
        }
    }

    $self->{context} = $args->{context} if (defined $args->{context});
    $self->{store} = $store;
    $self->{cache} = {};
    &App::sub_exit() if ($App::trace);
}

1;