← Index
NYTProf Performance Profile   « line view »
For t/bug-md-11.t
  Run on Fri Mar 8 13:27:24 2024
Reported on Fri Mar 8 13:30:23 2024

Filename/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Digest/Perl/MD5.pm
StatementsExecuted 725 statements in 2.65ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1111.39ms1.74msDigest::Perl::MD5::::gen_codeDigest::Perl::MD5::gen_code
1118µs10µsDigest::Perl::MD5::::BEGIN@2Digest::Perl::MD5::BEGIN@2
1113µs4µsDigest::Perl::MD5::::BEGIN@3Digest::Perl::MD5::BEGIN@3
1113µs11µsDigest::Perl::MD5::::BEGIN@4Digest::Perl::MD5::BEGIN@4
1113µs32µsDigest::Perl::MD5::::BEGIN@5Digest::Perl::MD5::BEGIN@5
0000s0sDigest::Perl::MD5::::_encode_base64Digest::Perl::MD5::_encode_base64
0000s0sDigest::Perl::MD5::::_encode_hexDigest::Perl::MD5::_encode_hex
0000s0sDigest::Perl::MD5::::addDigest::Perl::MD5::add
0000s0sDigest::Perl::MD5::::add_bitsDigest::Perl::MD5::add_bits
0000s0sDigest::Perl::MD5::::addfileDigest::Perl::MD5::addfile
0000s0sDigest::Perl::MD5::::b64digestDigest::Perl::MD5::b64digest
0000s0sDigest::Perl::MD5::::cloneDigest::Perl::MD5::clone
0000s0sDigest::Perl::MD5::::digestDigest::Perl::MD5::digest
0000s0sDigest::Perl::MD5::::finalizeDigest::Perl::MD5::finalize
0000s0sDigest::Perl::MD5::::hexdigestDigest::Perl::MD5::hexdigest
0000s0sDigest::Perl::MD5::::md5Digest::Perl::MD5::md5
0000s0sDigest::Perl::MD5::::md5_base64Digest::Perl::MD5::md5_base64
0000s0sDigest::Perl::MD5::::md5_hexDigest::Perl::MD5::md5_hex
0000s0sDigest::Perl::MD5::::newDigest::Perl::MD5::new
0000s0sDigest::Perl::MD5::::paddingDigest::Perl::MD5::padding
0000s0sDigest::Perl::MD5::::resetDigest::Perl::MD5::reset
0000s0sDigest::Perl::MD5::::rotate_leftDigest::Perl::MD5::rotate_left
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Digest::Perl::MD5;
2216µs212µ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
use strict;
# spent 10µs making 1 call to Digest::Perl::MD5::BEGIN@2 # spent 2µs making 1 call to strict::import
3210µs25µ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
use integer;
# spent 4µs making 1 call to Digest::Perl::MD5::BEGIN@3 # spent 700ns making 1 call to integer::import
4214µs220µ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
use Exporter;
# spent 11µs making 1 call to Digest::Perl::MD5::BEGIN@4 # spent 8µs making 1 call to Exporter::import
52864µs261µ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
use vars qw($VERSION @ISA @EXPORTER @EXPORT_OK);
# spent 32µs making 1 call to Digest::Perl::MD5::BEGIN@5 # spent 29µs making 1 call to vars::import
6
71900ns@EXPORT_OK = qw(md5 md5_hex md5_base64);
8
915µs@ISA = 'Exporter';
101100ns$VERSION = '1.9';
11
12# I-Vektor
13sub A() { 0x67_45_23_01 }
14sub B() { 0xef_cd_ab_89 }
15sub C() { 0x98_ba_dc_fe }
16sub D() { 0x10_32_54_76 }
17
18# for internal use
19sub MAX() { 0xFFFFFFFF }
20
21# pad a message to a multiple of 64
22sub 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
30sub 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
sub gen_code {
39 # Discard upper 32 bits on 64 bit archs.
401300ns 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;",
4312µ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
5213µ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
581100ns my $insert = "\n";
59170µs6516µs while(defined( my $data = <DATA> )) {
# spent 16µs making 65 calls to CORE::readline, avg 254ns/call
60646µs chomp $data;
616452µs6415µs next unless $data =~ /^[FGHI]/;
# spent 15µs making 64 calls to CORE::match, avg 228ns/call
626437µs my ($func,@x) = split /,/, $data;
63649µs my $c = $f{$func};
6464662µs736220µ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
656442µs647µs $c =~ s/(S\d{2})/$s{$1}/;
# spent 7µs making 64 calls to CORE::subst, avg 103ns/call
6664126µs6486µs $c =~ s/^(.*)=rotate_left\((.*),(.*)\)\+(.*)$//;
# spent 86µs making 64 calls to CORE::subst, avg 1µs/call
67
686413µs my $su = 32 - $3;
696411µs my $sh = (1 << $3) - 1;
70
716477µ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";
766453µs $insert .= "\t$c\n";
77 }
7816µs13µs close DATA;
# spent 3µs making 1 call to CORE::close
79
8012µ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 }';
871569µs eval $dump;
88 # print "$dump\n";
89 # exit 0;
90}
91
9211µs11.74msgen_code();
# spent 1.74ms making 1 call to Digest::Perl::MD5::gen_code
93
94#########################################
95# Private output converter functions:
96sub _encode_hex { unpack 'H*', $_[0] }
97sub _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:
110sub 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
119sub reset {
120 my $self = shift;
121 delete $self->{_data};
122 $self->{_state} = [A,B,C,D];
123 $self->{_length} = 0;
124 $self
125}
126
127sub 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
143sub 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
154sub 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
168sub 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
176sub digest {
177 my $self = shift;
178 $self->finalize();
179 my $res = pack 'V4', @{$self->{_state}};
180 $self->reset();
181 $res
182}
183
184sub hexdigest {
185 _encode_hex($_[0]->digest)
186}
187
188sub b64digest {
189 _encode_base64($_[0]->digest)
190}
191
192sub 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:
204sub 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}
214sub md5_hex { _encode_hex &md5 }
215sub md5_base64 { _encode_base64 &md5 }
216
217
21813µs1;
219
220=head1 NAME
221
222Digest::MD5::Perl - Perl implementation of Ron Rivests MD5 Algorithm
223
224=head1 DISCLAIMER
225
226This is B<not> an interface (like C<Digest::MD5>) but a Perl implementation of MD5.
227It is written in perl only and because of this it is slow but it works without C-Code.
228You should use C<Digest::MD5> instead of this module if it is available.
229This module is only useful for
230
231=over 4
232
233=item
234
235computers where you cannot install C<Digest::MD5> (e.g. lack of a C-Compiler)
236
237=item
238
239encrypting only small amounts of data (less than one million bytes). I use it to
240hash passwords.
241
242=item
243
244educational 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
272This modules has the same interface as the much faster C<Digest::MD5>. So you can
273easily 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
286If the C<Digest::MD5> module is available it is used and if not you take
287C<Digest::Perl::MD5>.
288
289You can also install the Perl part of Digest::MD5 together with Digest::Perl::MD5
290and use Digest::MD5 as normal, it falls back to Digest::Perl::MD5 if it
291cannot load its object files.
292
293For a detailed Documentation see the C<Digest::MD5> module.
294
295=head1 EXAMPLES
296
297The simplest way to use this library is to import the md5_hex()
298function (or one of its cousins):
299
300 use Digest::Perl::MD5 'md5_hex';
301 print 'Digest is ', md5_hex('foobarbaz'), "\n";
302
303The above example would print out the message
304
305 Digest is 6df23dc03f9b54cc38a0fc1483df6e21
306
307provided that the implementation is working correctly. The same
308checksum 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
319The digest methods are destructive. That means you can only call them
320once 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
326This implementation of the MD5 algorithm has some limitations:
327
328=over 4
329
330=item
331
332It's slow, very slow. I've done my very best but Digest::MD5 is still about 100 times faster.
333You can only encrypt Data up to one million bytes in an acceptable time. But it's very useful
334for encrypting small amounts of data like passwords.
335
336=item
337
338You can only encrypt up to 2^32 bits = 512 MB on 32bit archs. But You should
339use C<Digest::MD5> for those amounts of data anyway.
340
341=back
342
343=head1 SEE ALSO
344
345L<Digest::MD5>
346
347L<md5(1)>
348
349RFC 1321
350
351tools/md5: a small BSD compatible md5 tool written in pure perl.
352
353=head1 COPYRIGHT
354
355This library is free software; you can redistribute it and/or
356modify 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
363The MD5 algorithm is defined in RFC 1321. The basic C code
364implementing the algorithm is derived from that in the RFC and is
365covered by the following copyright:
366
367=over 4
368
369=item
370
371Copyright (C) 1991-1992, RSA Data Security, Inc. Created 1991. All
372rights reserved.
373
374License to copy and use this software is granted provided that it
375is identified as the "RSA Data Security, Inc. MD5 Message-Digest
376Algorithm" in all material mentioning or referencing this software
377or this function.
378
379License is also granted to make and use derivative works provided
380that such works are identified as "derived from the RSA Data
381Security, Inc. MD5 Message-Digest Algorithm" in all material
382mentioning or referencing the derived work.
383
384RSA Data Security, Inc. makes no representations concerning either
385the merchantability of this software or the suitability of this
386software for any particular purpose. It is provided "as is"
387without express or implied warranty of any kind.
388
389These notices must be retained in any copies of any part of this
390documentation and/or software.
391
392=back
393
394This copyright does not prohibit distribution of any version of Perl
395containing this extension under the terms of the GNU or Artistic
396licenses.
397
398=head1 AUTHORS
399
400The original MD5 interface was written by Neil Winton
401(<N.Winton (at) axion.bt.co.uk>).
402
403C<Digest::MD5> was made by Gisle Aas <gisle (at) aas.no> (I took his Interface
404and part of the documentation).
405
406Thanks to Guido Flohr for his 'use integer'-hint.
407
408This release was made by Christian Lackas <delta (at) lackas.net>.
409
410=cut
411
412__DATA__