|
1 # This library is free software; you can redistribute it and/or |
|
2 # modify it under the same terms as Perl itself. |
|
3 # |
|
4 # Copyright 2000 Christian Lackas, Imperia Software Solutions |
|
5 # Copyright 1998-1999 Gisle Aas. |
|
6 # Copyright 1995-1996 Neil Winton. |
|
7 # Copyright 1991-1992 RSA Data Security, Inc. |
|
8 |
|
9 #!/usr/local/bin/perl -w |
|
10 #$Id: MD5.pm,v 1.16 2000/09/19 22:19:31 lackas Exp $ |
|
11 |
|
12 package Digest::Perl::MD5; |
|
13 use strict; |
|
14 use integer; |
|
15 use Exporter; |
|
16 use vars qw($VERSION @ISA @EXPORTER @EXPORT_OK); |
|
17 |
|
18 @EXPORT_OK = qw(md5 md5_hex md5_base64); |
|
19 |
|
20 @ISA = 'Exporter'; |
|
21 $VERSION = '1.5'; |
|
22 |
|
23 # I-Vektor |
|
24 sub A() { 0x67_45_23_01 } |
|
25 sub B() { 0xef_cd_ab_89 } |
|
26 sub C() { 0x98_ba_dc_fe } |
|
27 sub D() { 0x10_32_54_76 } |
|
28 |
|
29 # for internal use |
|
30 sub MAX() { 0xFFFFFFFF } |
|
31 |
|
32 # padd a message to a multiple of 64 |
|
33 sub padding($) { |
|
34 my $l = length (my $msg = shift() . chr(128)); |
|
35 $msg .= "\0" x (($l%64<=56?56:120)-$l%64); |
|
36 $l = ($l-1)*8; |
|
37 $msg .= pack 'VV', $l & MAX , ($l >> 16 >> 16); |
|
38 } |
|
39 |
|
40 |
|
41 sub rotate_left($$) { |
|
42 ($_[0] << $_[1]) | (( $_[0] >> (32 - $_[1]) ) & ((1 << $_[1]) - 1)); |
|
43 } |
|
44 |
|
45 sub gen_code { |
|
46 # Discard upper 32 bits on 64 bit archs. |
|
47 my $MSK = ((1 << 16) << 16) ? ' & ' . MAX : ''; |
|
48 my %f = ( |
|
49 FF => "X0=rotate_left((X3^(X1&(X2^X3)))+X0+X4+X6$MSK,X5)+X1$MSK;", |
|
50 GG => "X0=rotate_left((X2^(X3&(X1^X2)))+X0+X4+X6$MSK,X5)+X1$MSK;", |
|
51 HH => "X0=rotate_left((X1^X2^X3)+X0+X4+X6$MSK,X5)+X1$MSK;", |
|
52 II => "X0=rotate_left((X2^(X1|(~X3)))+X0+X4+X6$MSK,X5)+X1$MSK;", |
|
53 ); |
|
54 |
|
55 my %s = ( # shift lengths |
|
56 S11 => 7, S12 => 12, S13 => 17, S14 => 22, S21 => 5, S22 => 9, S23 => 14, |
|
57 S24 => 20, S31 => 4, S32 => 11, S33 => 16, S34 => 23, S41 => 6, S42 => 10, |
|
58 S43 => 15, S44 => 21 |
|
59 ); |
|
60 |
|
61 my $insert = ""; |
|
62 while(<DATA>) { |
|
63 chomp; |
|
64 next unless /^[FGHI]/; |
|
65 my ($func,@x) = split /,/; |
|
66 my $c = $f{$func}; |
|
67 $c =~ s/X(\d)/$x[$1]/g; |
|
68 $c =~ s/(S\d{2})/$s{$1}/; |
|
69 $c =~ s/^(.*)=rotate_left\((.*),(.*)\)\+(.*)$//; |
|
70 |
|
71 $c = "\$r = $2; |
|
72 $1 = ((\$r << $3) | ((\$r >> (32 - $3)) & ((1 << $3) - 1))) + $4"; |
|
73 $insert .= "\t$c\n"; |
|
74 } |
|
75 |
|
76 my $dump = ' |
|
77 sub round { |
|
78 my ($a,$b,$c,$d) = @_[0 .. 3]; |
|
79 my $r; |
|
80 |
|
81 ' . $insert . ' |
|
82 $_[0]+$a' . $MSK . ', $_[1]+$b ' . $MSK . |
|
83 ', $_[2]+$c' . $MSK . ', $_[3]+$d' . $MSK . '; |
|
84 }'; |
|
85 eval $dump; |
|
86 } |
|
87 |
|
88 gen_code(); |
|
89 |
|
90 |
|
91 # object part of this module |
|
92 sub new { |
|
93 my $class = shift; |
|
94 bless {}, ref($class) || $class; |
|
95 } |
|
96 |
|
97 sub reset { |
|
98 my $self = shift; |
|
99 delete $self->{data}; |
|
100 $self |
|
101 } |
|
102 |
|
103 sub add(@) { |
|
104 my $self = shift; |
|
105 $self->{data} .= join'', @_; |
|
106 $self |
|
107 } |
|
108 |
|
109 sub addfile { |
|
110 my ($self,$fh) = @_; |
|
111 if (!ref($fh) && ref(\$fh) ne "GLOB") { |
|
112 require Symbol; |
|
113 $fh = Symbol::qualify($fh, scalar caller); |
|
114 } |
|
115 $self->{data} .= do{local$/;<$fh>}; |
|
116 $self |
|
117 } |
|
118 |
|
119 sub digest { |
|
120 md5(shift->{data}) |
|
121 } |
|
122 |
|
123 sub hexdigest { |
|
124 md5_hex(shift->{data}) |
|
125 } |
|
126 |
|
127 sub b64digest { |
|
128 md5_base64(shift->{data}) |
|
129 } |
|
130 |
|
131 sub md5(@) { |
|
132 my $message = padding(join'',@_); |
|
133 my ($a,$b,$c,$d) = (A,B,C,D); |
|
134 my $i; |
|
135 for $i (0 .. (length $message)/64-1) { |
|
136 my @X = unpack 'V16', substr $message,$i*64,64; |
|
137 ($a,$b,$c,$d) = round($a,$b,$c,$d,@X); |
|
138 } |
|
139 pack 'V4',$a,$b,$c,$d; |
|
140 } |
|
141 |
|
142 |
|
143 sub md5_hex(@) { |
|
144 unpack 'H*', &md5; |
|
145 } |
|
146 |
|
147 sub md5_base64(@) { |
|
148 encode_base64(&md5); |
|
149 } |
|
150 |
|
151 |
|
152 sub encode_base64 ($) { |
|
153 my $res; |
|
154 while ($_[0] =~ /(.{1,45})/gs) { |
|
155 $res .= substr pack('u', $1), 1; |
|
156 chop $res; |
|
157 } |
|
158 $res =~ tr|` -_|AA-Za-z0-9+/|;#` |
|
159 chop $res;chop $res; |
|
160 $res; |
|
161 } |
|
162 |
|
163 1; |
|
164 |
|
165 =head1 NAME |
|
166 |
|
167 Digest::MD5::Perl - Perl implementation of Ron Rivests MD5 Algorithm |
|
168 |
|
169 =head1 DISCLAIMER |
|
170 |
|
171 This is B<not> an interface (like C<Digest::MD5>) but a Perl implementation of MD5. |
|
172 It is written in perl only and because of this it is slow but it works without C-Code. |
|
173 You should use C<Digest::MD5> instead of this module if it is available. |
|
174 This module is only usefull for |
|
175 |
|
176 =over 4 |
|
177 |
|
178 =item |
|
179 |
|
180 computers where you cannot install C<Digest::MD5> (e.g. lack of a C-Compiler) |
|
181 |
|
182 =item |
|
183 |
|
184 encrypting only small amounts of data (less than one million bytes). I use it to |
|
185 hash passwords. |
|
186 |
|
187 =item |
|
188 |
|
189 educational purposes |
|
190 |
|
191 =back |
|
192 |
|
193 =head1 SYNOPSIS |
|
194 |
|
195 # Functional style |
|
196 use Digest::MD5 qw(md5 md5_hex md5_base64); |
|
197 |
|
198 $hash = md5 $data; |
|
199 $hash = md5_hex $data; |
|
200 $hash = md5_base64 $data; |
|
201 |
|
202 |
|
203 # OO style |
|
204 use Digest::MD5; |
|
205 |
|
206 $ctx = Digest::MD5->new; |
|
207 |
|
208 $ctx->add($data); |
|
209 $ctx->addfile(*FILE); |
|
210 |
|
211 $digest = $ctx->digest; |
|
212 $digest = $ctx->hexdigest; |
|
213 $digest = $ctx->b64digest; |
|
214 |
|
215 =head1 DESCRIPTION |
|
216 |
|
217 This modules has the same interface as the much faster C<Digest::MD5>. So you can |
|
218 easily exchange them, e.g. |
|
219 |
|
220 BEGIN { |
|
221 eval { |
|
222 require Digest::MD5; |
|
223 import Digest::MD5 'md5_hex' |
|
224 }; |
|
225 if ($@) { # ups, no Digest::MD5 |
|
226 require Digest::Perl::MD5; |
|
227 import Digest::Perl::MD5 'md5_hex' |
|
228 } |
|
229 } |
|
230 |
|
231 If the C<Digest::MD5> module is available it is used and if not you take |
|
232 C<Digest::Perl::MD5>. |
|
233 |
|
234 You can also install the Perl part of Digest::MD5 together with Digest::Perl::MD5 |
|
235 and use Digest::MD5 as normal, it falls back to Digest::Perl::MD5 if it |
|
236 cannot load its object files. |
|
237 |
|
238 For a detailed Documentation see the C<Digest::MD5> module. |
|
239 |
|
240 =head1 EXAMPLES |
|
241 |
|
242 The simplest way to use this library is to import the md5_hex() |
|
243 function (or one of its cousins): |
|
244 |
|
245 use Digest::Perl::MD5 'md5_hex'; |
|
246 print 'Digest is ', md5_hex('foobarbaz'), "\n"; |
|
247 |
|
248 The above example would print out the message |
|
249 |
|
250 Digest is 6df23dc03f9b54cc38a0fc1483df6e21 |
|
251 |
|
252 provided that the implementation is working correctly. The same |
|
253 checksum can also be calculated in OO style: |
|
254 |
|
255 use Digest::MD5; |
|
256 |
|
257 $md5 = Digest::MD5->new; |
|
258 $md5->add('foo', 'bar'); |
|
259 $md5->add('baz'); |
|
260 $digest = $md5->hexdigest; |
|
261 |
|
262 print "Digest is $digest\n"; |
|
263 |
|
264 =head1 LIMITATIONS |
|
265 |
|
266 This implementation of the MD5 algorithm has some limitations: |
|
267 |
|
268 =over 4 |
|
269 |
|
270 =item |
|
271 |
|
272 It's slow, very slow. I've done my very best but Digest::MD5 is still about 135 times faster. |
|
273 You can only encrypt Data up to one million bytes in an acceptable time. But it's very usefull |
|
274 for encrypting small amounts of data like passwords. |
|
275 |
|
276 =item |
|
277 |
|
278 You can only encrypt up to 2^32 bits = 512 MB on 32bit archs. You should use C<Digest::MD5> |
|
279 for those amounts of data. |
|
280 |
|
281 =item |
|
282 |
|
283 C<Digest::Perl::MD5> loads all data to encrypt into memory. This is a todo. |
|
284 |
|
285 =back |
|
286 |
|
287 =head1 SEE ALSO |
|
288 |
|
289 L<Digest::MD5> |
|
290 |
|
291 L<md5sum(1)> |
|
292 |
|
293 RFC 1321 |
|
294 |
|
295 =head1 COPYRIGHT |
|
296 |
|
297 This library is free software; you can redistribute it and/or |
|
298 modify it under the same terms as Perl itself. |
|
299 |
|
300 Copyright 2000 Christian Lackas, Imperia Software Solutions |
|
301 Copyright 1998-1999 Gisle Aas. |
|
302 Copyright 1995-1996 Neil Winton. |
|
303 Copyright 1991-1992 RSA Data Security, Inc. |
|
304 |
|
305 The MD5 algorithm is defined in RFC 1321. The basic C code |
|
306 implementing the algorithm is derived from that in the RFC and is |
|
307 covered by the following copyright: |
|
308 |
|
309 =over 4 |
|
310 |
|
311 =item |
|
312 |
|
313 Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All |
|
314 rights reserved. |
|
315 |
|
316 License to copy and use this software is granted provided that it |
|
317 is identified as the "RSA Data Security, Inc. MD5 Message-Digest |
|
318 Algorithm" in all material mentioning or referencing this software |
|
319 or this function. |
|
320 |
|
321 License is also granted to make and use derivative works provided |
|
322 that such works are identified as "derived from the RSA Data |
|
323 Security, Inc. MD5 Message-Digest Algorithm" in all material |
|
324 mentioning or referencing the derived work. |
|
325 |
|
326 RSA Data Security, Inc. makes no representations concerning either |
|
327 the merchantability of this software or the suitability of this |
|
328 software for any particular purpose. It is provided "as is" |
|
329 without express or implied warranty of any kind. |
|
330 |
|
331 These notices must be retained in any copies of any part of this |
|
332 documentation and/or software. |
|
333 |
|
334 =back |
|
335 |
|
336 This copyright does not prohibit distribution of any version of Perl |
|
337 containing this extension under the terms of the GNU or Artistic |
|
338 licenses. |
|
339 |
|
340 =head1 AUTHORS |
|
341 |
|
342 The original MD5 interface was written by Neil Winton |
|
343 (C<N.Winton@axion.bt.co.uk>). |
|
344 |
|
345 C<Digest::MD5> was made by Gisle Aas <gisle@aas.no> (I took his Interface |
|
346 and part of the documentation) |
|
347 |
|
348 Thanks to Guido Flohr for his 'use integer'-hint. |
|
349 |
|
350 This release was made by Christian Lackas <delta@clackas.de>. |
|
351 |
|
352 =cut |
|
353 |
|
354 __DATA__ |
|
355 FF,$a,$b,$c,$d,$_[4],7,0xd76aa478,/* 1 */ |
|
356 FF,$d,$a,$b,$c,$_[5],12,0xe8c7b756,/* 2 */ |
|
357 FF,$c,$d,$a,$b,$_[6],17,0x242070db,/* 3 */ |
|
358 FF,$b,$c,$d,$a,$_[7],22,0xc1bdceee,/* 4 */ |
|
359 FF,$a,$b,$c,$d,$_[8],7,0xf57c0faf,/* 5 */ |
|
360 FF,$d,$a,$b,$c,$_[9],12,0x4787c62a,/* 6 */ |
|
361 FF,$c,$d,$a,$b,$_[10],17,0xa8304613,/* 7 */ |
|
362 FF,$b,$c,$d,$a,$_[11],22,0xfd469501,/* 8 */ |
|
363 FF,$a,$b,$c,$d,$_[12],7,0x698098d8,/* 9 */ |
|
364 FF,$d,$a,$b,$c,$_[13],12,0x8b44f7af,/* 10 */ |
|
365 FF,$c,$d,$a,$b,$_[14],17,0xffff5bb1,/* 11 */ |
|
366 FF,$b,$c,$d,$a,$_[15],22,0x895cd7be,/* 12 */ |
|
367 FF,$a,$b,$c,$d,$_[16],7,0x6b901122,/* 13 */ |
|
368 FF,$d,$a,$b,$c,$_[17],12,0xfd987193,/* 14 */ |
|
369 FF,$c,$d,$a,$b,$_[18],17,0xa679438e,/* 15 */ |
|
370 FF,$b,$c,$d,$a,$_[19],22,0x49b40821,/* 16 */ |
|
371 GG,$a,$b,$c,$d,$_[5],5,0xf61e2562,/* 17 */ |
|
372 GG,$d,$a,$b,$c,$_[10],9,0xc040b340,/* 18 */ |
|
373 GG,$c,$d,$a,$b,$_[15],14,0x265e5a51,/* 19 */ |
|
374 GG,$b,$c,$d,$a,$_[4],20,0xe9b6c7aa,/* 20 */ |
|
375 GG,$a,$b,$c,$d,$_[9],5,0xd62f105d,/* 21 */ |
|
376 GG,$d,$a,$b,$c,$_[14],9,0x2441453,/* 22 */ |
|
377 GG,$c,$d,$a,$b,$_[19],14,0xd8a1e681,/* 23 */ |
|
378 GG,$b,$c,$d,$a,$_[8],20,0xe7d3fbc8,/* 24 */ |
|
379 GG,$a,$b,$c,$d,$_[13],5,0x21e1cde6,/* 25 */ |
|
380 GG,$d,$a,$b,$c,$_[18],9,0xc33707d6,/* 26 */ |
|
381 GG,$c,$d,$a,$b,$_[7],14,0xf4d50d87,/* 27 */ |
|
382 GG,$b,$c,$d,$a,$_[12],20,0x455a14ed,/* 28 */ |
|
383 GG,$a,$b,$c,$d,$_[17],5,0xa9e3e905,/* 29 */ |
|
384 GG,$d,$a,$b,$c,$_[6],9,0xfcefa3f8,/* 30 */ |
|
385 GG,$c,$d,$a,$b,$_[11],14,0x676f02d9,/* 31 */ |
|
386 GG,$b,$c,$d,$a,$_[16],20,0x8d2a4c8a,/* 32 */ |
|
387 HH,$a,$b,$c,$d,$_[9],4,0xfffa3942,/* 33 */ |
|
388 HH,$d,$a,$b,$c,$_[12],11,0x8771f681,/* 34 */ |
|
389 HH,$c,$d,$a,$b,$_[15],16,0x6d9d6122,/* 35 */ |
|
390 HH,$b,$c,$d,$a,$_[18],23,0xfde5380c,/* 36 */ |
|
391 HH,$a,$b,$c,$d,$_[5],4,0xa4beea44,/* 37 */ |
|
392 HH,$d,$a,$b,$c,$_[8],11,0x4bdecfa9,/* 38 */ |
|
393 HH,$c,$d,$a,$b,$_[11],16,0xf6bb4b60,/* 39 */ |
|
394 HH,$b,$c,$d,$a,$_[14],23,0xbebfbc70,/* 40 */ |
|
395 HH,$a,$b,$c,$d,$_[17],4,0x289b7ec6,/* 41 */ |
|
396 HH,$d,$a,$b,$c,$_[4],11,0xeaa127fa,/* 42 */ |
|
397 HH,$c,$d,$a,$b,$_[7],16,0xd4ef3085,/* 43 */ |
|
398 HH,$b,$c,$d,$a,$_[10],23,0x4881d05,/* 44 */ |
|
399 HH,$a,$b,$c,$d,$_[13],4,0xd9d4d039,/* 45 */ |
|
400 HH,$d,$a,$b,$c,$_[16],11,0xe6db99e5,/* 46 */ |
|
401 HH,$c,$d,$a,$b,$_[19],16,0x1fa27cf8,/* 47 */ |
|
402 HH,$b,$c,$d,$a,$_[6],23,0xc4ac5665,/* 48 */ |
|
403 II,$a,$b,$c,$d,$_[4],6,0xf4292244,/* 49 */ |
|
404 II,$d,$a,$b,$c,$_[11],10,0x432aff97,/* 50 */ |
|
405 II,$c,$d,$a,$b,$_[18],15,0xab9423a7,/* 51 */ |
|
406 II,$b,$c,$d,$a,$_[9],21,0xfc93a039,/* 52 */ |
|
407 II,$a,$b,$c,$d,$_[16],6,0x655b59c3,/* 53 */ |
|
408 II,$d,$a,$b,$c,$_[7],10,0x8f0ccc92,/* 54 */ |
|
409 II,$c,$d,$a,$b,$_[14],15,0xffeff47d,/* 55 */ |
|
410 II,$b,$c,$d,$a,$_[5],21,0x85845dd1,/* 56 */ |
|
411 II,$a,$b,$c,$d,$_[12],6,0x6fa87e4f,/* 57 */ |
|
412 II,$d,$a,$b,$c,$_[19],10,0xfe2ce6e0,/* 58 */ |
|
413 II,$c,$d,$a,$b,$_[10],15,0xa3014314,/* 59 */ |
|
414 II,$b,$c,$d,$a,$_[17],21,0x4e0811a1,/* 60 */ |
|
415 II,$a,$b,$c,$d,$_[8],6,0xf7537e82,/* 61 */ |
|
416 II,$d,$a,$b,$c,$_[15],10,0xbd3af235,/* 62 */ |
|
417 II,$c,$d,$a,$b,$_[6],15,0x2ad7d2bb,/* 63 */ |
|
418 II,$b,$c,$d,$a,$_[13],21,0xeb86d391,/* 64 */ |