File: Simple.pm

package info (click to toggle)
libcrypt-simple-perl 0.06-7
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 88 kB
  • sloc: perl: 224; makefile: 2
file content (207 lines) | stat: -rw-r--r-- 5,752 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
package Crypt::Simple;
$Crypt::Simple::VERSION = '0.06';

=head1 NAME

Crypt::Simple - encrypt stuff simply

=head1 SYNOPSIS

  use Crypt::Simple;
  
  my $data = encrypt(@stuff);

  my @same_stuff = decrypt($data);

=head1 DESCRIPTION

Maybe you have a web application and you need to store some session data at the
client side (in a cookie or hidden form fields) but you don't want the user to
be able to mess with the data.  Maybe you want to save secret information to a
text file.  Maybe you have better ideas of what to do with encrypted stuff!

This little module will convert all your data into nice base64 text that you
can save in a text file, send in an email, store in a cookie or web page, or
bounce around the Net.  The data you encrypt can be as simple or as complicated
as you like.

=head1 KEY

If you don't pass any options when using C<Crypt::Simple> we will generate a key
for you based on the name of your module that uses this one.  In many cases this
works fine, but you may want more control over the key.  Here's how:

=over 4

=item use Crypt::Simple passphrase => 'pass phrase';

The MD5 hash of the text string "pass phrase" is used as the key.

=item use Crypt::Simple prompt => 'Please type the magic words';

The user is prompted to enter a passphrase, and the MD5 hash of the entered text
is used as the key.

=item use Crypt::Simple passfile => '/home/marty/secret';

The contents of the file /home/marty/secret are used as the pass phrase: the MD5
hash of the file is used as the key.

=item use Crypt::Simple file => '/home/marty/noise';

The contents of the file /home/marty/noise are directly used as the key.

=back

=head1 INTERNALS

C<Crypt::Simple> is really just a wrapper round a few other useful Perl
modules: you may want to read the documentation for these modules too.

We use C<FreezeThaw> to squish all your data into a concise textual
representation.  We use C<Compress::Zlib> to compress this string, and then use
C<Crypt::Blowfish> in a home-brew CBC mode to perform the encryption.
Somewhere in this process we also add a MD5 digest (using C<Digest::MD5>).
Then we throw the whole thing through C<MIME::Base64> to produce a nice bit of
text for you to play with.

Decryption, obviously, is the reverse of this process.

=head1 WARNING

Governments throughout the world do not like encryption because it makes it
difficult for them to look at all your stuff.  Each country has a different
policy designed to stop you using encryption: some governments are honest enough
to make it illegal; some think it is a dangerous weapon; some insist that you
are free to encrypt, but only evil people would want to; some make confusing and
contradictory laws because they try to do all of the above.

Although this modules itself does not include any encryption code, it does use
another module that contains encryption code, and this documentation mentions
encryption.  Downloading, using, or reading this modules could be illegal where
you live.

=head1 AUTHOR

Marty Pauley E<lt>marty@kasei.comE<gt>

=head1 COPYRIGHT

  Copyright (C) 2001 Kasei Limited

  This program is free software; you can redistribute it and/or modify it under
  the terms of the GNU General Public License; either version 2 of the License,
  or (at your option) any later version.

  This program is distributed in the hope that it will be useful, but WITHOUT
  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  FOR A PARTICULAR PURPOSE.

=cut

use strict;
use Carp;
use Crypt::Blowfish;
use Compress::Zlib;
use MIME::Base64;
use Digest::MD5 qw(md5);
use FreezeThaw qw(freeze thaw);

sub _chunk($) { $_[0] =~ /.{1,8}/ogs }

sub import {
	my ($class, @args) = @_;
	my $caller = caller;
	my $key = $class->get_key_param(@args)
		|| $class->get_key_default($caller);
	my $cipher = Crypt::Blowfish->new($key);

	no strict 'refs';
	*{"${caller}::encrypt"} = sub {
		my $data = freeze(@_);
		my $sig = md5($data);
		my $b0 = pack('NN', 0, 0);
		my $ct = '';
		foreach my $block (_chunk($sig.compress($data))) {
			$ct .= $b0 = $cipher->encrypt($b0 ^ $block);
		}
		return encode_base64($ct, '');
	};
	*{"${caller}::decrypt"} = sub {
		my $data = decode_base64($_[0]);
		my ($sig1, $sig2, @blocks) = _chunk($data);
		my $b0 = pack('NN', 0, 0);
		my $sig = $b0 ^ $cipher->decrypt($sig1);
		$b0 = $sig1;
		$sig .= $b0 ^ $cipher->decrypt($sig2);
		$b0 = $sig2;
		my $pt = '';
		foreach my $block (@blocks) {
			$pt .= $b0 ^ $cipher->decrypt($block);
			$b0 = $block;
		}
		my $result = uncompress($pt);
		croak "message digest incorrect" unless $sig eq md5($result);
		my @data = thaw($result);
		return wantarray ? @data : $data[0];
	};

      1;
}

sub get_key_param {
	my ($class, @p) = @_;
	return md5($p[0]) if @p == 1;
	my %p = @p;
	my $key = '';
	foreach my $k ($class->get_key_methods) {
		next unless exists $p{$k};
		if (my $m = $class->can("key_from_$k")) {
			$key = $class->$m($p{$k});
			last if $key;
		}
	}
	return $key;
}

sub get_key_default {
	my ($class, $c) = @_;
	return md5("$class,$c");
}

sub get_key_methods { qw{passphrase passfile file prompt} }

sub key_from_passphrase {
	my ($class, $pass) = @_;
	return md5($pass);
}

sub read_file_contents {
	my ($class, $file) = @_;
	open my $io, $file or croak "cannot open $file: $!";
	local $/;
	my $data = <$io>;
	close $io;
	return $data;
}

sub key_from_passfile {
	my ($class, $file) = @_;
	my $pass = $class->read_file_contents($file);
	return $class->key_from_passphrase($pass);
}

sub key_from_file {
	my ($class, $file) = @_;
	return $class->read_file_contents($file);
}

sub key_from_prompt {
	my ($class, $prompt) = @_;
	print STDERR "$prompt: ";
	my $pass = <STDIN>;
	chomp $pass;
	return $class->key_from_passphrase($pass);
}

1;