Filename | /usr/local/lib/perl5/5.24/mach/Digest/SHA.pm |
Statements | Executed 26 statements in 3.76ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
155799 | 1 | 1 | 1.32s | 1.32s | sha1 (xsub) | Digest::SHA::
555 | 1 | 1 | 12.7ms | 12.7ms | sha1_hex (xsub) | Digest::SHA::
1 | 1 | 1 | 204µs | 204µs | bootstrap (xsub) | Digest::SHA::
1 | 1 | 1 | 43µs | 52µs | BEGIN@196 | Digest::SHA::
1 | 1 | 1 | 39µs | 56µs | BEGIN@5 | Digest::SHA::
1 | 1 | 1 | 32µs | 2.45ms | BEGIN@8 | Digest::SHA::
1 | 1 | 1 | 29µs | 57µs | BEGIN@6 | Digest::SHA::
1 | 1 | 1 | 26µs | 34µs | BEGIN@9 | Digest::SHA::
1 | 1 | 1 | 25µs | 271µs | BEGIN@7 | Digest::SHA::
1 | 1 | 1 | 13µs | 13µs | BEGIN@55 | Digest::SHA::
0 | 0 | 0 | 0s | 0s | _addfile | Digest::SHA::
0 | 0 | 0 | 0s | 0s | _bail | Digest::SHA::
0 | 0 | 0 | 0s | 0s | _istext | Digest::SHA::
0 | 0 | 0 | 0s | 0s | add_bits | Digest::SHA::
0 | 0 | 0 | 0s | 0s | addfile | Digest::SHA::
0 | 0 | 0 | 0s | 0s | dump | Digest::SHA::
0 | 0 | 0 | 0s | 0s | getstate | Digest::SHA::
0 | 0 | 0 | 0s | 0s | load | Digest::SHA::
0 | 0 | 0 | 0s | 0s | new | Digest::SHA::
0 | 0 | 0 | 0s | 0s | putstate | Digest::SHA::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Digest::SHA; | ||||
2 | |||||
3 | 1 | 31µs | require 5.003000; | ||
4 | |||||
5 | 2 | 75µs | 2 | 72µs | # spent 56µs (39+17) within Digest::SHA::BEGIN@5 which was called:
# once (39µs+17µs) by Mail::SpamAssassin::Message::BEGIN@49 at line 5 # spent 56µs making 1 call to Digest::SHA::BEGIN@5
# spent 17µs making 1 call to strict::import |
6 | 2 | 73µs | 2 | 84µs | # spent 57µs (29+27) within Digest::SHA::BEGIN@6 which was called:
# once (29µs+27µs) by Mail::SpamAssassin::Message::BEGIN@49 at line 6 # spent 57µs making 1 call to Digest::SHA::BEGIN@6
# spent 27µs making 1 call to warnings::import |
7 | 2 | 70µs | 2 | 518µs | # spent 271µs (25+246) within Digest::SHA::BEGIN@7 which was called:
# once (25µs+246µs) by Mail::SpamAssassin::Message::BEGIN@49 at line 7 # spent 271µs making 1 call to Digest::SHA::BEGIN@7
# spent 246µs making 1 call to vars::import |
8 | 2 | 79µs | 2 | 4.87ms | # spent 2.45ms (32µs+2.42) within Digest::SHA::BEGIN@8 which was called:
# once (32µs+2.42ms) by Mail::SpamAssassin::Message::BEGIN@49 at line 8 # spent 2.45ms making 1 call to Digest::SHA::BEGIN@8
# spent 2.42ms making 1 call to Exporter::import |
9 | 2 | 442µs | 2 | 41µs | # spent 34µs (26+7) within Digest::SHA::BEGIN@9 which was called:
# once (26µs+7µs) by Mail::SpamAssassin::Message::BEGIN@49 at line 9 # spent 34µs making 1 call to Digest::SHA::BEGIN@9
# spent 7µs making 1 call to integer::import |
10 | |||||
11 | 1 | 2µs | $VERSION = '5.95_01'; | ||
12 | |||||
13 | 1 | 8µs | require Exporter; | ||
14 | 1 | 2µs | require DynaLoader; | ||
15 | 1 | 19µs | @ISA = qw(Exporter DynaLoader); | ||
16 | 1 | 9µs | @EXPORT_OK = qw( | ||
17 | hmac_sha1 hmac_sha1_base64 hmac_sha1_hex | ||||
18 | hmac_sha224 hmac_sha224_base64 hmac_sha224_hex | ||||
19 | hmac_sha256 hmac_sha256_base64 hmac_sha256_hex | ||||
20 | hmac_sha384 hmac_sha384_base64 hmac_sha384_hex | ||||
21 | hmac_sha512 hmac_sha512_base64 hmac_sha512_hex | ||||
22 | hmac_sha512224 hmac_sha512224_base64 hmac_sha512224_hex | ||||
23 | hmac_sha512256 hmac_sha512256_base64 hmac_sha512256_hex | ||||
24 | sha1 sha1_base64 sha1_hex | ||||
25 | sha224 sha224_base64 sha224_hex | ||||
26 | sha256 sha256_base64 sha256_hex | ||||
27 | sha384 sha384_base64 sha384_hex | ||||
28 | sha512 sha512_base64 sha512_hex | ||||
29 | sha512224 sha512224_base64 sha512224_hex | ||||
30 | sha512256 sha512256_base64 sha512256_hex); | ||||
31 | |||||
32 | # Inherit from Digest::base if possible | ||||
33 | |||||
34 | 1 | 5µs | eval { | ||
35 | 1 | 279µs | require Digest::base; | ||
36 | 1 | 19µs | push(@ISA, 'Digest::base'); | ||
37 | }; | ||||
38 | |||||
39 | # The following routines aren't time-critical, so they can be left in Perl | ||||
40 | |||||
41 | sub new { | ||||
42 | my($class, $alg) = @_; | ||||
43 | $alg =~ s/\D+//g if defined $alg; | ||||
44 | if (ref($class)) { # instance method | ||||
45 | if (!defined($alg) || ($alg == $class->algorithm)) { | ||||
46 | sharewind($class); | ||||
47 | return($class); | ||||
48 | } | ||||
49 | return shainit($class, $alg) ? $class : undef; | ||||
50 | } | ||||
51 | $alg = 1 unless defined $alg; | ||||
52 | return $class->newSHA($alg); | ||||
53 | } | ||||
54 | |||||
55 | 1 | 1.91ms | 1 | 13µs | # spent 13µs within Digest::SHA::BEGIN@55 which was called:
# once (13µs+0s) by Mail::SpamAssassin::Message::BEGIN@49 at line 55 # spent 13µs making 1 call to Digest::SHA::BEGIN@55 |
56 | |||||
57 | sub add_bits { | ||||
58 | my($self, $data, $nbits) = @_; | ||||
59 | unless (defined $nbits) { | ||||
60 | $nbits = length($data); | ||||
61 | $data = pack("B*", $data); | ||||
62 | } | ||||
63 | $nbits = length($data) * 8 if $nbits > length($data) * 8; | ||||
64 | shawrite($data, $nbits, $self); | ||||
65 | return($self); | ||||
66 | } | ||||
67 | |||||
68 | sub _bail { | ||||
69 | my $msg = shift; | ||||
70 | |||||
71 | $msg .= ": $!"; | ||||
72 | require Carp; | ||||
73 | Carp::croak($msg); | ||||
74 | } | ||||
75 | |||||
76 | { | ||||
77 | 1 | 2µs | my $_can_T_filehandle; | ||
78 | |||||
79 | sub _istext { | ||||
80 | local *FH = shift; | ||||
81 | my $file = shift; | ||||
82 | |||||
83 | if (! defined $_can_T_filehandle) { | ||||
84 | local $^W = 0; | ||||
85 | my $istext = eval { -T FH }; | ||||
86 | $_can_T_filehandle = $@ ? 0 : 1; | ||||
87 | return $_can_T_filehandle ? $istext : -T $file; | ||||
88 | } | ||||
89 | return $_can_T_filehandle ? -T FH : -T $file; | ||||
90 | } | ||||
91 | } | ||||
92 | |||||
93 | 1 | 3µs | sub _addfile { | ||
94 | my ($self, $handle) = @_; | ||||
95 | |||||
96 | my $n; | ||||
97 | my $buf = ""; | ||||
98 | |||||
99 | while (($n = read($handle, $buf, 4096))) { | ||||
100 | $self->add($buf); | ||||
101 | } | ||||
102 | _bail("Read failed") unless defined $n; | ||||
103 | |||||
104 | $self; | ||||
105 | } | ||||
106 | |||||
107 | sub addfile { | ||||
108 | my ($self, $file, $mode) = @_; | ||||
109 | |||||
110 | return(_addfile($self, $file)) unless ref(\$file) eq 'SCALAR'; | ||||
111 | |||||
112 | $mode = defined($mode) ? $mode : ""; | ||||
113 | my ($binary, $UNIVERSAL, $BITS, $portable) = | ||||
114 | map { $_ eq $mode } ("b", "U", "0", "p"); | ||||
115 | |||||
116 | ## Always interpret "-" to mean STDIN; otherwise use | ||||
117 | ## sysopen to handle full range of POSIX file names | ||||
118 | |||||
119 | local *FH; | ||||
120 | $file eq '-' and open(FH, '< -') | ||||
121 | or sysopen(FH, $file, O_RDONLY) | ||||
122 | or _bail('Open failed'); | ||||
123 | |||||
124 | if ($BITS) { | ||||
125 | my ($n, $buf) = (0, ""); | ||||
126 | while (($n = read(FH, $buf, 4096))) { | ||||
127 | $buf =~ s/[^01]//g; | ||||
128 | $self->add_bits($buf); | ||||
129 | } | ||||
130 | _bail("Read failed") unless defined $n; | ||||
131 | close(FH); | ||||
132 | return($self); | ||||
133 | } | ||||
134 | |||||
135 | binmode(FH) if $binary || $portable || $UNIVERSAL; | ||||
136 | if ($UNIVERSAL && _istext(*FH, $file)) { | ||||
137 | $self->_addfileuniv(*FH); | ||||
138 | } | ||||
139 | elsif ($portable && _istext(*FH, $file)) { | ||||
140 | while (<FH>) { | ||||
141 | s/\015?\015\012/\012/g; | ||||
142 | s/\015/\012/g; | ||||
143 | $self->add($_); | ||||
144 | } | ||||
145 | } | ||||
146 | else { $self->_addfilebin(*FH) } | ||||
147 | close(FH); | ||||
148 | |||||
149 | $self; | ||||
150 | } | ||||
151 | |||||
152 | sub getstate { | ||||
153 | my $self = shift; | ||||
154 | |||||
155 | my $alg = $self->algorithm or return; | ||||
156 | my $state = $self->_getstate or return; | ||||
157 | my $nD = $alg <= 256 ? 8 : 16; | ||||
158 | my $nH = $alg <= 256 ? 32 : 64; | ||||
159 | my $nB = $alg <= 256 ? 64 : 128; | ||||
160 | my($H, $block, $blockcnt, $lenhh, $lenhl, $lenlh, $lenll) = | ||||
161 | $state =~ /^(.{$nH})(.{$nB})(.{4})(.{4})(.{4})(.{4})(.{4})$/s; | ||||
162 | for ($alg, $H, $block, $blockcnt, $lenhh, $lenhl, $lenlh, $lenll) { | ||||
163 | return unless defined $_; | ||||
164 | } | ||||
165 | |||||
166 | my @s = (); | ||||
167 | push(@s, "alg:" . $alg); | ||||
168 | push(@s, "H:" . join(":", unpack("H*", $H) =~ /.{$nD}/g)); | ||||
169 | push(@s, "block:" . join(":", unpack("H*", $block) =~ /.{2}/g)); | ||||
170 | push(@s, "blockcnt:" . unpack("N", $blockcnt)); | ||||
171 | push(@s, "lenhh:" . unpack("N", $lenhh)); | ||||
172 | push(@s, "lenhl:" . unpack("N", $lenhl)); | ||||
173 | push(@s, "lenlh:" . unpack("N", $lenlh)); | ||||
174 | push(@s, "lenll:" . unpack("N", $lenll)); | ||||
175 | join("\n", @s) . "\n"; | ||||
176 | } | ||||
177 | |||||
178 | sub putstate { | ||||
179 | my($class, $state) = @_; | ||||
180 | |||||
181 | my %s = (); | ||||
182 | for (split(/\n/, $state)) { | ||||
183 | s/^\s+//; | ||||
184 | s/\s+$//; | ||||
185 | next if (/^(#|$)/); | ||||
186 | my @f = split(/[:\s]+/); | ||||
187 | my $tag = shift(@f); | ||||
188 | $s{$tag} = join('', @f); | ||||
189 | } | ||||
190 | |||||
191 | # H and block may contain arbitrary values, but check everything else | ||||
192 | grep { $_ == $s{'alg'} } (1,224,256,384,512,512224,512256) or return; | ||||
193 | length($s{'H'}) == ($s{'alg'} <= 256 ? 64 : 128) or return; | ||||
194 | length($s{'block'}) == ($s{'alg'} <= 256 ? 128 : 256) or return; | ||||
195 | { | ||||
196 | 2 | 672µs | 2 | 61µs | # spent 52µs (43+9) within Digest::SHA::BEGIN@196 which was called:
# once (43µs+9µs) by Mail::SpamAssassin::Message::BEGIN@49 at line 196 # spent 52µs making 1 call to Digest::SHA::BEGIN@196
# spent 9µs making 1 call to integer::unimport |
197 | for (qw(blockcnt lenhh lenhl lenlh lenll)) { | ||||
198 | 0 <= $s{$_} or return; | ||||
199 | $s{$_} <= 4294967295 or return; | ||||
200 | } | ||||
201 | $s{'blockcnt'} < ($s{'alg'} <= 256 ? 512 : 1024) or return; | ||||
202 | } | ||||
203 | |||||
204 | my $packed_state = ( | ||||
205 | pack("H*", $s{'H'}) . | ||||
206 | pack("H*", $s{'block'}) . | ||||
207 | pack("N", $s{'blockcnt'}) . | ||||
208 | pack("N", $s{'lenhh'}) . | ||||
209 | pack("N", $s{'lenhl'}) . | ||||
210 | pack("N", $s{'lenlh'}) . | ||||
211 | pack("N", $s{'lenll'}) | ||||
212 | ); | ||||
213 | |||||
214 | return $class->new($s{'alg'})->_putstate($packed_state); | ||||
215 | } | ||||
216 | |||||
217 | sub dump { | ||||
218 | my $self = shift; | ||||
219 | my $file = shift; | ||||
220 | |||||
221 | my $state = $self->getstate or return; | ||||
222 | $file = "-" if (!defined($file) || $file eq ""); | ||||
223 | |||||
224 | local *FH; | ||||
225 | open(FH, "> $file") or return; | ||||
226 | print FH $state; | ||||
227 | close(FH); | ||||
228 | |||||
229 | return($self); | ||||
230 | } | ||||
231 | |||||
232 | sub load { | ||||
233 | my $class = shift; | ||||
234 | my $file = shift; | ||||
235 | |||||
236 | $file = "-" if (!defined($file) || $file eq ""); | ||||
237 | |||||
238 | local *FH; | ||||
239 | open(FH, "< $file") or return; | ||||
240 | my $str = join('', <FH>); | ||||
241 | close(FH); | ||||
242 | |||||
243 | $class->putstate($str); | ||||
244 | } | ||||
245 | |||||
246 | 1 | 24µs | 1 | 809µs | Digest::SHA->bootstrap($VERSION); # spent 809µs making 1 call to DynaLoader::bootstrap |
247 | |||||
248 | 1 | 31µs | 1; | ||
249 | __END__ | ||||
# spent 204µs within Digest::SHA::bootstrap which was called:
# once (204µs+0s) by DynaLoader::bootstrap at line 210 of DynaLoader.pm | |||||
# spent 1.32s within Digest::SHA::sha1 which was called 155799 times, avg 8µs/call:
# 155799 times (1.32s+0s) by Mail::SpamAssassin::Plugin::Bayes::tokenize at line 1124 of Mail/SpamAssassin/Plugin/Bayes.pm, avg 8µs/call | |||||
# spent 12.7ms within Digest::SHA::sha1_hex which was called 555 times, avg 23µs/call:
# 555 times (12.7ms+0s) by Mail::SpamAssassin::Plugin::Bayes::get_msgid at line 1009 of Mail/SpamAssassin/Plugin/Bayes.pm, avg 23µs/call |