package Crypt::CGIsession;
$Crypt::CGIsession::VERSION = 2.09;
$Crypt::CGIsession::NAME = __PACKAGE__;
=pod
AUTHOR
Tommy Butler <tommy @ atrixnet.com>
phone: (817)-468-7716
6711 Forest Park Dr
Arlington, TX
76001-8403
COPYRIGHT Tommy Butler. All rights reserved
LISCENCE This software is free, use/distribute under the GNU GPL.
BUGS TO Tommy Butler <perlmod @ atrixnet.com>
HISTORY
Version 1.00
+-----------+--------------------------------------------------+
| RELEASED: | Monday, March 4, 2002, 4:58:46 PM |
+-----------+--------------------------------------------------+
| NOTES | |
| | Original release of Crypt::CGIsession.pm |
| | |
| SYNOPSIS | Use CGI; |
| | Use Crypt::CGIsession; |
| | |
| | my($cgi) = CGI->new(); |
| | my($cgisess) = |
| | Crypt::CGIsession->new('cgi' => $cgi, ); |
| | |
| | |
| | # get data from a form |
| | my($want_newsltr) = $cgi->param('wantsnews'); |
| | my($pref_format) = $cgi->param('preffmt'); |
| | my($pref_pmt) = $cgi->param('prefpmt'); |
| | my($name) = $cgi->param('name'); |
| | |
| | # retrieve paramameters from the last script |
| | my($member_or_no) = |
| | $cgisess->session_param('cust_type'); |
| | |
| | # save form data for next script |
| | $cgisess-> |
| | push_params |
| | ( |
| | { |
| | 'customer_type' => $member_or_no, |
| | 'name' => $name, |
| | 'want_newsltr' => $want_newsltr, |
| | 'prefered_fmt' => $pref_format, |
| | 'orderid' => $order_id, |
| | 'pmt_method' => $pref_pmt, |
| | } |
| | ); |
| | |
| | # remove un-needed params |
| | $cgisess-> |
| | delete_params |
| | ( |
| | 'show flash intro', |
| | 'is new visitor', |
| | ); |
| | |
| | # a standard built-in session param |
| | my($page_last_viewed) = |
| | $cgisess->session_param('prev'); |
| | |
| | # another standard built-in session param |
| | my($currently_requested_page) = |
| | $cgisess->session_param('req'); |
| | |
| | # get the current encrypted session string |
| | my($crypted_session_string) = |
| | $cgisess->gimme_crypted_session_string(); |
| | |
| | |
| DEPENDENCIES |
| | |
| | This module has dependecies, namely: |
| | |
| | 1) CGI::Util |
| | This module is part of the core Perl |
| | module library. You should not need to |
| | to install it. If you do, you can down- |
| | load it from the Comprehensive Perl |
| | Archive Network (CPAN) |
| | |
| | The CPAN is located at http://www.cpan.org |
| | |
| | |
| | 2) Your choice of the following: |
| | Crypt::Blowfish |
| | Crypt::Blowfish_PP |
| | Crypt::DES |
| | Crypt::DES_PP |
| | Crypt::IDEA |
| | Crypt::RSA |
| | Crypt::TEA |
| | Crypt::TripleDES |
| | Crypt::Twofish |
| | |
| | ...OR ANY MODULE OF THE Crypt FAMILY WHICH |
| | CAN BE USED WITH Crypt::CBC |
| | |
| | Any of the listed modules could change in |
| | in future versions. This list is only |
| | intended to provide a place to start. |
| | If your Crypt module of choice can be used |
| | from the Crypt::CBC interface it will work |
| | for your code using Crypt::CGIsession.pm |
| | |
| | These modules are not part of the core |
| | Perl module library. You will probably |
| | need to install them. If you do, you can |
| | download them from the Comprehensive Perl |
| | Archive Network (CPAN) |
| | |
| | The CPAN is located at http://www.cpan.org |
| | |
| | |
| | 3) Crypt::CBC |
| | This module is not part of the core Perl |
| | module library. You will probably need |
| | to install it. If you do, you can down- |
| | load it from the Comprehensive Perl |
| | Archive Network (CPAN) |
| | |
| | The CPAN is located at http://www.cpan.org |
| | |
| | |
| | 4) expt_handler |
| | This module is not part of the core Perl |
| | module library because it was written by |
| | me. Because of that, you'll probably need |
| | to install it. If you do, you can down- |
| | load it from Atrixnet Open Source Perl |
| | Archives under category: /modules/ |
| | |
| | The Atrixnet archives are located at |
| | http://www.atrixnet.com/pub/ |
| | |
+-----------+--------------------------------------------------+
=cut
# use strict coding pragma
use strict;
# use encryption modules
use Crypt::CBC;
# use CGI::Util for proper query string encoding/decoding
use CGI::Util;
# use exception handler library
use expt_handler;
# --------------------------------------------------------
# Constructor
# --------------------------------------------------------
sub new {
my($class) = shift(@_);
my($this) = {};
my($name) = __PACKAGE__;
# -------------------------------------------
# bless object ref into the class' namespace
# -------------------------------------------
bless($this, $class);
# -------------------------------------------
# begin setting up class attributes
# -------------------------------------------
my($in) = $this->coerce_array(@_);
$this->{'session_params'} = {};
$this->{'name'} = $name;
$this->{'read_session'} = qr/(?o)%([a-fA-F0-9]{2})/;
$this->{'cgi'} = $$in{'cgi'} || {};
$this->{'push_params'} = $$in{'push_params'} || {};
$this->{'cypher_key'} = $$in{'cypher_key'} || '';
$this->{'cypher'} = $$in{'cypher'} || 'Blowfish';
$this->{'iv'} = $$in{'iv'} || '';
$this->{'exclude-Xelems'} = $$in{'exclude-Xelems'} || '';
$this->{'unescape'} = $$in{'unescape'} || 0;
$this->{'debug'} = $$in{'debug'} || 0;
$this->{'verbose'} = $$in{'verbose'} || 0;
$this->{'sessvar'} = $$in{'sessvar'} || 'session';
# default session duration to 5 min
$this->{'duration'} = $this->to_seconds( $$in{'duration'} ) || 300;
# local debug object
$this->{'stack'} = expt_handler->new();
# -------------------------------------------
# finish by verifying class attributes
# -------------------------------------------
$this->verify_attributes();
$this->init();
# return object reference
return($this);
}
# --------------------------------------------------------
# Crypt::CGIsession::verify_attributes()
# --------------------------------------------------------
sub verify_attributes {
my($this) = shift(@_);
my($name) = $this->{'name'};
my($stack) = $this->{'stack'};
$stack->
quit
(
$this->{'errors'}{'no cgi'}
)
if (not $this->{'cgi'});
$stack->
quit
(
$this->{'errors'}{'no iv'}
)
if (not $this->{'iv'}); $this->{'iv'} =
sprintf( q[%8.8s], $this->{'iv'} );
$stack->
quit
(
$this->{'errors'}{'no cypher'}
)
if (not $this->{'cypher_key'});
return(1);
}
# --------------------------------------------------------
# Crypt::CGIsession::init()
# --------------------------------------------------------
sub init {
my($this) = shift(@_);
my($cgi) = $this->{'cgi'};
my(@uncrypted) = ();
my($delim) = 0;
my($self_ref) = {};
my($session_pairs) = [];
my($new_pair) = [];
my($sess_elements) = {};
my($element) = '';
my($session_qstr) = '';
my($sess_len) = $this->{'duration'}||300;
$this->read_session( $cgi->param($this->{'sessvar'}) );
warn
(
qq[$this->{'name'}::init has been called]
) if $this->{'verbose'};
unless ($this->{'exclude-Xelems'}) {
$sess_elements =
{
'X-req' => $cgi->script_name(),
'X-prevreq' => $this->session_param('X-req') || 'first request',
'X-started' => time(),
'X-elapsed' => time() - ( $this->session_param('X-started')||0 ),
'X-expires' => time() + $sess_len,
};
$$this{'session_status'} = $$sess_elements{'X-elapsed'} < $sess_len;
}
# we only need these values for this session...
$this->delete_params(keys(%{$sess_elements}));
my($uncrypted) = $cgi->param('.') || '';
@uncrypted = split(/\:/, $uncrypted);
foreach (@uncrypted) {
my($name,$value) = split(/\./, $_);
$sess_elements->{ $name } = $value;
}
$this->push_params($sess_elements);
return(1);
}
# --------------------------------------------------------
# Crypt::CGIsession::to_seconds()
# --------------------------------------------------------
sub to_seconds {
my($this) = shift(@_);
my($unit) = shift(@_) || '10 minutes';
my($amt) = 0;
$unit =~ s/(?go)^(?: )+|(?: )+$//;
($amt,$unit) = split(/ /,$unit);
if ($unit =~ /(?o)sec/) {
return($amt);
}
elsif ($unit =~ /(?o)min/) {
# 1 minute = 60 seconds
return($amt * 60);
}
elsif ($unit =~ /(?o)hour/) {
# 1 hour = 60 minutes
# 60 minutes = 3600 seconds
return($amt * 3600);
}
elsif ($unit =~ /(?o)day/) {
# 1 day = 24 hours
# 24 hours = 1440 minutes
# 1440 minutes = 86400 seconds
return($amt * 86400);
}
elsif ($unit =~ /(?o)week/) {
# 1 week = 7.0347222 days
# 7.0347222 days = 168.8333333 hours
# 168.8333333 hours = 10130 minutes
# 10130 minutes = 607800 seconds
return($amt * 607800);
}
elsif ($unit =~ /(?o)year/) {
# 1 year = 365.2425116 days
# 365.2425116 days = 8765.8202778 hours
# 8765.8202778 hours = 525949.2166667 minutes
# 525949.2166667 minutes = 31556953 seconds
return($amt * 31556953);
}
elsif ($unit =~ /(?o)never/) {
return(-2)
}
else { return(-1) }
}
# --------------------------------------------------------
# Crypt::CGIsession::session_status
# --------------------------------------------------------
sub session_status { $_[0]->{'session_status'}||0 }
# --------------------------------------------------------
# Crypt::CGIsession::get_session_qstr()
# --------------------------------------------------------
sub get_session_qstr {
my($this) = shift(@_);
my($argstring) = shift(@_);
return ( $this->crypt_string($argstring) )
if $argstring;
$this->
{'stack'}->
fwarn
(
q[no argstring was passed to get_session_qstr()]
)
if
($this->{'verbose'});
return();
}
# --------------------------------------------------------
# Crypt::CGIsession::gimme_crypted_session_string()
# --------------------------------------------------------
sub gimme_crypted_session_string {
my($this) = shift(@_);
return
(
$this->{'session'}{'crypted session args'}
);
}
# --------------------------------------------------------
# Crypt::CGIsession::gimme_normal_session_string()
# --------------------------------------------------------
sub gimme_normal_session_string {
my($this) = shift(@_);
return
(
$this->{'raw session string'}
);
}
# --------------------------------------------------------
# Crypt::CGIsession::push_params()
# --------------------------------------------------------
sub push_params {
my($this) = shift(@_);
my($params_2_push) = shift || {};
my($session_pairs) = [];
my($session_qstr) = '';
my($i) = 0;
return($this->gimme_crypted_session_string())
if
(scalar(keys(%{$params_2_push})) == 0);
# stick values into the session params hash
foreach (keys(%{$params_2_push})) {
next
if
(
not defined($params_2_push->{$_})
||
length($params_2_push->{$_}) == 0
);
unless (length($params_2_push->{$_}) == 0) {
unshift
(
@{ $this->{'session_params'}{$_} },
$params_2_push->{$_},
);
++$i;
warn(<<__stat__) if $this->{'debug'};
$i name/value pairs pushed... <$_> = <$params_2_push->{$_}>
__stat__
}
}
return($this->gimme_crypted_session_string()) if ($i == 0);
foreach (keys(%{ $this->{'session_params'} })) {
my($param) = $_;
my($values) = $this->{'session_params'}{$_}||'';
foreach (@{$values}) {
next unless defined($_);
next unless (length($_) > 0);
push
(
@{ $session_pairs },
join
(
'=',
($param, $_),
)
);
}
}
# create next crypted session string
$session_qstr =
join
(
';',
@{ $session_pairs },
);
$this->{'raw session string'} = $session_qstr;
my($pushed) = join(qq[\n], keys(%{ $params_2_push }));
$this->
{'stack'}->
fwarn(<<__dbg__) if ($this->{'verbose'});
Session parameters have been updated. Session args which will be passed
to the next script:
$session_qstr
__dbg__
$pushed = join(q[, ], keys(%{ $params_2_push }));
warn(<<__dbg__) if ($this->{'debug'} and not $this->{'verbose'});
new string: $session_qstr
__dbg__
# assign it to the proper package variable for this module
$this->
{'session'}
{'crypted session args'} =
$this->
get_session_qstr
(
$session_qstr
);
return( $this->{'session'}{'crypted session args'} );
}
# --------------------------------------------------------
# Crypt::CGIsession::clear_session()
# --------------------------------------------------------
sub clear_session {
my($this) = shift(@_);
$this->{'session_params'} = {};
$this->{'session'}{'crypted session args'} = '';
return('');
}
# --------------------------------------------------------
# Crypt::CGIsession::delete_params()
# --------------------------------------------------------
sub delete_params {
my($this) = shift(@_);
my($cgi) = $this->{'cgi'};
my($session_pairs) = [];
my($session_qstr) = '';
my(@kill) = @_;
my($i) = 0;
foreach (@_) {
splice(@kill,1,$i)
if
(not defined($_) or length($_) == 0);
++$i;
}
return($this->gimme_crypted_session_string()) if (scalar(@kill) == 0);
foreach (@kill) {
next unless (defined($this->{'session_params'}{$_}));
delete($this->{'session_params'}{$_});
}
foreach (keys(%{ $this->{'session_params'} })) {
my($param) = $_;
my($values) = $this->{'session_params'}{$_}||'';
foreach (@{$values}) {
next unless defined($_);
next unless (length($_) > 0);
push
(
@{ $session_pairs },
join
(
'=',
($param, $_),
)
);
}
}
# create next crypted session string
$session_qstr =
join
(
';',
@{ $session_pairs },
);
$this->{'raw session string'} = $session_qstr;
my($d_leted) = join(qq[\,], @kill);
warn(<<__dbg__) if ($this->{'debug'});
deleted: $d_leted
new string: $session_qstr
__dbg__
# assign it to the proper package variable for this module
$this->
{'session'}
{'crypted session args'} =
$this->
get_session_qstr
( $session_qstr );
return( $this->{'session'}{'crypted session args'} );
}
# --------------------------------------------------------
# Crypt::CGIsession::read_session()
# --------------------------------------------------------
sub read_session {
my($this) = shift(@_);
my($argstring) = shift(@_);
my($cgi) = $this->{'cgi'};
my($session) = $this->{'session'};
my($regex_ref) = $this->{'read_session'};
my($decrypted) = '';
$decrypted = $this->decrypt_string( $argstring ) || '';
my(@pairs) = split(/[;&]/, $decrypted);
warn(<<'__babysit__') if $this->{'debug'};
Reading previous session data...
__babysit__
{ # lets' face it, Perl's warnings suck in places like this.
my($i) = 1;
foreach (@pairs) {
local($^W) = 0; my($dummy) = eval('no warnings;undef($dummy);');
# here's the killer
my($name, $value) = split('=', $_);
$name = '' unless (length($name) > 0);
$value = '' unless (length($value) > 0);
warn(<<__babysit__) if $this->{'debug'};
$i name/value pairs read... <$name> = <$value>
__babysit__
++$i;
unshift(@{ $this->{'session_params'}{$name} }, $value)
unless
(length($value) == 0);
}
}
warn('-'x 25,qq[\n]) if $this->{'debug'};
$this->
{'session'}
{'expires'} = $this->session_param('expires');
$this->
{'session'}
{'start'} = $this->session_param('start');
$this->
{'session'}
{'uid'} = $this->session_param('uid') || 'unidentified';
$this->{'decrypted session args'} = $decrypted;
$this->
{'stack'}->
fwarn
(
qq[Newly decrypted session args: $decrypted]
)
if ($this->{'debug'} and $this->{'verbose'});
return( $decrypted );
}
# --------------------------------------------------------
# Crypt::CGIsession::crypt_string()
# --------------------------------------------------------
sub crypt_string {
my($this) = shift(@_);
my($argstring) = shift(@_);
my($cgi) = $this->{'cgi'};
my($cypher_key) = $this->{'cypher_key'};
my($newline) = qq[\n];
my($transliterate) = 0;
my($delim) = 0;
my($crypted) = 0;
my($cipher) =
Crypt::CBC->
new
(
{
'cipher' => $this->{'cypher'},
'key' => $this->{'cypher_key'},
'iv' => $this->{'iv'},
'padding' => 'space',
'regenerate_key' => 1,
'prepend_iv' => 0,
}
);
$crypted = $cipher->encrypt($argstring);
$crypted =~ s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x", ord($1))/eg;
return ( $crypted );
}
# --------------------------------------------------------
# Crypt::CGIsession::decrypt_string()
# --------------------------------------------------------
sub decrypt_string {
my($this) = shift(@_);
my($argstring) = shift(@_) || '';
my($cgi) = $this->{'cgi'};
my($session) = $this->{'session'};
my($cypher_key) = $this->{'cypher_key'};
my($regex_ref) = $this->{'read_session'};
my($newline) = qq[\n];
my($transliterate) = 0;
my($delim) = 0;
my($decrypted) = '';
return(undef) if (length($argstring) == 0);
my($cipher) =
Crypt::CBC->
new
(
{
'cipher' => $this->{'cypher'},
'key' => $this->{'cypher_key'},
'iv' => $this->{'iv'},
'padding' => 'space',
'regenerate_key' => 1,
'prepend_iv' => 0,
}
);
if ($this->{'unescape'} || $ENV{'REQUEST_METHOD'} =~ /POST/i) {
$argstring = CGI::Util::unescape($argstring);
}
$decrypted = $cipher->decrypt($argstring);
return( $decrypted );
}
# --------------------------------------------------------
# Crypt::CGIsession::session_param()
# --------------------------------------------------------
sub session_param {
my($this) = shift(@_);
my($cgi) = $this->{'cgi'};
my($lookup) = shift(@_);
return(undef)
unless exists $this->{'session_params'};
return($this->{'session_params'})
unless defined $lookup;
if (exists $this->{'session_params'}{ $lookup }) {
return (wantarray()) ? @{ $this->{'session_params'}{ $lookup } }
: $this->{'session_params'}{ $lookup }[0];
}
return(undef);
};
# --------------------------------------------------------
# Crypt::CGIsession::coerce_array()
# --------------------------------------------------------
sub coerce_array {
my($this) = shift(@_);
my($hashref) = {};
my($i) = 0;
my(@shadow) = @_;
while (@shadow) {
my($name,$val) = splice(@shadow,0,2);
if (defined($name)) {
$hashref->{$name} = (defined($val)) ? $val : '';
}
else {
$hashref->{qq[un-named key no. $i]} = (defined($val)) ? $val : '';
}
}
return($hashref);
}
# --------------------------------------------------------
# Crypt::CGIsession::DESTROY()
# --------------------------------------------------------
sub DESTROY { } sub AUTOLOAD { }
# --------------------------------------------------------
# $Crypt::CGIsession::errors -(an anonymous HASH)
# --------------------------------------------------------
$Crypt::CGIsession::errors = {};
$Crypt::CGIsession::errors =
{
'no cgi' => <<__nocgi__,
$Crypt::CGIsession::NAME needs a reference to a CGI object. (CGI.pm)
Refer to the documentation at the top of this module for a usage
example where a $Crypt::CGIsession::NAME object is created and a
CGI object reference is passed to it.
__nocgi__
'no iv' => <<__noiv__,
An initialization value must be specified by passing in a key of
'iv' as an option to Crypt::CGIsession::NAME::new() It can be
be any series of 8 characters.
Refer to the documentation at the top of this module for a usage
example where a $Crypt::CGIsession::NAME object is created and an
initialization value, or "iv" is passed to it.
__noiv__
'no cypher' => <<__nocypher__,
A encryption/decryption key must be specified by passing in a key of
'cypher_key' as an option to Crypt::CGIsession::NAME::new() It can
be any series of characters of any length.
Refer to the documentation at the top of this module for a usage
example where a $Crypt::CGIsession::NAME object is created and a
encryption/decryption key, or "cypher_key" is passed to it.
__nocypher__
};
# --------------------------------------------------------
# end Crypt::CGIsession Class, return true on import
# --------------------------------------------------------
1;