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