File Coverage

blib/lib/Crypt/Simple.pm
Criterion Covered Total %
statement 82 87 94.2
branch 9 14 64.2
condition 2 3 66.6
subroutine 19 20 95.0
pod 0 8 0.0
total 112 132 84.8


line stmt bran cond sub pod time code
1             package Crypt::Simple;
2             $Crypt::Simple::VERSION = '0.06';
3              
4             =head1 NAME
5              
6             Crypt::Simple - encrypt stuff simply
7              
8             =head1 SYNOPSIS
9              
10             use Crypt::Simple;
11            
12             my $data = encrypt(@stuff);
13              
14             my @same_stuff = decrypt($data);
15              
16             =head1 DESCRIPTION
17              
18             Maybe you have a web application and you need to store some session data at the
19             client side (in a cookie or hidden form fields) but you don't want the user to
20             be able to mess with the data. Maybe you want to save secret information to a
21             text file. Maybe you have better ideas of what to do with encrypted stuff!
22              
23             This little module will convert all your data into nice base64 text that you
24             can save in a text file, send in an email, store in a cookie or web page, or
25             bounce around the Net. The data you encrypt can be as simple or as complicated
26             as you like.
27              
28             =head1 KEY
29              
30             If you don't pass any options when using C we will generate a key
31             for you based on the name of your module that uses this one. In many cases this
32             works fine, but you may want more control over the key. Here's how:
33              
34             =over 4
35              
36             =item use Crypt::Simple passphrase => 'pass phrase';
37              
38             The MD5 hash of the text string "pass phrase" is used as the key.
39              
40             =item use Crypt::Simple prompt => 'Please type the magic words';
41              
42             The user is prompted to enter a passphrase, and the MD5 hash of the entered text
43             is used as the key.
44              
45             =item use Crypt::Simple passfile => '/home/marty/secret';
46              
47             The contents of the file /home/marty/secret are used as the pass phrase: the MD5
48             hash of the file is used as the key.
49              
50             =item use Crypt::Simple file => '/home/marty/noise';
51              
52             The contents of the file /home/marty/noise are directly used as the key.
53              
54             =back
55              
56             =head1 INTERNALS
57              
58             C is really just a wrapper round a few other useful Perl
59             modules: you may want to read the documentation for these modules too.
60              
61             We use C to squish all your data into a concise textual
62             representation. We use C to compress this string, and then use
63             C in a home-brew CBC mode to perform the encryption.
64             Somewhere in this process we also add a MD5 digest (using C).
65             Then we throw the whole thing through C to produce a nice bit of
66             text for you to play with.
67              
68             Decryption, obviously, is the reverse of this process.
69              
70             =head1 WARNING
71              
72             Governments throughout the world do not like encryption because it makes it
73             difficult for them to look at all your stuff. Each country has a different
74             policy designed to stop you using encryption: some governments are honest enough
75             to make it illegal; some think it is a dangerous weapon; some insist that you
76             are free to encrypt, but only evil people would want to; some make confusing and
77             contradictory laws because they try to do all of the above.
78              
79             Although this modules itself does not include any encryption code, it does use
80             another module that contains encryption code, and this documentation mentions
81             encryption. Downloading, using, or reading this modules could be illegal where
82             you live.
83              
84             =head1 AUTHOR
85              
86             Marty Pauley Emarty@kasei.comE
87              
88             =head1 COPYRIGHT
89              
90             Copyright (C) 2001 Kasei Limited
91              
92             This program is free software; you can redistribute it and/or modify it under
93             the terms of the GNU General Public License; either version 2 of the License,
94             or (at your option) any later version.
95              
96             This program is distributed in the hope that it will be useful, but WITHOUT
97             ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
98             FOR A PARTICULAR PURPOSE.
99              
100             =cut
101              
102 6     6   34041 use strict;
  6         17  
  6         234  
103 6     6   33 use Carp;
  6         13  
  6         429  
104 6     6   5536 use Crypt::Blowfish;
  6         7291  
  6         288  
105 6     6   9237 use Compress::Zlib;
  6         590239  
  6         1860  
106 6     6   10682 use MIME::Base64;
  6         5378  
  6         446  
107 6     6   49 use Digest::MD5 qw(md5);
  6         13  
  6         404  
108 6     6   5821 use FreezeThaw qw(freeze thaw);
  6         32397  
  6         1085  
109              
110 27     27   5865 sub _chunk($) { $_[0] =~ /.{1,8}/ogs }
111              
112             sub import {
113 12     12   1883 my ($class, @args) = @_;
114 12         51 my $caller = caller;
115 12   66     39 my $key = $class->get_key_param(@args)
116             || $class->get_key_default($caller);
117 12         93 my $cipher = Crypt::Blowfish->new($key);
118              
119 6     6   51 no strict 'refs';
  6         14  
  6         5774  
120 12         78 *{"${caller}::encrypt"} = sub {
121 14     14   3719 my $data = freeze(@_);
122 14         902 my $sig = md5($data);
123 14         29 my $b0 = pack('NN', 0, 0);
124 14         22 my $ct = '';
125 14         84 foreach my $block (_chunk($sig.compress($data))) {
126 95         919 $ct .= $b0 = $cipher->encrypt($b0 ^ $block);
127             }
128 14         223 return encode_base64($ct, '');
129 12         1018 };
130 12         42 *{"${caller}::decrypt"} = sub {
131 13     13   3431 my $data = decode_base64($_[0]);
132 13         40 my ($sig1, $sig2, @blocks) = _chunk($data);
133 13         55 my $b0 = pack('NN', 0, 0);
134 13         81 my $sig = $b0 ^ $cipher->decrypt($sig1);
135 13         135 $b0 = $sig1;
136 13         95 $sig .= $b0 ^ $cipher->decrypt($sig2);
137 12         102 $b0 = $sig2;
138 12         21 my $pt = '';
139 12         25 foreach my $block (@blocks) {
140 55         148 $pt .= $b0 ^ $cipher->decrypt($block);
141 55         405 $b0 = $block;
142             }
143 12         61 my $result = uncompress($pt);
144 12 50       1008 croak "message digest incorrect" unless $sig eq md5($result);
145 12         51 my @data = thaw($result);
146 12 100       1081 return wantarray ? @data : $data[0];
147 12         59 };
148              
149 12         6674 1;
150             }
151              
152             sub get_key_param {
153 12     12 0 23 my ($class, @p) = @_;
154 12 50       51 return md5($p[0]) if @p == 1;
155 12         33 my %p = @p;
156 12         24 my $key = '';
157 12         38 foreach my $k ($class->get_key_methods) {
158 30 100       83 next unless exists $p{$k};
159 9 50       87 if (my $m = $class->can("key_from_$k")) {
160 9         24 $key = $class->$m($p{$k});
161 9 50       30 last if $key;
162             }
163             }
164 12         67 return $key;
165             }
166              
167             sub get_key_default {
168 3     3 0 7 my ($class, $c) = @_;
169 3         33 return md5("$class,$c");
170             }
171              
172 12     12 0 47 sub get_key_methods { qw{passphrase passfile file prompt} }
173              
174             sub key_from_passphrase {
175 6     6 0 11 my ($class, $pass) = @_;
176 6         43 return md5($pass);
177             }
178              
179             sub read_file_contents {
180 6     6 0 9 my ($class, $file) = @_;
181 6 50       252 open my $io, $file or croak "cannot open $file: $!";
182 6         22 local $/;
183 6         148 my $data = <$io>;
184 6         69 close $io;
185 6         43 return $data;
186             }
187              
188             sub key_from_passfile {
189 3     3 0 5 my ($class, $file) = @_;
190 3         9 my $pass = $class->read_file_contents($file);
191 3         14 return $class->key_from_passphrase($pass);
192             }
193              
194             sub key_from_file {
195 3     3 0 5 my ($class, $file) = @_;
196 3         8 return $class->read_file_contents($file);
197             }
198              
199             sub key_from_prompt {
200 0     0 0   my ($class, $prompt) = @_;
201 0           print STDERR "$prompt: ";
202 0           my $pass = ;
203 0           chomp $pass;
204 0           return $class->key_from_passphrase($pass);
205             }
206              
207             1;