view release on metacpan or  search on metacpan

SecureState.pm  view on Meta::CPAN

{
    my ($self, $buffer) = @_;
    my ($cipher, $statefile) = @$self{'.cipher','.statefile'};
    my ($length, $time, $block);
    $time=pack("N",time());

    # Open the target file and die with warnings if necessary
    my $open_flags = $buffer ? (O_WRONLY | O_TRUNC | O_CREAT) : (O_RDWR | O_CREAT);
    if ($AVOID_SYMLINKS && -l $statefile) { $self->errormsg('symlink encountered') }
    sysopen(STATEFILE, $statefile, $open_flags, 0600 ) or $self->errormsg('failed to open the state file');
    if ($USE_FLOCK && !flock(STATEFILE, LOCK_EX)) { $self->errormsg('failed to lock the state file') }
    binmode STATEFILE;

    #if we've got nothing to write, only update the timestamp
    unless ($buffer) {
	if (sysread(STATEFILE,$buffer,16)==16) {
	    #the length of the encrypted data is stored in the first four bytes of the state file
	    $length=substr($cipher->decrypt(substr($buffer,0,8)),0,4);
	    $buffer=$length.($time^substr($buffer,12,4));
	} else {
	    $length=pack("N",0);
	    $buffer=$length.$time;
	}
	sysseek(STATEFILE,0,$SEEK_SET);
	syswrite(STATEFILE,$cipher->encrypt($buffer));
    }
    else {
	#add metadata to the beginning of the plaintext
	$length=length($buffer);
	$buffer=pack("N",$length).$time.$buffer;

	#pad the buffer to have a length that is divisible by 8
	if ($length%=8) {
	    $length=8-$length;
	    $buffer.=chr(int(rand(256))) while ($length--);
	}

	#encrypt in reverse-CBC mode
	$block=$cipher->encrypt(substr($buffer,-8,8));
	substr($buffer,-8,8,$block);

	$length=length($buffer) - 8;
	while(($length-=8)>-8) {
	    $block^=substr($buffer,$length,8);
	    $block=$cipher->encrypt($block);
	    substr($buffer,$length,8,$block);
	}

	#blast it to the file
	syswrite(STATEFILE,$buffer);
    }
    if ($USE_FLOCK) { flock(STATEFILE, LOCK_UN) || $self->errormsg('failed to unlock the state file') }
    close(STATEFILE) || $self->errormsg('failed to close the state file');
}


sub decipher
{
    my $self = shift;
    my ($cipher,$statefile) = @$self{'.cipher','.statefile'};
    my ($length,$extra,$decoded,$buffer,$block);

    if ($AVOID_SYMLINKS) { -l $statefile and $self->errormsg('symlink encountered')}
    sysopen(STATEFILE,$statefile, O_RDONLY) || $self->errormsg('failed to open the state file');
    if ($USE_FLOCK) { flock(STATEFILE, LOCK_SH) || $self->errormsg('failed to lock the state file') }
    binmode STATEFILE;

    #read metadata
    sysread(STATEFILE,$block,8);
    $block = $cipher->decrypt($block);

    #if there is nothing in the file, only set the age; otherwise read the contents
    unless (sysread(STATEFILE,$buffer,8)==8) {
	$self->{'.age'} = unpack("N",substr($block,4,4));
	$buffer = "";
    } else {
	#parse metadata
	$block^=$buffer;
	$self->{'.age'} = unpack("N",substr($block,4,4));
	$length = unpack("N",substr($block,0,4));
	$extra = ($length % 8) ? (8-($length % 8)) : 0;
	$decoded=-8;

	#sanity check
	if ((stat(STATEFILE))[7] != ($length+$extra+8))
	{ $self->errormsg('invalid state file') }

	#read the rest of the file
	sysseek(STATEFILE, 8, $SEEK_SET);
	unless (sysread(STATEFILE,$buffer,$length+$extra) == ($length+$extra))
	{ $self->errormsg('invalid state file') }

	my $next_block;
	$block = $cipher->decrypt(substr($buffer,0,8));
	#decrypt it
	while (($decoded+=8)<$length-8) {
	    $next_block = substr($buffer,$decoded+8,8);
	    $block^=$next_block;
	    substr($buffer, $decoded, 8, $block);
	    $block=$cipher->decrypt($next_block);
	}
	substr($buffer, $decoded, 8, $block);
	substr($buffer, -$extra, $extra, "");

    }
    if ($USE_FLOCK) { flock(STATEFILE, LOCK_UN) || $self->errormsg('failed to unlock the state file') }
    close(STATEFILE) || $self->errormsg('failed to close the state file');

    return($buffer);
}
END_OF_FUNCTIONS
    ;
eval(($]<5.006) ? $subs : "use bytes; $subs");
}

"True Value";

=head1 NAME

CGI::SecureState -- Transparent, secure statefulness for CGI programs

=head1 SYNOPSIS

    use CGI::SecureState;

    my @memory = qw(param1 param2 other_params_to_remember);
    my $cgi = new CGI::SecureState(-stateDir => "states",
                                   -mindSet => 'forgetful',
                                   -memory => \@memory);

    print $cgi->header(), $cgi->start_html;
    my $url = $cgi->state_url();
    my $param = $cgi->state_param();
    print "<a href=\"$url\">I am a stateful CGI session.</a>";
    print "<a href=\"other_url.pl?$param\">I am a different ",
          "script that also has access to this session.</a>";


=head2 Very Important Note for Users of CGI::SecureState 0.2x

For those still using the 0.2x series, CGI::SecureState changed enormously between
0.26 and 0.30.  Specifically, the addition of mindsets is so important that if you
run your old scripts unchanged under CGI::SecureState 0.3x, you will receive nasty
warnings (likely both in output web pages and your log files) that will tell you not
to do so.  Please do yourself a favor by re-reading this documentation, as this
mysterious mindset business (as well as all the scrumptious new features) will be
made clear.

Of course, any and all comments on the changes are welcome.  If you are interested,
send mail to behroozi@cpan.org with the subject "CGI::SecureState Comment".


=head1 DESCRIPTION

A Better Solution to the stateless problem.

HTTP is by nature a stateless protocol; as soon as the requested object is
delivered, HTTP severs the object's connection to the client.  HTTP retains no 
memory of the request details and does not relate subsequent requests with what
it has already served.

There are a few methods available to deal with this problem, including forms