File Coverage

blib/lib/Apache/AppSamurai/Session/Serialize/CryptBase64.pm

Criterion	Covered	Total	%
statement	44	47	93.6
branch	11	22	50.0
condition	2	6	33.3
subroutine	10	10	100.0
pod	0	4	0.0
total	67	89	75.2

# Apache::AppSamurai::Session::Serialize::CryptBase64 - Apache::Session
#                                Serialize module.  Replaces Base64 serializer
#                                with one that uses Crypt::CBC to
#                                encrypt the Base64 encoded and frozen data
#                                before encoding into Base64 for final delivery

# $Id: CryptBase64.pm,v 1.18 2008/04/30 21:40:12 pauldoom Exp $

##
# Copyright (c) 2008 Paul M. Hirsch ([e-mail]).
# All rights reserved.
#
# This program is free software; you can redistribute it and/or modify it under
# the same terms as Perl itself.
##

package Apache::AppSamurai::Session::Serialize::CryptBase64;
use strict;
use warnings;

use Crypt::CBC 2.17;
use MIME::Base64;
use Storable qw(nfreeze thaw);

use vars qw($VERSION);
$VERSION = substr(q$Revision: 1.18 $, 10, -1);

# Set keylength in hex chars (bytes x 2) - This should stay 64 (256bits)
# at least.  Note that the session key generator must have the same
# size output
my $keylength = 64;

# Only listed ciphers are allowed
my @allowedciphers = (
		      'Crypt::OpenSSL::AES',
		      'Crypt::Rijndael',
		      'Crypt::Twofish',
		      'Crypt::Blowfish',
		      );

# A cipher lookup table
my %allowedcl = map { $_ => 1 } @allowedciphers;


sub serialize {
    my $session = shift;

    # Setup crypt engine
    my $c = &setup_crypt($session);

    # Turn off Crypt::CBC automatic salt creation - (Note: This is done to
    # avoid a taint bug related to Crypt::CBC and some cipher modules.
    # Eventually this should be fixed and all salt handling should be done
    # by Crypt::CBC)
    $c->{make_random_salt} = 0;

    # Use existing salt or create one if not set
    unless ($session->{args}->{salt}) {
	$session->{args}->{salt} = $c->random_bytes(8);
    }

    # Check for valid salt and untaint
    ($session->{args}->{salt} =~ /^(.{8})$/s) or die "Invalid salt value (must be 8 bytes)";
    $c->salt($1);

    # Enfruzen!! Enkryptor!!!  Enmimeor!!!  (Crypt it then Base64 encode)
    (my $serialized = encode_base64($c->encrypt(nfreeze($session->{data})),'')) or die "Problem while serializing data: $!";

    $session->{serialized} = $serialized;
}

sub unserialize {
    my $session = shift;
    my $data = '';

    # Setup key and crypt instance
    my $c = &setup_crypt($session);

    # Demimeor! Dekryptor! Unfruzen! (Demime, decrypt, thaw, rock!)
    ($data = thaw($c->decrypt(decode_base64($session->{serialized})))) or die "Problem while unserializing data: $!";

    $session->{data} = $data;

    # Save salt value (value is maintained per session - this does not
    # pass over the hostile network, so I THINK it is not an issue. Comment
    # this code out for a per-write new salt to be generated
    ($session->{args}->{salt} = $c->salt()) or die "Could not retrive salt value for session";

}

# Create symmetric key and create encryption instance
sub setup_crypt {
    my $session = shift;

    # Very basic key checks
    (defined($session->{args}->{ServerKey}) && ($session->{args}->{ServerKey} =~ /^[a-f0-9]{$keylength}$/)) or die "ServerKey not set or invalid for use with this module";
    (defined($session->{args}->{key}) && ($session->{args}->{key} =~ /^[a-f0-9]{$keylength}$/)) or die "Session authentication key not set or invalid for use with this module $session->{args}->{key}";

    # Build the full key by concatenating server and auth key.
    my $k = $session->{args}->{ServerKey} . $session->{args}->{key};

    if (!defined($session->{args}->{SerializeCipher})) {
	# Currently, a pre-configured crypt module is required.
	# find_crypt() could just as easily do it here, but making the
	# extenal code calling this module define it seems more appropriate.
	die "No session SerializeCipher defined!  Configure one of: " . join(',', @allowedciphers);

    # Check passed in cipher against list of supported ciphers.
    # (No, I will not allow you to use Crypt::DES.  So sorry.)
    } elsif (!exists($allowedcl{$session->{args}->{SerializeCipher}})) {
	die "Bad session SerializeCipher defined: \"" . $session->{args}->{SerializeCipher} . "\".  CryptBase64 requires one of: " . join(',', @allowedciphers);
    }

    # Only allow a specific set of
    # Try to setup the encryptor.  (Note - key and block sizes are NOT
    # hardcoded below.  The default IV generator from Crypt::CBC is used.)
    my $c = Crypt::CBC->new(
			    -key => $k,
			    -cipher => $session->{args}->{SerializeCipher},
			    -header => 'salt'
			    );

    ($c) or die "Failed to create CBC encrypt/decrypt instance: $!";

    return $c;
}

# Search through list of allowed ciphers for one present on this system.
# (This should be called once per-run at most per-process. You don't want to be
# module searching on every call!)
sub find_cipher {

    # Search in order, returning the first found
    foreach (@allowedciphers) {
	if (eval "require $_") {
	    return $_;
	}
    }

    # Oh well.... nothing found
    return undef;
}

1; # End of Apache::AppSamurai::Session::Serialize::CryptBase64

__END__