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__ |