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


line stmt bran cond sub pod time code
1             # Apache::AppSamurai::Session::Serialize::CryptBase64 - Apache::Session
2             # Serialize module. Replaces Base64 serializer
3             # with one that uses Crypt::CBC to
4             # encrypt the Base64 encoded and frozen data
5             # before encoding into Base64 for final delivery
6              
7             # $Id: CryptBase64.pm,v 1.18 2008/04/30 21:40:12 pauldoom Exp $
8              
9             ##
10             # Copyright (c) 2008 Paul M. Hirsch (paul@voltagenoir.org).
11             # All rights reserved.
12             #
13             # This program is free software; you can redistribute it and/or modify it under
14             # the same terms as Perl itself.
15             ##
16              
17             package Apache::AppSamurai::Session::Serialize::CryptBase64;
18 1     1   25381 use strict;
  1         2  
  1         34  
19 1     1   5 use warnings;
  1         3  
  1         28  
20              
21 1     1   1058 use Crypt::CBC 2.17;
  1         7323  
  1         35  
22 1     1   1223 use MIME::Base64;
  1         1060  
  1         97  
23 1     1   7144 use Storable qw(nfreeze thaw);
  1         10935  
  1         221  
24              
25 1     1   16 use vars qw($VERSION);
  1         3  
  1         1452  
26             $VERSION = substr(q$Revision: 1.18 $, 10, -1);
27              
28             # Set keylength in hex chars (bytes x 2) - This should stay 64 (256bits)
29             # at least. Note that the session key generator must have the same
30             # size output
31             my $keylength = 64;
32              
33             # Only listed ciphers are allowed
34             my @allowedciphers = (
35             'Crypt::OpenSSL::AES',
36             'Crypt::Rijndael',
37             'Crypt::Twofish',
38             'Crypt::Blowfish',
39             );
40              
41             # A cipher lookup table
42             my %allowedcl = map { $_ => 1 } @allowedciphers;
43              
44              
45             sub serialize {
46 1     1 0 212 my $session = shift;
47            
48             # Setup crypt engine
49 1         6 my $c = &setup_crypt($session);
50            
51             # Turn off Crypt::CBC automatic salt creation - (Note: This is done to
52             # avoid a taint bug related to Crypt::CBC and some cipher modules.
53             # Eventually this should be fixed and all salt handling should be done
54             # by Crypt::CBC)
55 1         3 $c->{make_random_salt} = 0;
56            
57             # Use existing salt or create one if not set
58 1 50       8 unless ($session->{args}->{salt}) {
59 1         7 $session->{args}->{salt} = $c->random_bytes(8);
60             }
61            
62             # Check for valid salt and untaint
63 1 50       1534 ($session->{args}->{salt} =~ /^(.{8})$/s) or die "Invalid salt value (must be 8 bytes)";
64 1         9 $c->salt($1);
65            
66             # Enfruzen!! Enkryptor!!! Enmimeor!!! (Crypt it then Base64 encode)
67 1 50       16 (my $serialized = encode_base64($c->encrypt(nfreeze($session->{data})),'')) or die "Problem while serializing data: $!";
68            
69 1         1680 $session->{serialized} = $serialized;
70             }
71              
72             sub unserialize {
73 1     1 0 3 my $session = shift;
74 1         3 my $data = '';
75            
76             # Setup key and crypt instance
77 1         5 my $c = &setup_crypt($session);
78            
79             # Demimeor! Dekryptor! Unfruzen! (Demime, decrypt, thaw, rock!)
80 1 50       11 ($data = thaw($c->decrypt(decode_base64($session->{serialized})))) or die "Problem while unserializing data: $!";
81            
82 1         334 $session->{data} = $data;
83            
84             # Save salt value (value is maintained per session - this does not
85             # pass over the hostile network, so I THINK it is not an issue. Comment
86             # this code out for a per-write new salt to be generated
87 1 50       7 ($session->{args}->{salt} = $c->salt()) or die "Could not retrive salt value for session";
88            
89             }
90              
91             # Create symmetric key and create encryption instance
92             sub setup_crypt {
93 2     2 0 5 my $session = shift;
94            
95             # Very basic key checks
96 2 50 33     79 (defined($session->{args}->{ServerKey}) && ($session->{args}->{ServerKey} =~ /^[a-f0-9]{$keylength}$/)) or die "ServerKey not set or invalid for use with this module";
97 2 50 33     130 (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}";
98            
99             # Build the full key by concatenating server and auth key.
100 2         11 my $k = $session->{args}->{ServerKey} . $session->{args}->{key};
101            
102 2 50       17 if (!defined($session->{args}->{SerializeCipher})) {
    50          
103             # Currently, a pre-configured crypt module is required.
104             # find_crypt() could just as easily do it here, but making the
105             # extenal code calling this module define it seems more appropriate.
106 0         0 die "No session SerializeCipher defined! Configure one of: " . join(',', @allowedciphers);
107              
108             # Check passed in cipher against list of supported ciphers.
109             # (No, I will not allow you to use Crypt::DES. So sorry.)
110             } elsif (!exists($allowedcl{$session->{args}->{SerializeCipher}})) {
111 0         0 die "Bad session SerializeCipher defined: \"" . $session->{args}->{SerializeCipher} . "\". CryptBase64 requires one of: " . join(',', @allowedciphers);
112             }
113            
114             # Only allow a specific set of
115             # Try to setup the encryptor. (Note - key and block sizes are NOT
116             # hardcoded below. The default IV generator from Crypt::CBC is used.)
117 2         24 my $c = Crypt::CBC->new(
118             -key => $k,
119             -cipher => $session->{args}->{SerializeCipher},
120             -header => 'salt'
121             );
122            
123 2 50       349 ($c) or die "Failed to create CBC encrypt/decrypt instance: $!";
124            
125 2         8 return $c;
126             }
127              
128             # Search through list of allowed ciphers for one present on this system.
129             # (This should be called once per-run at most per-process. You don't want to be
130             # module searching on every call!)
131             sub find_cipher {
132            
133             # Search in order, returning the first found
134 1     1 0 259 foreach (@allowedciphers) {
135 1 50       136 if (eval "require $_") {
136 1         2802 return $_;
137             }
138             }
139              
140             # Oh well.... nothing found
141 0           return undef;
142             }
143              
144             1; # End of Apache::AppSamurai::Session::Serialize::CryptBase64
145              
146             __END__