| 7319 |
dpurdie |
1 |
package Digest::SHA::PurePerl;
|
|
|
2 |
|
|
|
3 |
require 5.003000;
|
|
|
4 |
|
|
|
5 |
use strict;
|
|
|
6 |
use warnings;
|
|
|
7 |
use vars qw($VERSION @ISA @EXPORT_OK);
|
|
|
8 |
use Fcntl qw(O_RDONLY);
|
|
|
9 |
use integer;
|
|
|
10 |
use Carp qw(croak);
|
|
|
11 |
|
|
|
12 |
$VERSION = '5.97';
|
|
|
13 |
|
|
|
14 |
require Exporter;
|
|
|
15 |
@ISA = qw(Exporter);
|
|
|
16 |
@EXPORT_OK = (); # see "SHA and HMAC-SHA functions" below
|
|
|
17 |
|
|
|
18 |
# Inherit from Digest::base if possible
|
|
|
19 |
|
|
|
20 |
eval {
|
|
|
21 |
require Digest::base;
|
|
|
22 |
push(@ISA, 'Digest::base');
|
|
|
23 |
};
|
|
|
24 |
|
|
|
25 |
# ref. src/sha.c and sha/sha64bit.c from Digest::SHA
|
|
|
26 |
|
|
|
27 |
my $MAX32 = 0xffffffff;
|
|
|
28 |
|
|
|
29 |
my $uses64bit = (((1 << 16) << 16) << 16) << 15;
|
|
|
30 |
|
|
|
31 |
my @H01 = ( # SHA-1 initial hash value
|
|
|
32 |
0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476,
|
|
|
33 |
0xc3d2e1f0
|
|
|
34 |
);
|
|
|
35 |
|
|
|
36 |
my @H0224 = ( # SHA-224 initial hash value
|
|
|
37 |
0xc1059ed8, 0x367cd507, 0x3070dd17, 0xf70e5939,
|
|
|
38 |
0xffc00b31, 0x68581511, 0x64f98fa7, 0xbefa4fa4
|
|
|
39 |
);
|
|
|
40 |
|
|
|
41 |
my @H0256 = ( # SHA-256 initial hash value
|
|
|
42 |
0x6a09e667, 0xbb67ae85, 0x3c6ef372, 0xa54ff53a,
|
|
|
43 |
0x510e527f, 0x9b05688c, 0x1f83d9ab, 0x5be0cd19
|
|
|
44 |
);
|
|
|
45 |
|
|
|
46 |
my(@H0384, @H0512, @H0512224, @H0512256); # filled in later if $uses64bit
|
|
|
47 |
|
|
|
48 |
# Routines with a "_c_" prefix return Perl code-fragments which are
|
|
|
49 |
# eval'ed at initialization. This technique emulates the behavior
|
|
|
50 |
# of the C preprocessor, allowing the optimized transform code from
|
|
|
51 |
# Digest::SHA to be more easily translated into Perl.
|
|
|
52 |
|
|
|
53 |
sub _c_SL32 { # code to shift $x left by $n bits
|
|
|
54 |
my($x, $n) = @_;
|
|
|
55 |
"($x << $n)"; # even works for 64-bit integers
|
|
|
56 |
# since the upper 32 bits are
|
|
|
57 |
# eventually discarded in _digcpy
|
|
|
58 |
}
|
|
|
59 |
|
|
|
60 |
sub _c_SR32 { # code to shift $x right by $n bits
|
|
|
61 |
my($x, $n) = @_;
|
|
|
62 |
my $mask = (1 << (32 - $n)) - 1;
|
|
|
63 |
"(($x >> $n) & $mask)"; # "use integer" does arithmetic
|
|
|
64 |
# shift, so clear upper bits
|
|
|
65 |
}
|
|
|
66 |
|
|
|
67 |
sub _c_Ch { my($x, $y, $z) = @_; "($z ^ ($x & ($y ^ $z)))" }
|
|
|
68 |
sub _c_Pa { my($x, $y, $z) = @_; "($x ^ $y ^ $z)" }
|
|
|
69 |
sub _c_Ma { my($x, $y, $z) = @_; "(($x & $y) | ($z & ($x | $y)))" }
|
|
|
70 |
|
|
|
71 |
sub _c_ROTR { # code to rotate $x right by $n bits
|
|
|
72 |
my($x, $n) = @_;
|
|
|
73 |
"(" . _c_SR32($x, $n) . " | " . _c_SL32($x, 32 - $n) . ")";
|
|
|
74 |
}
|
|
|
75 |
|
|
|
76 |
sub _c_ROTL { # code to rotate $x left by $n bits
|
|
|
77 |
my($x, $n) = @_;
|
|
|
78 |
"(" . _c_SL32($x, $n) . " | " . _c_SR32($x, 32 - $n) . ")";
|
|
|
79 |
}
|
|
|
80 |
|
|
|
81 |
sub _c_SIGMA0 { # ref. NIST SHA standard
|
|
|
82 |
my($x) = @_;
|
|
|
83 |
"(" . _c_ROTR($x, 2) . " ^ " . _c_ROTR($x, 13) . " ^ " .
|
|
|
84 |
_c_ROTR($x, 22) . ")";
|
|
|
85 |
}
|
|
|
86 |
|
|
|
87 |
sub _c_SIGMA1 {
|
|
|
88 |
my($x) = @_;
|
|
|
89 |
"(" . _c_ROTR($x, 6) . " ^ " . _c_ROTR($x, 11) . " ^ " .
|
|
|
90 |
_c_ROTR($x, 25) . ")";
|
|
|
91 |
}
|
|
|
92 |
|
|
|
93 |
sub _c_sigma0 {
|
|
|
94 |
my($x) = @_;
|
|
|
95 |
"(" . _c_ROTR($x, 7) . " ^ " . _c_ROTR($x, 18) . " ^ " .
|
|
|
96 |
_c_SR32($x, 3) . ")";
|
|
|
97 |
}
|
|
|
98 |
|
|
|
99 |
sub _c_sigma1 {
|
|
|
100 |
my($x) = @_;
|
|
|
101 |
"(" . _c_ROTR($x, 17) . " ^ " . _c_ROTR($x, 19) . " ^ " .
|
|
|
102 |
_c_SR32($x, 10) . ")";
|
|
|
103 |
}
|
|
|
104 |
|
|
|
105 |
sub _c_M1Ch { # ref. Digest::SHA sha.c (sha1 routine)
|
|
|
106 |
my($a, $b, $c, $d, $e, $k, $w) = @_;
|
|
|
107 |
"$e += " . _c_ROTL($a, 5) . " + " . _c_Ch($b, $c, $d) .
|
|
|
108 |
" + $k + $w; $b = " . _c_ROTL($b, 30) . ";\n";
|
|
|
109 |
}
|
|
|
110 |
|
|
|
111 |
sub _c_M1Pa {
|
|
|
112 |
my($a, $b, $c, $d, $e, $k, $w) = @_;
|
|
|
113 |
"$e += " . _c_ROTL($a, 5) . " + " . _c_Pa($b, $c, $d) .
|
|
|
114 |
" + $k + $w; $b = " . _c_ROTL($b, 30) . ";\n";
|
|
|
115 |
}
|
|
|
116 |
|
|
|
117 |
sub _c_M1Ma {
|
|
|
118 |
my($a, $b, $c, $d, $e, $k, $w) = @_;
|
|
|
119 |
"$e += " . _c_ROTL($a, 5) . " + " . _c_Ma($b, $c, $d) .
|
|
|
120 |
" + $k + $w; $b = " . _c_ROTL($b, 30) . ";\n";
|
|
|
121 |
}
|
|
|
122 |
|
|
|
123 |
sub _c_M11Ch { my($k, $w) = @_; _c_M1Ch('$a', '$b', '$c', '$d', '$e', $k, $w) }
|
|
|
124 |
sub _c_M11Pa { my($k, $w) = @_; _c_M1Pa('$a', '$b', '$c', '$d', '$e', $k, $w) }
|
|
|
125 |
sub _c_M11Ma { my($k, $w) = @_; _c_M1Ma('$a', '$b', '$c', '$d', '$e', $k, $w) }
|
|
|
126 |
sub _c_M12Ch { my($k, $w) = @_; _c_M1Ch('$e', '$a', '$b', '$c', '$d', $k, $w) }
|
|
|
127 |
sub _c_M12Pa { my($k, $w) = @_; _c_M1Pa('$e', '$a', '$b', '$c', '$d', $k, $w) }
|
|
|
128 |
sub _c_M12Ma { my($k, $w) = @_; _c_M1Ma('$e', '$a', '$b', '$c', '$d', $k, $w) }
|
|
|
129 |
sub _c_M13Ch { my($k, $w) = @_; _c_M1Ch('$d', '$e', '$a', '$b', '$c', $k, $w) }
|
|
|
130 |
sub _c_M13Pa { my($k, $w) = @_; _c_M1Pa('$d', '$e', '$a', '$b', '$c', $k, $w) }
|
|
|
131 |
sub _c_M13Ma { my($k, $w) = @_; _c_M1Ma('$d', '$e', '$a', '$b', '$c', $k, $w) }
|
|
|
132 |
sub _c_M14Ch { my($k, $w) = @_; _c_M1Ch('$c', '$d', '$e', '$a', '$b', $k, $w) }
|
|
|
133 |
sub _c_M14Pa { my($k, $w) = @_; _c_M1Pa('$c', '$d', '$e', '$a', '$b', $k, $w) }
|
|
|
134 |
sub _c_M14Ma { my($k, $w) = @_; _c_M1Ma('$c', '$d', '$e', '$a', '$b', $k, $w) }
|
|
|
135 |
sub _c_M15Ch { my($k, $w) = @_; _c_M1Ch('$b', '$c', '$d', '$e', '$a', $k, $w) }
|
|
|
136 |
sub _c_M15Pa { my($k, $w) = @_; _c_M1Pa('$b', '$c', '$d', '$e', '$a', $k, $w) }
|
|
|
137 |
sub _c_M15Ma { my($k, $w) = @_; _c_M1Ma('$b', '$c', '$d', '$e', '$a', $k, $w) }
|
|
|
138 |
|
|
|
139 |
sub _c_W11 { my($s) = @_; '$W[' . (($s + 0) & 0xf) . ']' }
|
|
|
140 |
sub _c_W12 { my($s) = @_; '$W[' . (($s + 13) & 0xf) . ']' }
|
|
|
141 |
sub _c_W13 { my($s) = @_; '$W[' . (($s + 8) & 0xf) . ']' }
|
|
|
142 |
sub _c_W14 { my($s) = @_; '$W[' . (($s + 2) & 0xf) . ']' }
|
|
|
143 |
|
|
|
144 |
sub _c_A1 {
|
|
|
145 |
my($s) = @_;
|
|
|
146 |
my $tmp = _c_W11($s) . " ^ " . _c_W12($s) . " ^ " .
|
|
|
147 |
_c_W13($s) . " ^ " . _c_W14($s);
|
|
|
148 |
"((\$tmp = $tmp), (" . _c_W11($s) . " = " . _c_ROTL('$tmp', 1) . "))";
|
|
|
149 |
}
|
|
|
150 |
|
|
|
151 |
# The following code emulates the "sha1" routine from Digest::SHA sha.c
|
|
|
152 |
|
|
|
153 |
my $sha1_code = '
|
|
|
154 |
|
|
|
155 |
my($K1, $K2, $K3, $K4) = ( # SHA-1 constants
|
|
|
156 |
0x5a827999, 0x6ed9eba1, 0x8f1bbcdc, 0xca62c1d6
|
|
|
157 |
);
|
|
|
158 |
|
|
|
159 |
sub _sha1 {
|
|
|
160 |
my($self, $block) = @_;
|
|
|
161 |
my(@W, $a, $b, $c, $d, $e, $tmp);
|
|
|
162 |
|
|
|
163 |
@W = unpack("N16", $block);
|
|
|
164 |
($a, $b, $c, $d, $e) = @{$self->{H}};
|
|
|
165 |
' .
|
|
|
166 |
_c_M11Ch('$K1', '$W[ 0]' ) . _c_M12Ch('$K1', '$W[ 1]' ) .
|
|
|
167 |
_c_M13Ch('$K1', '$W[ 2]' ) . _c_M14Ch('$K1', '$W[ 3]' ) .
|
|
|
168 |
_c_M15Ch('$K1', '$W[ 4]' ) . _c_M11Ch('$K1', '$W[ 5]' ) .
|
|
|
169 |
_c_M12Ch('$K1', '$W[ 6]' ) . _c_M13Ch('$K1', '$W[ 7]' ) .
|
|
|
170 |
_c_M14Ch('$K1', '$W[ 8]' ) . _c_M15Ch('$K1', '$W[ 9]' ) .
|
|
|
171 |
_c_M11Ch('$K1', '$W[10]' ) . _c_M12Ch('$K1', '$W[11]' ) .
|
|
|
172 |
_c_M13Ch('$K1', '$W[12]' ) . _c_M14Ch('$K1', '$W[13]' ) .
|
|
|
173 |
_c_M15Ch('$K1', '$W[14]' ) . _c_M11Ch('$K1', '$W[15]' ) .
|
|
|
174 |
_c_M12Ch('$K1', _c_A1( 0) ) . _c_M13Ch('$K1', _c_A1( 1) ) .
|
|
|
175 |
_c_M14Ch('$K1', _c_A1( 2) ) . _c_M15Ch('$K1', _c_A1( 3) ) .
|
|
|
176 |
_c_M11Pa('$K2', _c_A1( 4) ) . _c_M12Pa('$K2', _c_A1( 5) ) .
|
|
|
177 |
_c_M13Pa('$K2', _c_A1( 6) ) . _c_M14Pa('$K2', _c_A1( 7) ) .
|
|
|
178 |
_c_M15Pa('$K2', _c_A1( 8) ) . _c_M11Pa('$K2', _c_A1( 9) ) .
|
|
|
179 |
_c_M12Pa('$K2', _c_A1(10) ) . _c_M13Pa('$K2', _c_A1(11) ) .
|
|
|
180 |
_c_M14Pa('$K2', _c_A1(12) ) . _c_M15Pa('$K2', _c_A1(13) ) .
|
|
|
181 |
_c_M11Pa('$K2', _c_A1(14) ) . _c_M12Pa('$K2', _c_A1(15) ) .
|
|
|
182 |
_c_M13Pa('$K2', _c_A1( 0) ) . _c_M14Pa('$K2', _c_A1( 1) ) .
|
|
|
183 |
_c_M15Pa('$K2', _c_A1( 2) ) . _c_M11Pa('$K2', _c_A1( 3) ) .
|
|
|
184 |
_c_M12Pa('$K2', _c_A1( 4) ) . _c_M13Pa('$K2', _c_A1( 5) ) .
|
|
|
185 |
_c_M14Pa('$K2', _c_A1( 6) ) . _c_M15Pa('$K2', _c_A1( 7) ) .
|
|
|
186 |
_c_M11Ma('$K3', _c_A1( 8) ) . _c_M12Ma('$K3', _c_A1( 9) ) .
|
|
|
187 |
_c_M13Ma('$K3', _c_A1(10) ) . _c_M14Ma('$K3', _c_A1(11) ) .
|
|
|
188 |
_c_M15Ma('$K3', _c_A1(12) ) . _c_M11Ma('$K3', _c_A1(13) ) .
|
|
|
189 |
_c_M12Ma('$K3', _c_A1(14) ) . _c_M13Ma('$K3', _c_A1(15) ) .
|
|
|
190 |
_c_M14Ma('$K3', _c_A1( 0) ) . _c_M15Ma('$K3', _c_A1( 1) ) .
|
|
|
191 |
_c_M11Ma('$K3', _c_A1( 2) ) . _c_M12Ma('$K3', _c_A1( 3) ) .
|
|
|
192 |
_c_M13Ma('$K3', _c_A1( 4) ) . _c_M14Ma('$K3', _c_A1( 5) ) .
|
|
|
193 |
_c_M15Ma('$K3', _c_A1( 6) ) . _c_M11Ma('$K3', _c_A1( 7) ) .
|
|
|
194 |
_c_M12Ma('$K3', _c_A1( 8) ) . _c_M13Ma('$K3', _c_A1( 9) ) .
|
|
|
195 |
_c_M14Ma('$K3', _c_A1(10) ) . _c_M15Ma('$K3', _c_A1(11) ) .
|
|
|
196 |
_c_M11Pa('$K4', _c_A1(12) ) . _c_M12Pa('$K4', _c_A1(13) ) .
|
|
|
197 |
_c_M13Pa('$K4', _c_A1(14) ) . _c_M14Pa('$K4', _c_A1(15) ) .
|
|
|
198 |
_c_M15Pa('$K4', _c_A1( 0) ) . _c_M11Pa('$K4', _c_A1( 1) ) .
|
|
|
199 |
_c_M12Pa('$K4', _c_A1( 2) ) . _c_M13Pa('$K4', _c_A1( 3) ) .
|
|
|
200 |
_c_M14Pa('$K4', _c_A1( 4) ) . _c_M15Pa('$K4', _c_A1( 5) ) .
|
|
|
201 |
_c_M11Pa('$K4', _c_A1( 6) ) . _c_M12Pa('$K4', _c_A1( 7) ) .
|
|
|
202 |
_c_M13Pa('$K4', _c_A1( 8) ) . _c_M14Pa('$K4', _c_A1( 9) ) .
|
|
|
203 |
_c_M15Pa('$K4', _c_A1(10) ) . _c_M11Pa('$K4', _c_A1(11) ) .
|
|
|
204 |
_c_M12Pa('$K4', _c_A1(12) ) . _c_M13Pa('$K4', _c_A1(13) ) .
|
|
|
205 |
_c_M14Pa('$K4', _c_A1(14) ) . _c_M15Pa('$K4', _c_A1(15) ) .
|
|
|
206 |
|
|
|
207 |
' $self->{H}->[0] += $a; $self->{H}->[1] += $b; $self->{H}->[2] += $c;
|
|
|
208 |
$self->{H}->[3] += $d; $self->{H}->[4] += $e;
|
|
|
209 |
}
|
|
|
210 |
';
|
|
|
211 |
|
|
|
212 |
eval($sha1_code);
|
|
|
213 |
|
|
|
214 |
sub _c_M2 { # ref. Digest::SHA sha.c (sha256 routine)
|
|
|
215 |
my($a, $b, $c, $d, $e, $f, $g, $h, $w) = @_;
|
|
|
216 |
"\$T1 = $h + " . _c_SIGMA1($e) . " + " . _c_Ch($e, $f, $g) .
|
|
|
217 |
" + \$K256[\$i++] + $w; $h = \$T1 + " . _c_SIGMA0($a) .
|
|
|
218 |
" + " . _c_Ma($a, $b, $c) . "; $d += \$T1;\n";
|
|
|
219 |
}
|
|
|
220 |
|
|
|
221 |
sub _c_M21 { _c_M2('$a', '$b', '$c', '$d', '$e', '$f', '$g', '$h', $_[0]) }
|
|
|
222 |
sub _c_M22 { _c_M2('$h', '$a', '$b', '$c', '$d', '$e', '$f', '$g', $_[0]) }
|
|
|
223 |
sub _c_M23 { _c_M2('$g', '$h', '$a', '$b', '$c', '$d', '$e', '$f', $_[0]) }
|
|
|
224 |
sub _c_M24 { _c_M2('$f', '$g', '$h', '$a', '$b', '$c', '$d', '$e', $_[0]) }
|
|
|
225 |
sub _c_M25 { _c_M2('$e', '$f', '$g', '$h', '$a', '$b', '$c', '$d', $_[0]) }
|
|
|
226 |
sub _c_M26 { _c_M2('$d', '$e', '$f', '$g', '$h', '$a', '$b', '$c', $_[0]) }
|
|
|
227 |
sub _c_M27 { _c_M2('$c', '$d', '$e', '$f', '$g', '$h', '$a', '$b', $_[0]) }
|
|
|
228 |
sub _c_M28 { _c_M2('$b', '$c', '$d', '$e', '$f', '$g', '$h', '$a', $_[0]) }
|
|
|
229 |
|
|
|
230 |
sub _c_W21 { my($s) = @_; '$W[' . (($s + 0) & 0xf) . ']' }
|
|
|
231 |
sub _c_W22 { my($s) = @_; '$W[' . (($s + 14) & 0xf) . ']' }
|
|
|
232 |
sub _c_W23 { my($s) = @_; '$W[' . (($s + 9) & 0xf) . ']' }
|
|
|
233 |
sub _c_W24 { my($s) = @_; '$W[' . (($s + 1) & 0xf) . ']' }
|
|
|
234 |
|
|
|
235 |
sub _c_A2 {
|
|
|
236 |
my($s) = @_;
|
|
|
237 |
"(" . _c_W21($s) . " += " . _c_sigma1(_c_W22($s)) . " + " .
|
|
|
238 |
_c_W23($s) . " + " . _c_sigma0(_c_W24($s)) . ")";
|
|
|
239 |
}
|
|
|
240 |
|
|
|
241 |
# The following code emulates the "sha256" routine from Digest::SHA sha.c
|
|
|
242 |
|
|
|
243 |
my $sha256_code = '
|
|
|
244 |
|
|
|
245 |
my @K256 = ( # SHA-224/256 constants
|
|
|
246 |
0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5,
|
|
|
247 |
0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5,
|
|
|
248 |
0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3,
|
|
|
249 |
0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174,
|
|
|
250 |
0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc,
|
|
|
251 |
0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da,
|
|
|
252 |
0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7,
|
|
|
253 |
0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967,
|
|
|
254 |
0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13,
|
|
|
255 |
0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85,
|
|
|
256 |
0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3,
|
|
|
257 |
0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070,
|
|
|
258 |
0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5,
|
|
|
259 |
0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3,
|
|
|
260 |
0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208,
|
|
|
261 |
0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2
|
|
|
262 |
);
|
|
|
263 |
|
|
|
264 |
sub _sha256 {
|
|
|
265 |
my($self, $block) = @_;
|
|
|
266 |
my(@W, $a, $b, $c, $d, $e, $f, $g, $h, $i, $T1);
|
|
|
267 |
|
|
|
268 |
@W = unpack("N16", $block);
|
|
|
269 |
($a, $b, $c, $d, $e, $f, $g, $h) = @{$self->{H}};
|
|
|
270 |
' .
|
|
|
271 |
_c_M21('$W[ 0]' ) . _c_M22('$W[ 1]' ) . _c_M23('$W[ 2]' ) .
|
|
|
272 |
_c_M24('$W[ 3]' ) . _c_M25('$W[ 4]' ) . _c_M26('$W[ 5]' ) .
|
|
|
273 |
_c_M27('$W[ 6]' ) . _c_M28('$W[ 7]' ) . _c_M21('$W[ 8]' ) .
|
|
|
274 |
_c_M22('$W[ 9]' ) . _c_M23('$W[10]' ) . _c_M24('$W[11]' ) .
|
|
|
275 |
_c_M25('$W[12]' ) . _c_M26('$W[13]' ) . _c_M27('$W[14]' ) .
|
|
|
276 |
_c_M28('$W[15]' ) .
|
|
|
277 |
_c_M21(_c_A2( 0)) . _c_M22(_c_A2( 1)) . _c_M23(_c_A2( 2)) .
|
|
|
278 |
_c_M24(_c_A2( 3)) . _c_M25(_c_A2( 4)) . _c_M26(_c_A2( 5)) .
|
|
|
279 |
_c_M27(_c_A2( 6)) . _c_M28(_c_A2( 7)) . _c_M21(_c_A2( 8)) .
|
|
|
280 |
_c_M22(_c_A2( 9)) . _c_M23(_c_A2(10)) . _c_M24(_c_A2(11)) .
|
|
|
281 |
_c_M25(_c_A2(12)) . _c_M26(_c_A2(13)) . _c_M27(_c_A2(14)) .
|
|
|
282 |
_c_M28(_c_A2(15)) . _c_M21(_c_A2( 0)) . _c_M22(_c_A2( 1)) .
|
|
|
283 |
_c_M23(_c_A2( 2)) . _c_M24(_c_A2( 3)) . _c_M25(_c_A2( 4)) .
|
|
|
284 |
_c_M26(_c_A2( 5)) . _c_M27(_c_A2( 6)) . _c_M28(_c_A2( 7)) .
|
|
|
285 |
_c_M21(_c_A2( 8)) . _c_M22(_c_A2( 9)) . _c_M23(_c_A2(10)) .
|
|
|
286 |
_c_M24(_c_A2(11)) . _c_M25(_c_A2(12)) . _c_M26(_c_A2(13)) .
|
|
|
287 |
_c_M27(_c_A2(14)) . _c_M28(_c_A2(15)) . _c_M21(_c_A2( 0)) .
|
|
|
288 |
_c_M22(_c_A2( 1)) . _c_M23(_c_A2( 2)) . _c_M24(_c_A2( 3)) .
|
|
|
289 |
_c_M25(_c_A2( 4)) . _c_M26(_c_A2( 5)) . _c_M27(_c_A2( 6)) .
|
|
|
290 |
_c_M28(_c_A2( 7)) . _c_M21(_c_A2( 8)) . _c_M22(_c_A2( 9)) .
|
|
|
291 |
_c_M23(_c_A2(10)) . _c_M24(_c_A2(11)) . _c_M25(_c_A2(12)) .
|
|
|
292 |
_c_M26(_c_A2(13)) . _c_M27(_c_A2(14)) . _c_M28(_c_A2(15)) .
|
|
|
293 |
|
|
|
294 |
' $self->{H}->[0] += $a; $self->{H}->[1] += $b; $self->{H}->[2] += $c;
|
|
|
295 |
$self->{H}->[3] += $d; $self->{H}->[4] += $e; $self->{H}->[5] += $f;
|
|
|
296 |
$self->{H}->[6] += $g; $self->{H}->[7] += $h;
|
|
|
297 |
}
|
|
|
298 |
';
|
|
|
299 |
|
|
|
300 |
eval($sha256_code);
|
|
|
301 |
|
|
|
302 |
sub _sha512_placeholder { return }
|
|
|
303 |
my $sha512 = \&_sha512_placeholder;
|
|
|
304 |
|
|
|
305 |
my $_64bit_code = '
|
|
|
306 |
|
|
|
307 |
no warnings qw(portable);
|
|
|
308 |
|
|
|
309 |
my @K512 = (
|
|
|
310 |
0x428a2f98d728ae22, 0x7137449123ef65cd, 0xb5c0fbcfec4d3b2f,
|
|
|
311 |
0xe9b5dba58189dbbc, 0x3956c25bf348b538, 0x59f111f1b605d019,
|
|
|
312 |
0x923f82a4af194f9b, 0xab1c5ed5da6d8118, 0xd807aa98a3030242,
|
|
|
313 |
0x12835b0145706fbe, 0x243185be4ee4b28c, 0x550c7dc3d5ffb4e2,
|
|
|
314 |
0x72be5d74f27b896f, 0x80deb1fe3b1696b1, 0x9bdc06a725c71235,
|
|
|
315 |
0xc19bf174cf692694, 0xe49b69c19ef14ad2, 0xefbe4786384f25e3,
|
|
|
316 |
0x0fc19dc68b8cd5b5, 0x240ca1cc77ac9c65, 0x2de92c6f592b0275,
|
|
|
317 |
0x4a7484aa6ea6e483, 0x5cb0a9dcbd41fbd4, 0x76f988da831153b5,
|
|
|
318 |
0x983e5152ee66dfab, 0xa831c66d2db43210, 0xb00327c898fb213f,
|
|
|
319 |
0xbf597fc7beef0ee4, 0xc6e00bf33da88fc2, 0xd5a79147930aa725,
|
|
|
320 |
0x06ca6351e003826f, 0x142929670a0e6e70, 0x27b70a8546d22ffc,
|
|
|
321 |
0x2e1b21385c26c926, 0x4d2c6dfc5ac42aed, 0x53380d139d95b3df,
|
|
|
322 |
0x650a73548baf63de, 0x766a0abb3c77b2a8, 0x81c2c92e47edaee6,
|
|
|
323 |
0x92722c851482353b, 0xa2bfe8a14cf10364, 0xa81a664bbc423001,
|
|
|
324 |
0xc24b8b70d0f89791, 0xc76c51a30654be30, 0xd192e819d6ef5218,
|
|
|
325 |
0xd69906245565a910, 0xf40e35855771202a, 0x106aa07032bbd1b8,
|
|
|
326 |
0x19a4c116b8d2d0c8, 0x1e376c085141ab53, 0x2748774cdf8eeb99,
|
|
|
327 |
0x34b0bcb5e19b48a8, 0x391c0cb3c5c95a63, 0x4ed8aa4ae3418acb,
|
|
|
328 |
0x5b9cca4f7763e373, 0x682e6ff3d6b2b8a3, 0x748f82ee5defb2fc,
|
|
|
329 |
0x78a5636f43172f60, 0x84c87814a1f0ab72, 0x8cc702081a6439ec,
|
|
|
330 |
0x90befffa23631e28, 0xa4506cebde82bde9, 0xbef9a3f7b2c67915,
|
|
|
331 |
0xc67178f2e372532b, 0xca273eceea26619c, 0xd186b8c721c0c207,
|
|
|
332 |
0xeada7dd6cde0eb1e, 0xf57d4f7fee6ed178, 0x06f067aa72176fba,
|
|
|
333 |
0x0a637dc5a2c898a6, 0x113f9804bef90dae, 0x1b710b35131c471b,
|
|
|
334 |
0x28db77f523047d84, 0x32caab7b40c72493, 0x3c9ebe0a15c9bebc,
|
|
|
335 |
0x431d67c49c100d4c, 0x4cc5d4becb3e42b6, 0x597f299cfc657e2a,
|
|
|
336 |
0x5fcb6fab3ad6faec, 0x6c44198c4a475817);
|
|
|
337 |
|
|
|
338 |
@H0384 = (
|
|
|
339 |
0xcbbb9d5dc1059ed8, 0x629a292a367cd507, 0x9159015a3070dd17,
|
|
|
340 |
0x152fecd8f70e5939, 0x67332667ffc00b31, 0x8eb44a8768581511,
|
|
|
341 |
0xdb0c2e0d64f98fa7, 0x47b5481dbefa4fa4);
|
|
|
342 |
|
|
|
343 |
@H0512 = (
|
|
|
344 |
0x6a09e667f3bcc908, 0xbb67ae8584caa73b, 0x3c6ef372fe94f82b,
|
|
|
345 |
0xa54ff53a5f1d36f1, 0x510e527fade682d1, 0x9b05688c2b3e6c1f,
|
|
|
346 |
0x1f83d9abfb41bd6b, 0x5be0cd19137e2179);
|
|
|
347 |
|
|
|
348 |
@H0512224 = (
|
|
|
349 |
0x8c3d37c819544da2, 0x73e1996689dcd4d6, 0x1dfab7ae32ff9c82,
|
|
|
350 |
0x679dd514582f9fcf, 0x0f6d2b697bd44da8, 0x77e36f7304c48942,
|
|
|
351 |
0x3f9d85a86a1d36c8, 0x1112e6ad91d692a1);
|
|
|
352 |
|
|
|
353 |
@H0512256 = (
|
|
|
354 |
0x22312194fc2bf72c, 0x9f555fa3c84c64c2, 0x2393b86b6f53b151,
|
|
|
355 |
0x963877195940eabd, 0x96283ee2a88effe3, 0xbe5e1e2553863992,
|
|
|
356 |
0x2b0199fc2c85b8aa, 0x0eb72ddc81c52ca2);
|
|
|
357 |
|
|
|
358 |
use warnings;
|
|
|
359 |
|
|
|
360 |
sub _c_SL64 { my($x, $n) = @_; "($x << $n)" }
|
|
|
361 |
|
|
|
362 |
sub _c_SR64 {
|
|
|
363 |
my($x, $n) = @_;
|
|
|
364 |
my $mask = (1 << (64 - $n)) - 1;
|
|
|
365 |
"(($x >> $n) & $mask)";
|
|
|
366 |
}
|
|
|
367 |
|
|
|
368 |
sub _c_ROTRQ {
|
|
|
369 |
my($x, $n) = @_;
|
|
|
370 |
"(" . _c_SR64($x, $n) . " | " . _c_SL64($x, 64 - $n) . ")";
|
|
|
371 |
}
|
|
|
372 |
|
|
|
373 |
sub _c_SIGMAQ0 {
|
|
|
374 |
my($x) = @_;
|
|
|
375 |
"(" . _c_ROTRQ($x, 28) . " ^ " . _c_ROTRQ($x, 34) . " ^ " .
|
|
|
376 |
_c_ROTRQ($x, 39) . ")";
|
|
|
377 |
}
|
|
|
378 |
|
|
|
379 |
sub _c_SIGMAQ1 {
|
|
|
380 |
my($x) = @_;
|
|
|
381 |
"(" . _c_ROTRQ($x, 14) . " ^ " . _c_ROTRQ($x, 18) . " ^ " .
|
|
|
382 |
_c_ROTRQ($x, 41) . ")";
|
|
|
383 |
}
|
|
|
384 |
|
|
|
385 |
sub _c_sigmaQ0 {
|
|
|
386 |
my($x) = @_;
|
|
|
387 |
"(" . _c_ROTRQ($x, 1) . " ^ " . _c_ROTRQ($x, 8) . " ^ " .
|
|
|
388 |
_c_SR64($x, 7) . ")";
|
|
|
389 |
}
|
|
|
390 |
|
|
|
391 |
sub _c_sigmaQ1 {
|
|
|
392 |
my($x) = @_;
|
|
|
393 |
"(" . _c_ROTRQ($x, 19) . " ^ " . _c_ROTRQ($x, 61) . " ^ " .
|
|
|
394 |
_c_SR64($x, 6) . ")";
|
|
|
395 |
}
|
|
|
396 |
|
|
|
397 |
my $sha512_code = q/
|
|
|
398 |
sub _sha512 {
|
|
|
399 |
my($self, $block) = @_;
|
|
|
400 |
my(@N, @W, $a, $b, $c, $d, $e, $f, $g, $h, $T1, $T2);
|
|
|
401 |
|
|
|
402 |
@N = unpack("N32", $block);
|
|
|
403 |
($a, $b, $c, $d, $e, $f, $g, $h) = @{$self->{H}};
|
|
|
404 |
for ( 0 .. 15) { $W[$_] = (($N[2*$_] << 16) << 16) | $N[2*$_+1] }
|
|
|
405 |
for (16 .. 79) { $W[$_] = / .
|
|
|
406 |
_c_sigmaQ1(q/$W[$_- 2]/) . q/ + $W[$_- 7] + / .
|
|
|
407 |
_c_sigmaQ0(q/$W[$_-15]/) . q/ + $W[$_-16] }
|
|
|
408 |
for ( 0 .. 79) {
|
|
|
409 |
$T1 = $h + / . _c_SIGMAQ1(q/$e/) .
|
|
|
410 |
q/ + (($g) ^ (($e) & (($f) ^ ($g)))) +
|
|
|
411 |
$K512[$_] + $W[$_];
|
|
|
412 |
$T2 = / . _c_SIGMAQ0(q/$a/) .
|
|
|
413 |
q/ + ((($a) & ($b)) | (($c) & (($a) | ($b))));
|
|
|
414 |
$h = $g; $g = $f; $f = $e; $e = $d + $T1;
|
|
|
415 |
$d = $c; $c = $b; $b = $a; $a = $T1 + $T2;
|
|
|
416 |
}
|
|
|
417 |
$self->{H}->[0] += $a; $self->{H}->[1] += $b; $self->{H}->[2] += $c;
|
|
|
418 |
$self->{H}->[3] += $d; $self->{H}->[4] += $e; $self->{H}->[5] += $f;
|
|
|
419 |
$self->{H}->[6] += $g; $self->{H}->[7] += $h;
|
|
|
420 |
}
|
|
|
421 |
/;
|
|
|
422 |
|
|
|
423 |
eval($sha512_code);
|
|
|
424 |
$sha512 = \&_sha512;
|
|
|
425 |
|
|
|
426 |
';
|
|
|
427 |
|
|
|
428 |
eval($_64bit_code) if $uses64bit;
|
|
|
429 |
|
|
|
430 |
sub _SETBIT {
|
|
|
431 |
my($self, $pos) = @_;
|
|
|
432 |
my @c = unpack("C*", $self->{block});
|
|
|
433 |
$c[$pos >> 3] = 0x00 unless defined $c[$pos >> 3];
|
|
|
434 |
$c[$pos >> 3] |= (0x01 << (7 - $pos % 8));
|
|
|
435 |
$self->{block} = pack("C*", @c);
|
|
|
436 |
}
|
|
|
437 |
|
|
|
438 |
sub _CLRBIT {
|
|
|
439 |
my($self, $pos) = @_;
|
|
|
440 |
my @c = unpack("C*", $self->{block});
|
|
|
441 |
$c[$pos >> 3] = 0x00 unless defined $c[$pos >> 3];
|
|
|
442 |
$c[$pos >> 3] &= ~(0x01 << (7 - $pos % 8));
|
|
|
443 |
$self->{block} = pack("C*", @c);
|
|
|
444 |
}
|
|
|
445 |
|
|
|
446 |
sub _BYTECNT {
|
|
|
447 |
my($bitcnt) = @_;
|
|
|
448 |
$bitcnt > 0 ? 1 + (($bitcnt - 1) >> 3) : 0;
|
|
|
449 |
}
|
|
|
450 |
|
|
|
451 |
sub _digcpy {
|
|
|
452 |
my($self) = @_;
|
|
|
453 |
my @dig;
|
|
|
454 |
for (@{$self->{H}}) {
|
|
|
455 |
push(@dig, (($_>>16)>>16) & $MAX32) if $self->{alg} >= 384;
|
|
|
456 |
push(@dig, $_ & $MAX32);
|
|
|
457 |
}
|
|
|
458 |
$self->{digest} = pack("N" . ($self->{digestlen}>>2), @dig);
|
|
|
459 |
}
|
|
|
460 |
|
|
|
461 |
sub _sharewind {
|
|
|
462 |
my($self) = @_;
|
|
|
463 |
my $alg = $self->{alg};
|
|
|
464 |
$self->{block} = ""; $self->{blockcnt} = 0;
|
|
|
465 |
$self->{blocksize} = $alg <= 256 ? 512 : 1024;
|
|
|
466 |
for (qw(lenll lenlh lenhl lenhh)) { $self->{$_} = 0 }
|
|
|
467 |
$self->{digestlen} = $alg == 1 ? 20 : ($alg % 1000)/8;
|
|
|
468 |
if ($alg == 1) { $self->{sha} = \&_sha1; $self->{H} = [@H01] }
|
|
|
469 |
elsif ($alg == 224) { $self->{sha} = \&_sha256; $self->{H} = [@H0224] }
|
|
|
470 |
elsif ($alg == 256) { $self->{sha} = \&_sha256; $self->{H} = [@H0256] }
|
|
|
471 |
elsif ($alg == 384) { $self->{sha} = $sha512; $self->{H} = [@H0384] }
|
|
|
472 |
elsif ($alg == 512) { $self->{sha} = $sha512; $self->{H} = [@H0512] }
|
|
|
473 |
elsif ($alg == 512224) { $self->{sha}=$sha512; $self->{H}=[@H0512224] }
|
|
|
474 |
elsif ($alg == 512256) { $self->{sha}=$sha512; $self->{H}=[@H0512256] }
|
|
|
475 |
push(@{$self->{H}}, 0) while scalar(@{$self->{H}}) < 8;
|
|
|
476 |
$self;
|
|
|
477 |
}
|
|
|
478 |
|
|
|
479 |
sub _shaopen {
|
|
|
480 |
my($alg) = @_;
|
|
|
481 |
my($self);
|
|
|
482 |
return unless grep { $alg == $_ } (1,224,256,384,512,512224,512256);
|
|
|
483 |
return if ($alg >= 384 && !$uses64bit);
|
|
|
484 |
$self->{alg} = $alg;
|
|
|
485 |
_sharewind($self);
|
|
|
486 |
}
|
|
|
487 |
|
|
|
488 |
sub _shadirect {
|
|
|
489 |
my($bitstr, $bitcnt, $self) = @_;
|
|
|
490 |
my $savecnt = $bitcnt;
|
|
|
491 |
my $offset = 0;
|
|
|
492 |
my $blockbytes = $self->{blocksize} >> 3;
|
|
|
493 |
while ($bitcnt >= $self->{blocksize}) {
|
|
|
494 |
&{$self->{sha}}($self, substr($bitstr, $offset, $blockbytes));
|
|
|
495 |
$offset += $blockbytes;
|
|
|
496 |
$bitcnt -= $self->{blocksize};
|
|
|
497 |
}
|
|
|
498 |
if ($bitcnt > 0) {
|
|
|
499 |
$self->{block} = substr($bitstr, $offset, _BYTECNT($bitcnt));
|
|
|
500 |
$self->{blockcnt} = $bitcnt;
|
|
|
501 |
}
|
|
|
502 |
$savecnt;
|
|
|
503 |
}
|
|
|
504 |
|
|
|
505 |
sub _shabytes {
|
|
|
506 |
my($bitstr, $bitcnt, $self) = @_;
|
|
|
507 |
my($numbits);
|
|
|
508 |
my $savecnt = $bitcnt;
|
|
|
509 |
if ($self->{blockcnt} + $bitcnt >= $self->{blocksize}) {
|
|
|
510 |
$numbits = $self->{blocksize} - $self->{blockcnt};
|
|
|
511 |
$self->{block} .= substr($bitstr, 0, $numbits >> 3);
|
|
|
512 |
$bitcnt -= $numbits;
|
|
|
513 |
$bitstr = substr($bitstr, $numbits >> 3, _BYTECNT($bitcnt));
|
|
|
514 |
&{$self->{sha}}($self, $self->{block});
|
|
|
515 |
$self->{block} = "";
|
|
|
516 |
$self->{blockcnt} = 0;
|
|
|
517 |
_shadirect($bitstr, $bitcnt, $self);
|
|
|
518 |
}
|
|
|
519 |
else {
|
|
|
520 |
$self->{block} .= substr($bitstr, 0, _BYTECNT($bitcnt));
|
|
|
521 |
$self->{blockcnt} += $bitcnt;
|
|
|
522 |
}
|
|
|
523 |
$savecnt;
|
|
|
524 |
}
|
|
|
525 |
|
|
|
526 |
sub _shabits {
|
|
|
527 |
my($bitstr, $bitcnt, $self) = @_;
|
|
|
528 |
my($i, @buf);
|
|
|
529 |
my $numbytes = _BYTECNT($bitcnt);
|
|
|
530 |
my $savecnt = $bitcnt;
|
|
|
531 |
my $gap = 8 - $self->{blockcnt} % 8;
|
|
|
532 |
my @c = unpack("C*", $self->{block});
|
|
|
533 |
my @b = unpack("C" . $numbytes, $bitstr);
|
|
|
534 |
$c[$self->{blockcnt}>>3] &= (~0 << $gap);
|
|
|
535 |
$c[$self->{blockcnt}>>3] |= $b[0] >> (8 - $gap);
|
|
|
536 |
$self->{block} = pack("C*", @c);
|
|
|
537 |
$self->{blockcnt} += ($bitcnt < $gap) ? $bitcnt : $gap;
|
|
|
538 |
return($savecnt) if $bitcnt < $gap;
|
|
|
539 |
if ($self->{blockcnt} == $self->{blocksize}) {
|
|
|
540 |
&{$self->{sha}}($self, $self->{block});
|
|
|
541 |
$self->{block} = "";
|
|
|
542 |
$self->{blockcnt} = 0;
|
|
|
543 |
}
|
|
|
544 |
return($savecnt) if ($bitcnt -= $gap) == 0;
|
|
|
545 |
for ($i = 0; $i < $numbytes - 1; $i++) {
|
|
|
546 |
$buf[$i] = (($b[$i] << $gap) & 0xff) | ($b[$i+1] >> (8 - $gap));
|
|
|
547 |
}
|
|
|
548 |
$buf[$numbytes-1] = ($b[$numbytes-1] << $gap) & 0xff;
|
|
|
549 |
_shabytes(pack("C*", @buf), $bitcnt, $self);
|
|
|
550 |
$savecnt;
|
|
|
551 |
}
|
|
|
552 |
|
|
|
553 |
sub _shawrite {
|
|
|
554 |
my($bitstr, $bitcnt, $self) = @_;
|
|
|
555 |
return(0) unless $bitcnt > 0;
|
|
|
556 |
no integer;
|
|
|
557 |
my $TWO32 = 4294967296;
|
|
|
558 |
if (($self->{lenll} += $bitcnt) >= $TWO32) {
|
|
|
559 |
$self->{lenll} -= $TWO32;
|
|
|
560 |
if (++$self->{lenlh} >= $TWO32) {
|
|
|
561 |
$self->{lenlh} -= $TWO32;
|
|
|
562 |
if (++$self->{lenhl} >= $TWO32) {
|
|
|
563 |
$self->{lenhl} -= $TWO32;
|
|
|
564 |
if (++$self->{lenhh} >= $TWO32) {
|
|
|
565 |
$self->{lenhh} -= $TWO32;
|
|
|
566 |
}
|
|
|
567 |
}
|
|
|
568 |
}
|
|
|
569 |
}
|
|
|
570 |
use integer;
|
|
|
571 |
my $blockcnt = $self->{blockcnt};
|
|
|
572 |
return(_shadirect($bitstr, $bitcnt, $self)) if $blockcnt == 0;
|
|
|
573 |
return(_shabytes ($bitstr, $bitcnt, $self)) if $blockcnt % 8 == 0;
|
|
|
574 |
return(_shabits ($bitstr, $bitcnt, $self));
|
|
|
575 |
}
|
|
|
576 |
|
|
|
577 |
my $no_downgrade = 'sub utf8::downgrade { 1 }';
|
|
|
578 |
|
|
|
579 |
my $pp_downgrade = q {
|
|
|
580 |
sub utf8::downgrade {
|
|
|
581 |
|
|
|
582 |
# No need to downgrade if character and byte
|
|
|
583 |
# semantics are equivalent. But this might
|
|
|
584 |
# leave the UTF-8 flag set, harmlessly.
|
|
|
585 |
|
|
|
586 |
require bytes;
|
|
|
587 |
return 1 if length($_[0]) == bytes::length($_[0]);
|
|
|
588 |
|
|
|
589 |
use utf8;
|
|
|
590 |
return 0 if $_[0] =~ /[^\x00-\xff]/;
|
|
|
591 |
$_[0] = pack('C*', unpack('U*', $_[0]));
|
|
|
592 |
return 1;
|
|
|
593 |
}
|
|
|
594 |
};
|
|
|
595 |
|
|
|
596 |
{
|
|
|
597 |
no integer;
|
|
|
598 |
|
|
|
599 |
if ($] < 5.006) { eval $no_downgrade }
|
|
|
600 |
elsif ($] < 5.008) { eval $pp_downgrade }
|
|
|
601 |
}
|
|
|
602 |
|
|
|
603 |
my $WSE = 'Wide character in subroutine entry';
|
|
|
604 |
my $MWS = 16384;
|
|
|
605 |
|
|
|
606 |
sub _shaWrite {
|
|
|
607 |
my($bytestr_r, $bytecnt, $self) = @_;
|
|
|
608 |
return(0) unless $bytecnt > 0;
|
|
|
609 |
croak $WSE unless utf8::downgrade($$bytestr_r, 1);
|
|
|
610 |
return(_shawrite($$bytestr_r, $bytecnt<<3, $self)) if $bytecnt <= $MWS;
|
|
|
611 |
my $offset = 0;
|
|
|
612 |
while ($bytecnt > $MWS) {
|
|
|
613 |
_shawrite(substr($$bytestr_r, $offset, $MWS), $MWS<<3, $self);
|
|
|
614 |
$offset += $MWS;
|
|
|
615 |
$bytecnt -= $MWS;
|
|
|
616 |
}
|
|
|
617 |
_shawrite(substr($$bytestr_r, $offset, $bytecnt), $bytecnt<<3, $self);
|
|
|
618 |
}
|
|
|
619 |
|
|
|
620 |
sub _shafinish {
|
|
|
621 |
my($self) = @_;
|
|
|
622 |
my $LENPOS = $self->{alg} <= 256 ? 448 : 896;
|
|
|
623 |
_SETBIT($self, $self->{blockcnt}++);
|
|
|
624 |
while ($self->{blockcnt} > $LENPOS) {
|
|
|
625 |
if ($self->{blockcnt} < $self->{blocksize}) {
|
|
|
626 |
_CLRBIT($self, $self->{blockcnt}++);
|
|
|
627 |
}
|
|
|
628 |
else {
|
|
|
629 |
&{$self->{sha}}($self, $self->{block});
|
|
|
630 |
$self->{block} = "";
|
|
|
631 |
$self->{blockcnt} = 0;
|
|
|
632 |
}
|
|
|
633 |
}
|
|
|
634 |
while ($self->{blockcnt} < $LENPOS) {
|
|
|
635 |
_CLRBIT($self, $self->{blockcnt}++);
|
|
|
636 |
}
|
|
|
637 |
if ($self->{blocksize} > 512) {
|
|
|
638 |
$self->{block} .= pack("N", $self->{lenhh} & $MAX32);
|
|
|
639 |
$self->{block} .= pack("N", $self->{lenhl} & $MAX32);
|
|
|
640 |
}
|
|
|
641 |
$self->{block} .= pack("N", $self->{lenlh} & $MAX32);
|
|
|
642 |
$self->{block} .= pack("N", $self->{lenll} & $MAX32);
|
|
|
643 |
&{$self->{sha}}($self, $self->{block});
|
|
|
644 |
}
|
|
|
645 |
|
|
|
646 |
sub _shadigest { my($self) = @_; _digcpy($self); $self->{digest} }
|
|
|
647 |
|
|
|
648 |
sub _shahex {
|
|
|
649 |
my($self) = @_;
|
|
|
650 |
_digcpy($self);
|
|
|
651 |
join("", unpack("H*", $self->{digest}));
|
|
|
652 |
}
|
|
|
653 |
|
|
|
654 |
sub _shabase64 {
|
|
|
655 |
my($self) = @_;
|
|
|
656 |
_digcpy($self);
|
|
|
657 |
my $b64 = pack("u", $self->{digest});
|
|
|
658 |
$b64 =~ s/^.//mg;
|
|
|
659 |
$b64 =~ s/\n//g;
|
|
|
660 |
$b64 =~ tr|` -_|AA-Za-z0-9+/|;
|
|
|
661 |
my $numpads = (3 - length($self->{digest}) % 3) % 3;
|
|
|
662 |
$b64 =~ s/.{$numpads}$// if $numpads;
|
|
|
663 |
$b64;
|
|
|
664 |
}
|
|
|
665 |
|
|
|
666 |
sub _shadsize { my($self) = @_; $self->{digestlen} }
|
|
|
667 |
|
|
|
668 |
sub _shacpy {
|
|
|
669 |
my($to, $from) = @_;
|
|
|
670 |
$to->{alg} = $from->{alg};
|
|
|
671 |
$to->{sha} = $from->{sha};
|
|
|
672 |
$to->{H} = [@{$from->{H}}];
|
|
|
673 |
$to->{block} = $from->{block};
|
|
|
674 |
$to->{blockcnt} = $from->{blockcnt};
|
|
|
675 |
$to->{blocksize} = $from->{blocksize};
|
|
|
676 |
for (qw(lenhh lenhl lenlh lenll)) { $to->{$_} = $from->{$_} }
|
|
|
677 |
$to->{digestlen} = $from->{digestlen};
|
|
|
678 |
$to;
|
|
|
679 |
}
|
|
|
680 |
|
|
|
681 |
sub _shadup { my($self) = @_; my($copy); _shacpy($copy, $self) }
|
|
|
682 |
|
|
|
683 |
sub _shadump {
|
|
|
684 |
my $self = shift;
|
|
|
685 |
for (qw(alg H block blockcnt lenhh lenhl lenlh lenll)) {
|
|
|
686 |
return unless defined $self->{$_};
|
|
|
687 |
}
|
|
|
688 |
|
|
|
689 |
my @state = ();
|
|
|
690 |
my $fmt = ($self->{alg} <= 256 ? "%08x" : "%016x");
|
|
|
691 |
|
|
|
692 |
push(@state, "alg:" . $self->{alg});
|
|
|
693 |
|
|
|
694 |
my @H = map { $self->{alg} <= 256 ? $_ & $MAX32 : $_ } @{$self->{H}};
|
|
|
695 |
push(@state, "H:" . join(":", map { sprintf($fmt, $_) } @H));
|
|
|
696 |
|
|
|
697 |
my @c = unpack("C*", $self->{block});
|
|
|
698 |
push(@c, 0x00) while scalar(@c) < ($self->{blocksize} >> 3);
|
|
|
699 |
push(@state, "block:" . join(":", map {sprintf("%02x", $_)} @c));
|
|
|
700 |
push(@state, "blockcnt:" . $self->{blockcnt});
|
|
|
701 |
|
|
|
702 |
push(@state, "lenhh:" . $self->{lenhh});
|
|
|
703 |
push(@state, "lenhl:" . $self->{lenhl});
|
|
|
704 |
push(@state, "lenlh:" . $self->{lenlh});
|
|
|
705 |
push(@state, "lenll:" . $self->{lenll});
|
|
|
706 |
join("\n", @state) . "\n";
|
|
|
707 |
}
|
|
|
708 |
|
|
|
709 |
sub _shaload {
|
|
|
710 |
my $state = shift;
|
|
|
711 |
|
|
|
712 |
my %s = ();
|
|
|
713 |
for (split(/\n/, $state)) {
|
|
|
714 |
s/^\s+//;
|
|
|
715 |
s/\s+$//;
|
|
|
716 |
next if (/^(#|$)/);
|
|
|
717 |
my @f = split(/[:\s]+/);
|
|
|
718 |
my $tag = shift(@f);
|
|
|
719 |
$s{$tag} = join('', @f);
|
|
|
720 |
}
|
|
|
721 |
|
|
|
722 |
# H and block may contain arbitrary values, but check everything else
|
|
|
723 |
grep { $_ == $s{alg} } (1,224,256,384,512,512224,512256) or return;
|
|
|
724 |
length($s{H}) == ($s{alg} <= 256 ? 64 : 128) or return;
|
|
|
725 |
length($s{block}) == ($s{alg} <= 256 ? 128 : 256) or return;
|
|
|
726 |
{
|
|
|
727 |
no integer;
|
|
|
728 |
for (qw(blockcnt lenhh lenhl lenlh lenll)) {
|
|
|
729 |
|
|
|
730 |
$s{$_} <= 4294967295 or return;
|
|
|
731 |
}
|
|
|
732 |
$s{blockcnt} < ($s{alg} <= 256 ? 512 : 1024) or return;
|
|
|
733 |
}
|
|
|
734 |
|
|
|
735 |
my $self = _shaopen($s{alg}) or return;
|
|
|
736 |
|
|
|
737 |
my @h = $s{H} =~ /(.{8})/g;
|
|
|
738 |
for (@{$self->{H}}) {
|
|
|
739 |
$_ = hex(shift @h);
|
|
|
740 |
if ($self->{alg} > 256) {
|
|
|
741 |
$_ = (($_ << 16) << 16) | hex(shift @h);
|
|
|
742 |
}
|
|
|
743 |
}
|
|
|
744 |
|
|
|
745 |
$self->{blockcnt} = $s{blockcnt};
|
|
|
746 |
$self->{block} = pack("H*", $s{block});
|
|
|
747 |
$self->{block} = substr($self->{block},0,_BYTECNT($self->{blockcnt}));
|
|
|
748 |
|
|
|
749 |
$self->{lenhh} = $s{lenhh};
|
|
|
750 |
$self->{lenhl} = $s{lenhl};
|
|
|
751 |
$self->{lenlh} = $s{lenlh};
|
|
|
752 |
$self->{lenll} = $s{lenll};
|
|
|
753 |
|
|
|
754 |
$self;
|
|
|
755 |
}
|
|
|
756 |
|
|
|
757 |
# ref. src/hmac.c from Digest::SHA
|
|
|
758 |
|
|
|
759 |
sub _hmacopen {
|
|
|
760 |
my($alg, $key) = @_;
|
|
|
761 |
my($self);
|
|
|
762 |
$self->{isha} = _shaopen($alg) or return;
|
|
|
763 |
$self->{osha} = _shaopen($alg) or return;
|
|
|
764 |
croak $WSE unless utf8::downgrade($key, 1);
|
|
|
765 |
if (length($key) > $self->{osha}->{blocksize} >> 3) {
|
|
|
766 |
$self->{ksha} = _shaopen($alg) or return;
|
|
|
767 |
_shawrite($key, length($key) << 3, $self->{ksha});
|
|
|
768 |
_shafinish($self->{ksha});
|
|
|
769 |
$key = _shadigest($self->{ksha});
|
|
|
770 |
}
|
|
|
771 |
$key .= chr(0x00)
|
|
|
772 |
while length($key) < $self->{osha}->{blocksize} >> 3;
|
|
|
773 |
my @k = unpack("C*", $key);
|
|
|
774 |
for (@k) { $_ ^= 0x5c }
|
|
|
775 |
_shawrite(pack("C*", @k), $self->{osha}->{blocksize}, $self->{osha});
|
|
|
776 |
for (@k) { $_ ^= (0x5c ^ 0x36) }
|
|
|
777 |
_shawrite(pack("C*", @k), $self->{isha}->{blocksize}, $self->{isha});
|
|
|
778 |
$self;
|
|
|
779 |
}
|
|
|
780 |
|
|
|
781 |
sub _hmacWrite {
|
|
|
782 |
my($bytestr_r, $bytecnt, $self) = @_;
|
|
|
783 |
_shaWrite($bytestr_r, $bytecnt, $self->{isha});
|
|
|
784 |
}
|
|
|
785 |
|
|
|
786 |
sub _hmacfinish {
|
|
|
787 |
my($self) = @_;
|
|
|
788 |
_shafinish($self->{isha});
|
|
|
789 |
_shawrite(_shadigest($self->{isha}),
|
|
|
790 |
$self->{isha}->{digestlen} << 3, $self->{osha});
|
|
|
791 |
_shafinish($self->{osha});
|
|
|
792 |
}
|
|
|
793 |
|
|
|
794 |
sub _hmacdigest { my($self) = @_; _shadigest($self->{osha}) }
|
|
|
795 |
sub _hmachex { my($self) = @_; _shahex($self->{osha}) }
|
|
|
796 |
sub _hmacbase64 { my($self) = @_; _shabase64($self->{osha}) }
|
|
|
797 |
|
|
|
798 |
# SHA and HMAC-SHA functions
|
|
|
799 |
|
|
|
800 |
my @suffix_extern = ("", "_hex", "_base64");
|
|
|
801 |
my @suffix_intern = ("digest", "hex", "base64");
|
|
|
802 |
|
|
|
803 |
my($i, $alg);
|
|
|
804 |
for $alg (1, 224, 256, 384, 512, 512224, 512256) {
|
|
|
805 |
for $i (0 .. 2) {
|
|
|
806 |
my $fcn = 'sub sha' . $alg . $suffix_extern[$i] . ' {
|
|
|
807 |
my $state = _shaopen(' . $alg . ') or return;
|
|
|
808 |
for (@_) { _shaWrite(\$_, length($_), $state) }
|
|
|
809 |
_shafinish($state);
|
|
|
810 |
_sha' . $suffix_intern[$i] . '($state);
|
|
|
811 |
}';
|
|
|
812 |
eval($fcn);
|
|
|
813 |
push(@EXPORT_OK, 'sha' . $alg . $suffix_extern[$i]);
|
|
|
814 |
$fcn = 'sub hmac_sha' . $alg . $suffix_extern[$i] . ' {
|
|
|
815 |
my $state = _hmacopen(' . $alg . ', pop(@_)) or return;
|
|
|
816 |
for (@_) { _hmacWrite(\$_, length($_), $state) }
|
|
|
817 |
_hmacfinish($state);
|
|
|
818 |
_hmac' . $suffix_intern[$i] . '($state);
|
|
|
819 |
}';
|
|
|
820 |
eval($fcn);
|
|
|
821 |
push(@EXPORT_OK, 'hmac_sha' . $alg . $suffix_extern[$i]);
|
|
|
822 |
}
|
|
|
823 |
}
|
|
|
824 |
|
|
|
825 |
# OOP methods
|
|
|
826 |
|
|
|
827 |
sub hashsize { my $self = shift; _shadsize($self) << 3 }
|
|
|
828 |
sub algorithm { my $self = shift; $self->{alg} }
|
|
|
829 |
|
|
|
830 |
sub add {
|
|
|
831 |
my $self = shift;
|
|
|
832 |
for (@_) { _shaWrite(\$_, length($_), $self) }
|
|
|
833 |
$self;
|
|
|
834 |
}
|
|
|
835 |
|
|
|
836 |
sub digest {
|
|
|
837 |
my $self = shift;
|
|
|
838 |
_shafinish($self);
|
|
|
839 |
my $rsp = _shadigest($self);
|
|
|
840 |
_sharewind($self);
|
|
|
841 |
$rsp;
|
|
|
842 |
}
|
|
|
843 |
|
|
|
844 |
sub hexdigest {
|
|
|
845 |
my $self = shift;
|
|
|
846 |
_shafinish($self);
|
|
|
847 |
my $rsp = _shahex($self);
|
|
|
848 |
_sharewind($self);
|
|
|
849 |
$rsp;
|
|
|
850 |
}
|
|
|
851 |
|
|
|
852 |
sub b64digest {
|
|
|
853 |
my $self = shift;
|
|
|
854 |
_shafinish($self);
|
|
|
855 |
my $rsp = _shabase64($self);
|
|
|
856 |
_sharewind($self);
|
|
|
857 |
$rsp;
|
|
|
858 |
}
|
|
|
859 |
|
|
|
860 |
sub new {
|
|
|
861 |
my($class, $alg) = @_;
|
|
|
862 |
$alg =~ s/\D+//g if defined $alg;
|
|
|
863 |
if (ref($class)) { # instance method
|
|
|
864 |
if (!defined($alg) || ($alg == $class->algorithm)) {
|
|
|
865 |
_sharewind($class);
|
|
|
866 |
return($class);
|
|
|
867 |
}
|
|
|
868 |
my $self = _shaopen($alg) or return;
|
|
|
869 |
return(_shacpy($class, $self));
|
|
|
870 |
}
|
|
|
871 |
$alg = 1 unless defined $alg;
|
|
|
872 |
my $self = _shaopen($alg) or return;
|
|
|
873 |
bless($self, $class);
|
|
|
874 |
$self;
|
|
|
875 |
}
|
|
|
876 |
|
|
|
877 |
sub clone {
|
|
|
878 |
my $self = shift;
|
|
|
879 |
my $copy = _shadup($self) or return;
|
|
|
880 |
bless($copy, ref($self));
|
|
|
881 |
}
|
|
|
882 |
|
|
|
883 |
BEGIN { *reset = \&new }
|
|
|
884 |
|
|
|
885 |
sub add_bits {
|
|
|
886 |
my($self, $data, $nbits) = @_;
|
|
|
887 |
unless (defined $nbits) {
|
|
|
888 |
$nbits = length($data);
|
|
|
889 |
$data = pack("B*", $data);
|
|
|
890 |
}
|
|
|
891 |
$nbits = length($data) * 8 if $nbits > length($data) * 8;
|
|
|
892 |
_shawrite($data, $nbits, $self);
|
|
|
893 |
return($self);
|
|
|
894 |
}
|
|
|
895 |
|
|
|
896 |
sub _bail {
|
|
|
897 |
my $msg = shift;
|
|
|
898 |
|
|
|
899 |
$msg .= ": $!";
|
|
|
900 |
croak $msg;
|
|
|
901 |
}
|
|
|
902 |
|
|
|
903 |
sub _addfile {
|
|
|
904 |
my ($self, $handle) = @_;
|
|
|
905 |
|
|
|
906 |
my $n;
|
|
|
907 |
my $buf = "";
|
|
|
908 |
|
|
|
909 |
while (($n = read($handle, $buf, 4096))) {
|
|
|
910 |
$self->add($buf);
|
|
|
911 |
}
|
|
|
912 |
_bail("Read failed") unless defined $n;
|
|
|
913 |
|
|
|
914 |
$self;
|
|
|
915 |
}
|
|
|
916 |
|
|
|
917 |
{
|
|
|
918 |
my $_can_T_filehandle;
|
|
|
919 |
|
|
|
920 |
sub _istext {
|
|
|
921 |
local *FH = shift;
|
|
|
922 |
my $file = shift;
|
|
|
923 |
|
|
|
924 |
if (! defined $_can_T_filehandle) {
|
|
|
925 |
local $^W = 0;
|
|
|
926 |
my $istext = eval { -T FH };
|
|
|
927 |
$_can_T_filehandle = $@ ? 0 : 1;
|
|
|
928 |
return $_can_T_filehandle ? $istext : -T $file;
|
|
|
929 |
}
|
|
|
930 |
return $_can_T_filehandle ? -T FH : -T $file;
|
|
|
931 |
}
|
|
|
932 |
}
|
|
|
933 |
|
|
|
934 |
sub addfile {
|
|
|
935 |
my ($self, $file, $mode) = @_;
|
|
|
936 |
|
|
|
937 |
return(_addfile($self, $file)) unless ref(\$file) eq 'SCALAR';
|
|
|
938 |
|
|
|
939 |
$mode = defined($mode) ? $mode : "";
|
|
|
940 |
my ($binary, $UNIVERSAL, $BITS, $portable) =
|
|
|
941 |
map { $_ eq $mode } ("b", "U", "0", "p");
|
|
|
942 |
|
|
|
943 |
## Always interpret "-" to mean STDIN; otherwise use
|
|
|
944 |
## sysopen to handle full range of POSIX file names
|
|
|
945 |
|
|
|
946 |
local *FH;
|
|
|
947 |
$file eq '-' and open(FH, '< -')
|
|
|
948 |
or sysopen(FH, $file, O_RDONLY)
|
|
|
949 |
or _bail('Open failed');
|
|
|
950 |
|
|
|
951 |
if ($BITS) {
|
|
|
952 |
my ($n, $buf) = (0, "");
|
|
|
953 |
while (($n = read(FH, $buf, 4096))) {
|
|
|
954 |
$buf =~ s/[^01]//g;
|
|
|
955 |
$self->add_bits($buf);
|
|
|
956 |
}
|
|
|
957 |
_bail("Read failed") unless defined $n;
|
|
|
958 |
close(FH);
|
|
|
959 |
return($self);
|
|
|
960 |
}
|
|
|
961 |
|
|
|
962 |
binmode(FH) if $binary || $portable || $UNIVERSAL;
|
|
|
963 |
if ($UNIVERSAL && _istext(*FH, $file)) {
|
|
|
964 |
while (<FH>) {
|
|
|
965 |
s/\015\012/\012/g; # DOS/Windows
|
|
|
966 |
s/\015/\012/g; # early MacOS
|
|
|
967 |
$self->add($_);
|
|
|
968 |
}
|
|
|
969 |
}
|
|
|
970 |
elsif ($portable && _istext(*FH, $file)) {
|
|
|
971 |
while (<FH>) {
|
|
|
972 |
s/\015?\015\012/\012/g;
|
|
|
973 |
s/\015/\012/g;
|
|
|
974 |
$self->add($_);
|
|
|
975 |
}
|
|
|
976 |
}
|
|
|
977 |
else { $self->_addfile(*FH) }
|
|
|
978 |
close(FH);
|
|
|
979 |
|
|
|
980 |
$self;
|
|
|
981 |
}
|
|
|
982 |
|
|
|
983 |
sub getstate {
|
|
|
984 |
my $self = shift;
|
|
|
985 |
|
|
|
986 |
return _shadump($self);
|
|
|
987 |
}
|
|
|
988 |
|
|
|
989 |
sub putstate {
|
|
|
990 |
my $class = shift;
|
|
|
991 |
my $state = shift;
|
|
|
992 |
|
|
|
993 |
if (ref($class)) { # instance method
|
|
|
994 |
my $self = _shaload($state) or return;
|
|
|
995 |
return(_shacpy($class, $self));
|
|
|
996 |
}
|
|
|
997 |
my $self = _shaload($state) or return;
|
|
|
998 |
bless($self, $class);
|
|
|
999 |
return($self);
|
|
|
1000 |
}
|
|
|
1001 |
|
|
|
1002 |
sub dump {
|
|
|
1003 |
my $self = shift;
|
|
|
1004 |
my $file = shift;
|
|
|
1005 |
|
|
|
1006 |
my $state = $self->getstate or return;
|
|
|
1007 |
$file = "-" if (!defined($file) || $file eq "");
|
|
|
1008 |
|
|
|
1009 |
local *FH;
|
|
|
1010 |
open(FH, "> $file") or return;
|
|
|
1011 |
print FH $state;
|
|
|
1012 |
close(FH);
|
|
|
1013 |
|
|
|
1014 |
return($self);
|
|
|
1015 |
}
|
|
|
1016 |
|
|
|
1017 |
sub load {
|
|
|
1018 |
my $class = shift;
|
|
|
1019 |
my $file = shift;
|
|
|
1020 |
|
|
|
1021 |
$file = "-" if (!defined($file) || $file eq "");
|
|
|
1022 |
|
|
|
1023 |
local *FH;
|
|
|
1024 |
open(FH, "< $file") or return;
|
|
|
1025 |
my $str = join('', <FH>);
|
|
|
1026 |
close(FH);
|
|
|
1027 |
|
|
|
1028 |
$class->putstate($str);
|
|
|
1029 |
}
|
|
|
1030 |
|
|
|
1031 |
1;
|
|
|
1032 |
__END__
|
|
|
1033 |
|
|
|
1034 |
=head1 NAME
|
|
|
1035 |
|
|
|
1036 |
Digest::SHA::PurePerl - Perl implementation of SHA-1/224/256/384/512
|
|
|
1037 |
|
|
|
1038 |
=head1 SYNOPSIS
|
|
|
1039 |
|
|
|
1040 |
In programs:
|
|
|
1041 |
|
|
|
1042 |
# Functional interface
|
|
|
1043 |
|
|
|
1044 |
use Digest::SHA::PurePerl qw(sha1 sha1_hex sha1_base64 ...);
|
|
|
1045 |
|
|
|
1046 |
$digest = sha1($data);
|
|
|
1047 |
$digest = sha1_hex($data);
|
|
|
1048 |
$digest = sha1_base64($data);
|
|
|
1049 |
|
|
|
1050 |
$digest = sha256($data);
|
|
|
1051 |
$digest = sha384_hex($data);
|
|
|
1052 |
$digest = sha512_base64($data);
|
|
|
1053 |
|
|
|
1054 |
# Object-oriented
|
|
|
1055 |
|
|
|
1056 |
use Digest::SHA::PurePerl;
|
|
|
1057 |
|
|
|
1058 |
$sha = Digest::SHA::PurePerl->new($alg);
|
|
|
1059 |
|
|
|
1060 |
$sha->add($data); # feed data into stream
|
|
|
1061 |
|
|
|
1062 |
$sha->addfile(*F);
|
|
|
1063 |
$sha->addfile($filename);
|
|
|
1064 |
|
|
|
1065 |
$sha->add_bits($bits);
|
|
|
1066 |
$sha->add_bits($data, $nbits);
|
|
|
1067 |
|
|
|
1068 |
$sha_copy = $sha->clone; # make copy of digest object
|
|
|
1069 |
$state = $sha->getstate; # save current state to string
|
|
|
1070 |
$sha->putstate($state); # restore previous $state
|
|
|
1071 |
|
|
|
1072 |
$digest = $sha->digest; # compute digest
|
|
|
1073 |
$digest = $sha->hexdigest;
|
|
|
1074 |
$digest = $sha->b64digest;
|
|
|
1075 |
|
|
|
1076 |
From the command line:
|
|
|
1077 |
|
|
|
1078 |
$ shasum files
|
|
|
1079 |
|
|
|
1080 |
$ shasum --help
|
|
|
1081 |
|
|
|
1082 |
=head1 SYNOPSIS (HMAC-SHA)
|
|
|
1083 |
|
|
|
1084 |
# Functional interface only
|
|
|
1085 |
|
|
|
1086 |
use Digest::SHA::PurePerl qw(hmac_sha1 hmac_sha1_hex ...);
|
|
|
1087 |
|
|
|
1088 |
$digest = hmac_sha1($data, $key);
|
|
|
1089 |
$digest = hmac_sha224_hex($data, $key);
|
|
|
1090 |
$digest = hmac_sha256_base64($data, $key);
|
|
|
1091 |
|
|
|
1092 |
=head1 ABSTRACT
|
|
|
1093 |
|
|
|
1094 |
Digest::SHA::PurePerl is a complete implementation of the NIST Secure
|
|
|
1095 |
Hash Standard. It gives Perl programmers a convenient way to calculate
|
|
|
1096 |
SHA-1, SHA-224, SHA-256, SHA-384, SHA-512, SHA-512/224, and SHA-512/256
|
|
|
1097 |
message digests. The module can handle all types of input, including
|
|
|
1098 |
partial-byte data.
|
|
|
1099 |
|
|
|
1100 |
=head1 DESCRIPTION
|
|
|
1101 |
|
|
|
1102 |
Digest::SHA::PurePerl is written entirely in Perl. If your platform
|
|
|
1103 |
has a C compiler, you should install the functionally equivalent
|
|
|
1104 |
(but much faster) L<Digest::SHA> module.
|
|
|
1105 |
|
|
|
1106 |
The programming interface is easy to use: it's the same one found
|
|
|
1107 |
in CPAN's L<Digest> module. So, if your applications currently
|
|
|
1108 |
use L<Digest::MD5> and you'd prefer the stronger security of SHA,
|
|
|
1109 |
it's a simple matter to convert them.
|
|
|
1110 |
|
|
|
1111 |
The interface provides two ways to calculate digests: all-at-once,
|
|
|
1112 |
or in stages. To illustrate, the following short program computes
|
|
|
1113 |
the SHA-256 digest of "hello world" using each approach:
|
|
|
1114 |
|
|
|
1115 |
use Digest::SHA::PurePerl qw(sha256_hex);
|
|
|
1116 |
|
|
|
1117 |
$data = "hello world";
|
|
|
1118 |
@frags = split(//, $data);
|
|
|
1119 |
|
|
|
1120 |
# all-at-once (Functional style)
|
|
|
1121 |
$digest1 = sha256_hex($data);
|
|
|
1122 |
|
|
|
1123 |
# in-stages (OOP style)
|
|
|
1124 |
$state = Digest::SHA::PurePerl->new(256);
|
|
|
1125 |
for (@frags) { $state->add($_) }
|
|
|
1126 |
$digest2 = $state->hexdigest;
|
|
|
1127 |
|
|
|
1128 |
print $digest1 eq $digest2 ?
|
|
|
1129 |
"whew!\n" : "oops!\n";
|
|
|
1130 |
|
|
|
1131 |
To calculate the digest of an n-bit message where I<n> is not a
|
|
|
1132 |
multiple of 8, use the I<add_bits()> method. For example, consider
|
|
|
1133 |
the 446-bit message consisting of the bit-string "110" repeated
|
|
|
1134 |
148 times, followed by "11". Here's how to display its SHA-1
|
|
|
1135 |
digest:
|
|
|
1136 |
|
|
|
1137 |
use Digest::SHA::PurePerl;
|
|
|
1138 |
$bits = "110" x 148 . "11";
|
|
|
1139 |
$sha = Digest::SHA::PurePerl->new(1)->add_bits($bits);
|
|
|
1140 |
print $sha->hexdigest, "\n";
|
|
|
1141 |
|
|
|
1142 |
Note that for larger bit-strings, it's more efficient to use the
|
|
|
1143 |
two-argument version I<add_bits($data, $nbits)>, where I<$data> is
|
|
|
1144 |
in the customary packed binary format used for Perl strings.
|
|
|
1145 |
|
|
|
1146 |
The module also lets you save intermediate SHA states to a string. The
|
|
|
1147 |
I<getstate()> method generates portable, human-readable text describing
|
|
|
1148 |
the current state of computation. You can subsequently restore that
|
|
|
1149 |
state with I<putstate()> to resume where the calculation left off.
|
|
|
1150 |
|
|
|
1151 |
To see what a state description looks like, just run the following:
|
|
|
1152 |
|
|
|
1153 |
use Digest::SHA::PurePerl;
|
|
|
1154 |
print Digest::SHA::PurePerl->new->add("Shaw" x 1962)->getstate;
|
|
|
1155 |
|
|
|
1156 |
As an added convenience, the Digest::SHA::PurePerl module offers
|
|
|
1157 |
routines to calculate keyed hashes using the HMAC-SHA-1/224/256/384/512
|
|
|
1158 |
algorithms. These services exist in functional form only, and
|
|
|
1159 |
mimic the style and behavior of the I<sha()>, I<sha_hex()>, and
|
|
|
1160 |
I<sha_base64()> functions.
|
|
|
1161 |
|
|
|
1162 |
# Test vector from draft-ietf-ipsec-ciph-sha-256-01.txt
|
|
|
1163 |
|
|
|
1164 |
use Digest::SHA::PurePerl qw(hmac_sha256_hex);
|
|
|
1165 |
print hmac_sha256_hex("Hi There", chr(0x0b) x 32), "\n";
|
|
|
1166 |
|
|
|
1167 |
=head1 UNICODE AND SIDE EFFECTS
|
|
|
1168 |
|
|
|
1169 |
Perl supports Unicode strings as of version 5.6. Such strings may
|
|
|
1170 |
contain wide characters, namely, characters whose ordinal values are
|
|
|
1171 |
greater than 255. This can cause problems for digest algorithms such
|
|
|
1172 |
as SHA that are specified to operate on sequences of bytes.
|
|
|
1173 |
|
|
|
1174 |
The rule by which Digest::SHA::PurePerl handles a Unicode string is easy
|
|
|
1175 |
to state, but potentially confusing to grasp: the string is interpreted
|
|
|
1176 |
as a sequence of byte values, where each byte value is equal to the
|
|
|
1177 |
ordinal value (viz. code point) of its corresponding Unicode character.
|
|
|
1178 |
That way, the Unicode string 'abc' has exactly the same digest value as
|
|
|
1179 |
the ordinary string 'abc'.
|
|
|
1180 |
|
|
|
1181 |
Since a wide character does not fit into a byte, the Digest::SHA::PurePerl
|
|
|
1182 |
routines croak if they encounter one. Whereas if a Unicode string
|
|
|
1183 |
contains no wide characters, the module accepts it quite happily.
|
|
|
1184 |
The following code illustrates the two cases:
|
|
|
1185 |
|
|
|
1186 |
$str1 = pack('U*', (0..255));
|
|
|
1187 |
print sha1_hex($str1); # ok
|
|
|
1188 |
|
|
|
1189 |
$str2 = pack('U*', (0..256));
|
|
|
1190 |
print sha1_hex($str2); # croaks
|
|
|
1191 |
|
|
|
1192 |
Be aware that the digest routines silently convert UTF-8 input into its
|
|
|
1193 |
equivalent byte sequence in the native encoding (cf. utf8::downgrade).
|
|
|
1194 |
This side effect influences only the way Perl stores the data internally,
|
|
|
1195 |
but otherwise leaves the actual value of the data intact.
|
|
|
1196 |
|
|
|
1197 |
=head1 NIST STATEMENT ON SHA-1
|
|
|
1198 |
|
|
|
1199 |
NIST acknowledges that the work of Prof. Xiaoyun Wang constitutes a
|
|
|
1200 |
practical collision attack on SHA-1. Therefore, NIST encourages the
|
|
|
1201 |
rapid adoption of the SHA-2 hash functions (e.g. SHA-256) for applications
|
|
|
1202 |
requiring strong collision resistance, such as digital signatures.
|
|
|
1203 |
|
|
|
1204 |
ref. L<http://csrc.nist.gov/groups/ST/hash/statement.html>
|
|
|
1205 |
|
|
|
1206 |
=head1 PADDING OF BASE64 DIGESTS
|
|
|
1207 |
|
|
|
1208 |
By convention, CPAN Digest modules do B<not> pad their Base64 output.
|
|
|
1209 |
Problems can occur when feeding such digests to other software that
|
|
|
1210 |
expects properly padded Base64 encodings.
|
|
|
1211 |
|
|
|
1212 |
For the time being, any necessary padding must be done by the user.
|
|
|
1213 |
Fortunately, this is a simple operation: if the length of a Base64-encoded
|
|
|
1214 |
digest isn't a multiple of 4, simply append "=" characters to the end
|
|
|
1215 |
of the digest until it is:
|
|
|
1216 |
|
|
|
1217 |
while (length($b64_digest) % 4) {
|
|
|
1218 |
$b64_digest .= '=';
|
|
|
1219 |
}
|
|
|
1220 |
|
|
|
1221 |
To illustrate, I<sha256_base64("abc")> is computed to be
|
|
|
1222 |
|
|
|
1223 |
ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0
|
|
|
1224 |
|
|
|
1225 |
which has a length of 43. So, the properly padded version is
|
|
|
1226 |
|
|
|
1227 |
ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0=
|
|
|
1228 |
|
|
|
1229 |
=head1 EXPORT
|
|
|
1230 |
|
|
|
1231 |
None by default.
|
|
|
1232 |
|
|
|
1233 |
=head1 EXPORTABLE FUNCTIONS
|
|
|
1234 |
|
|
|
1235 |
Provided your Perl installation supports 64-bit integers, all of
|
|
|
1236 |
these functions will be available for use. Otherwise, you won't
|
|
|
1237 |
be able to perform the SHA-384 and SHA-512 transforms, both of
|
|
|
1238 |
which require 64-bit operations.
|
|
|
1239 |
|
|
|
1240 |
I<Functional style>
|
|
|
1241 |
|
|
|
1242 |
=over 4
|
|
|
1243 |
|
|
|
1244 |
=item B<sha1($data, ...)>
|
|
|
1245 |
|
|
|
1246 |
=item B<sha224($data, ...)>
|
|
|
1247 |
|
|
|
1248 |
=item B<sha256($data, ...)>
|
|
|
1249 |
|
|
|
1250 |
=item B<sha384($data, ...)>
|
|
|
1251 |
|
|
|
1252 |
=item B<sha512($data, ...)>
|
|
|
1253 |
|
|
|
1254 |
=item B<sha512224($data, ...)>
|
|
|
1255 |
|
|
|
1256 |
=item B<sha512256($data, ...)>
|
|
|
1257 |
|
|
|
1258 |
Logically joins the arguments into a single string, and returns
|
|
|
1259 |
its SHA-1/224/256/384/512 digest encoded as a binary string.
|
|
|
1260 |
|
|
|
1261 |
=item B<sha1_hex($data, ...)>
|
|
|
1262 |
|
|
|
1263 |
=item B<sha224_hex($data, ...)>
|
|
|
1264 |
|
|
|
1265 |
=item B<sha256_hex($data, ...)>
|
|
|
1266 |
|
|
|
1267 |
=item B<sha384_hex($data, ...)>
|
|
|
1268 |
|
|
|
1269 |
=item B<sha512_hex($data, ...)>
|
|
|
1270 |
|
|
|
1271 |
=item B<sha512224_hex($data, ...)>
|
|
|
1272 |
|
|
|
1273 |
=item B<sha512256_hex($data, ...)>
|
|
|
1274 |
|
|
|
1275 |
Logically joins the arguments into a single string, and returns
|
|
|
1276 |
its SHA-1/224/256/384/512 digest encoded as a hexadecimal string.
|
|
|
1277 |
|
|
|
1278 |
=item B<sha1_base64($data, ...)>
|
|
|
1279 |
|
|
|
1280 |
=item B<sha224_base64($data, ...)>
|
|
|
1281 |
|
|
|
1282 |
=item B<sha256_base64($data, ...)>
|
|
|
1283 |
|
|
|
1284 |
=item B<sha384_base64($data, ...)>
|
|
|
1285 |
|
|
|
1286 |
=item B<sha512_base64($data, ...)>
|
|
|
1287 |
|
|
|
1288 |
=item B<sha512224_base64($data, ...)>
|
|
|
1289 |
|
|
|
1290 |
=item B<sha512256_base64($data, ...)>
|
|
|
1291 |
|
|
|
1292 |
Logically joins the arguments into a single string, and returns
|
|
|
1293 |
its SHA-1/224/256/384/512 digest encoded as a Base64 string.
|
|
|
1294 |
|
|
|
1295 |
It's important to note that the resulting string does B<not> contain
|
|
|
1296 |
the padding characters typical of Base64 encodings. This omission is
|
|
|
1297 |
deliberate, and is done to maintain compatibility with the family of
|
|
|
1298 |
CPAN Digest modules. See L</"PADDING OF BASE64 DIGESTS"> for details.
|
|
|
1299 |
|
|
|
1300 |
=back
|
|
|
1301 |
|
|
|
1302 |
I<OOP style>
|
|
|
1303 |
|
|
|
1304 |
=over 4
|
|
|
1305 |
|
|
|
1306 |
=item B<new($alg)>
|
|
|
1307 |
|
|
|
1308 |
Returns a new Digest::SHA::PurePerl object. Allowed values for
|
|
|
1309 |
I<$alg> are 1, 224, 256, 384, 512, 512224, or 512256. It's also
|
|
|
1310 |
possible to use common string representations of the algorithm
|
|
|
1311 |
(e.g. "sha256", "SHA-384"). If the argument is missing, SHA-1 will
|
|
|
1312 |
be used by default.
|
|
|
1313 |
|
|
|
1314 |
Invoking I<new> as an instance method will reset the object to the
|
|
|
1315 |
initial state associated with I<$alg>. If the argument is missing,
|
|
|
1316 |
the object will continue using the same algorithm that was selected
|
|
|
1317 |
at creation.
|
|
|
1318 |
|
|
|
1319 |
=item B<reset($alg)>
|
|
|
1320 |
|
|
|
1321 |
This method has exactly the same effect as I<new($alg)>. In fact,
|
|
|
1322 |
I<reset> is just an alias for I<new>.
|
|
|
1323 |
|
|
|
1324 |
=item B<hashsize>
|
|
|
1325 |
|
|
|
1326 |
Returns the number of digest bits for this object. The values are
|
|
|
1327 |
160, 224, 256, 384, 512, 224, and 256 for SHA-1, SHA-224, SHA-256,
|
|
|
1328 |
SHA-384, SHA-512, SHA-512/224, and SHA-512/256, respectively.
|
|
|
1329 |
|
|
|
1330 |
=item B<algorithm>
|
|
|
1331 |
|
|
|
1332 |
Returns the digest algorithm for this object. The values are 1,
|
|
|
1333 |
224, 256, 384, 512, 512224, and 512256 for SHA-1, SHA-224, SHA-256,
|
|
|
1334 |
SHA-384, SHA-512, SHA-512/224, and SHA-512/256, respectively.
|
|
|
1335 |
|
|
|
1336 |
=item B<clone>
|
|
|
1337 |
|
|
|
1338 |
Returns a duplicate copy of the object.
|
|
|
1339 |
|
|
|
1340 |
=item B<add($data, ...)>
|
|
|
1341 |
|
|
|
1342 |
Logically joins the arguments into a single string, and uses it to
|
|
|
1343 |
update the current digest state. In other words, the following
|
|
|
1344 |
statements have the same effect:
|
|
|
1345 |
|
|
|
1346 |
$sha->add("a"); $sha->add("b"); $sha->add("c");
|
|
|
1347 |
$sha->add("a")->add("b")->add("c");
|
|
|
1348 |
$sha->add("a", "b", "c");
|
|
|
1349 |
$sha->add("abc");
|
|
|
1350 |
|
|
|
1351 |
The return value is the updated object itself.
|
|
|
1352 |
|
|
|
1353 |
=item B<add_bits($data, $nbits)>
|
|
|
1354 |
|
|
|
1355 |
=item B<add_bits($bits)>
|
|
|
1356 |
|
|
|
1357 |
Updates the current digest state by appending bits to it. The
|
|
|
1358 |
return value is the updated object itself.
|
|
|
1359 |
|
|
|
1360 |
The first form causes the most-significant I<$nbits> of I<$data>
|
|
|
1361 |
to be appended to the stream. The I<$data> argument is in the
|
|
|
1362 |
customary binary format used for Perl strings.
|
|
|
1363 |
|
|
|
1364 |
The second form takes an ASCII string of "0" and "1" characters as
|
|
|
1365 |
its argument. It's equivalent to
|
|
|
1366 |
|
|
|
1367 |
$sha->add_bits(pack("B*", $bits), length($bits));
|
|
|
1368 |
|
|
|
1369 |
So, the following two statements do the same thing:
|
|
|
1370 |
|
|
|
1371 |
$sha->add_bits("111100001010");
|
|
|
1372 |
$sha->add_bits("\xF0\xA0", 12);
|
|
|
1373 |
|
|
|
1374 |
=item B<addfile(*FILE)>
|
|
|
1375 |
|
|
|
1376 |
Reads from I<FILE> until EOF, and appends that data to the current
|
|
|
1377 |
state. The return value is the updated object itself.
|
|
|
1378 |
|
|
|
1379 |
=item B<addfile($filename [, $mode])>
|
|
|
1380 |
|
|
|
1381 |
Reads the contents of I<$filename>, and appends that data to the current
|
|
|
1382 |
state. The return value is the updated object itself.
|
|
|
1383 |
|
|
|
1384 |
By default, I<$filename> is simply opened and read; no special modes
|
|
|
1385 |
or I/O disciplines are used. To change this, set the optional I<$mode>
|
|
|
1386 |
argument to one of the following values:
|
|
|
1387 |
|
|
|
1388 |
"b" read file in binary mode
|
|
|
1389 |
|
|
|
1390 |
"U" use universal newlines
|
|
|
1391 |
|
|
|
1392 |
"p" use portable mode (to be deprecated)
|
|
|
1393 |
|
|
|
1394 |
"0" use BITS mode
|
|
|
1395 |
|
|
|
1396 |
The "U" mode is modeled on Python's "Universal Newlines" concept, whereby
|
|
|
1397 |
DOS and Mac OS line terminators are converted internally to UNIX newlines
|
|
|
1398 |
before processing. This ensures consistent digest values when working
|
|
|
1399 |
simultaneously across multiple file systems. B<The "U" mode influences
|
|
|
1400 |
only text files>, namely those passing Perl's I<-T> test; binary files
|
|
|
1401 |
are processed with no translation whatsoever.
|
|
|
1402 |
|
|
|
1403 |
The "p" mode differs from "U" only in that it treats "\r\r\n" as a single
|
|
|
1404 |
newline, a quirky feature designed to accommodate legacy applications that
|
|
|
1405 |
occasionally added an extra carriage return before DOS line terminators.
|
|
|
1406 |
The "p" mode will be phased out eventually in favor of the cleaner and
|
|
|
1407 |
more well-established Universal Newlines concept.
|
|
|
1408 |
|
|
|
1409 |
The BITS mode ("0") interprets the contents of I<$filename> as a logical
|
|
|
1410 |
stream of bits, where each ASCII '0' or '1' character represents a 0 or
|
|
|
1411 |
1 bit, respectively. All other characters are ignored. This provides
|
|
|
1412 |
a convenient way to calculate the digest values of partial-byte data
|
|
|
1413 |
by using files, rather than having to write separate programs employing
|
|
|
1414 |
the I<add_bits> method.
|
|
|
1415 |
|
|
|
1416 |
=item B<getstate>
|
|
|
1417 |
|
|
|
1418 |
Returns a string containing a portable, human-readable representation
|
|
|
1419 |
of the current SHA state.
|
|
|
1420 |
|
|
|
1421 |
=item B<putstate($str)>
|
|
|
1422 |
|
|
|
1423 |
Returns a Digest::SHA object representing the SHA state contained
|
|
|
1424 |
in I<$str>. The format of I<$str> matches the format of the output
|
|
|
1425 |
produced by method I<getstate>. If called as a class method, a new
|
|
|
1426 |
object is created; if called as an instance method, the object is reset
|
|
|
1427 |
to the state contained in I<$str>.
|
|
|
1428 |
|
|
|
1429 |
=item B<dump($filename)>
|
|
|
1430 |
|
|
|
1431 |
Writes the output of I<getstate> to I<$filename>. If the argument is
|
|
|
1432 |
missing, or equal to the empty string, the state information will be
|
|
|
1433 |
written to STDOUT.
|
|
|
1434 |
|
|
|
1435 |
=item B<load($filename)>
|
|
|
1436 |
|
|
|
1437 |
Returns a Digest::SHA object that results from calling I<putstate> on
|
|
|
1438 |
the contents of I<$filename>. If the argument is missing, or equal to
|
|
|
1439 |
the empty string, the state information will be read from STDIN.
|
|
|
1440 |
|
|
|
1441 |
=item B<digest>
|
|
|
1442 |
|
|
|
1443 |
Returns the digest encoded as a binary string.
|
|
|
1444 |
|
|
|
1445 |
Note that the I<digest> method is a read-once operation. Once it
|
|
|
1446 |
has been performed, the Digest::SHA::PurePerl object is automatically
|
|
|
1447 |
reset in preparation for calculating another digest value. Call
|
|
|
1448 |
I<$sha-E<gt>clone-E<gt>digest> if it's necessary to preserve the
|
|
|
1449 |
original digest state.
|
|
|
1450 |
|
|
|
1451 |
=item B<hexdigest>
|
|
|
1452 |
|
|
|
1453 |
Returns the digest encoded as a hexadecimal string.
|
|
|
1454 |
|
|
|
1455 |
Like I<digest>, this method is a read-once operation. Call
|
|
|
1456 |
I<$sha-E<gt>clone-E<gt>hexdigest> if it's necessary to preserve
|
|
|
1457 |
the original digest state.
|
|
|
1458 |
|
|
|
1459 |
=item B<b64digest>
|
|
|
1460 |
|
|
|
1461 |
Returns the digest encoded as a Base64 string.
|
|
|
1462 |
|
|
|
1463 |
Like I<digest>, this method is a read-once operation. Call
|
|
|
1464 |
I<$sha-E<gt>clone-E<gt>b64digest> if it's necessary to preserve
|
|
|
1465 |
the original digest state.
|
|
|
1466 |
|
|
|
1467 |
It's important to note that the resulting string does B<not> contain
|
|
|
1468 |
the padding characters typical of Base64 encodings. This omission is
|
|
|
1469 |
deliberate, and is done to maintain compatibility with the family of
|
|
|
1470 |
CPAN Digest modules. See L</"PADDING OF BASE64 DIGESTS"> for details.
|
|
|
1471 |
|
|
|
1472 |
=back
|
|
|
1473 |
|
|
|
1474 |
I<HMAC-SHA-1/224/256/384/512>
|
|
|
1475 |
|
|
|
1476 |
=over 4
|
|
|
1477 |
|
|
|
1478 |
=item B<hmac_sha1($data, $key)>
|
|
|
1479 |
|
|
|
1480 |
=item B<hmac_sha224($data, $key)>
|
|
|
1481 |
|
|
|
1482 |
=item B<hmac_sha256($data, $key)>
|
|
|
1483 |
|
|
|
1484 |
=item B<hmac_sha384($data, $key)>
|
|
|
1485 |
|
|
|
1486 |
=item B<hmac_sha512($data, $key)>
|
|
|
1487 |
|
|
|
1488 |
=item B<hmac_sha512224($data, $key)>
|
|
|
1489 |
|
|
|
1490 |
=item B<hmac_sha512256($data, $key)>
|
|
|
1491 |
|
|
|
1492 |
Returns the HMAC-SHA-1/224/256/384/512 digest of I<$data>/I<$key>,
|
|
|
1493 |
with the result encoded as a binary string. Multiple I<$data>
|
|
|
1494 |
arguments are allowed, provided that I<$key> is the last argument
|
|
|
1495 |
in the list.
|
|
|
1496 |
|
|
|
1497 |
=item B<hmac_sha1_hex($data, $key)>
|
|
|
1498 |
|
|
|
1499 |
=item B<hmac_sha224_hex($data, $key)>
|
|
|
1500 |
|
|
|
1501 |
=item B<hmac_sha256_hex($data, $key)>
|
|
|
1502 |
|
|
|
1503 |
=item B<hmac_sha384_hex($data, $key)>
|
|
|
1504 |
|
|
|
1505 |
=item B<hmac_sha512_hex($data, $key)>
|
|
|
1506 |
|
|
|
1507 |
=item B<hmac_sha512224_hex($data, $key)>
|
|
|
1508 |
|
|
|
1509 |
=item B<hmac_sha512256_hex($data, $key)>
|
|
|
1510 |
|
|
|
1511 |
Returns the HMAC-SHA-1/224/256/384/512 digest of I<$data>/I<$key>,
|
|
|
1512 |
with the result encoded as a hexadecimal string. Multiple I<$data>
|
|
|
1513 |
arguments are allowed, provided that I<$key> is the last argument
|
|
|
1514 |
in the list.
|
|
|
1515 |
|
|
|
1516 |
=item B<hmac_sha1_base64($data, $key)>
|
|
|
1517 |
|
|
|
1518 |
=item B<hmac_sha224_base64($data, $key)>
|
|
|
1519 |
|
|
|
1520 |
=item B<hmac_sha256_base64($data, $key)>
|
|
|
1521 |
|
|
|
1522 |
=item B<hmac_sha384_base64($data, $key)>
|
|
|
1523 |
|
|
|
1524 |
=item B<hmac_sha512_base64($data, $key)>
|
|
|
1525 |
|
|
|
1526 |
=item B<hmac_sha512224_base64($data, $key)>
|
|
|
1527 |
|
|
|
1528 |
=item B<hmac_sha512256_base64($data, $key)>
|
|
|
1529 |
|
|
|
1530 |
Returns the HMAC-SHA-1/224/256/384/512 digest of I<$data>/I<$key>,
|
|
|
1531 |
with the result encoded as a Base64 string. Multiple I<$data>
|
|
|
1532 |
arguments are allowed, provided that I<$key> is the last argument
|
|
|
1533 |
in the list.
|
|
|
1534 |
|
|
|
1535 |
It's important to note that the resulting string does B<not> contain
|
|
|
1536 |
the padding characters typical of Base64 encodings. This omission is
|
|
|
1537 |
deliberate, and is done to maintain compatibility with the family of
|
|
|
1538 |
CPAN Digest modules. See L</"PADDING OF BASE64 DIGESTS"> for details.
|
|
|
1539 |
|
|
|
1540 |
=back
|
|
|
1541 |
|
|
|
1542 |
=head1 SEE ALSO
|
|
|
1543 |
|
|
|
1544 |
L<Digest>, L<Digest::SHA>
|
|
|
1545 |
|
|
|
1546 |
The Secure Hash Standard (Draft FIPS PUB 180-4) can be found at:
|
|
|
1547 |
|
|
|
1548 |
L<http://csrc.nist.gov/publications/drafts/fips180-4/Draft-FIPS180-4_Feb2011.pdf>
|
|
|
1549 |
|
|
|
1550 |
The Keyed-Hash Message Authentication Code (HMAC):
|
|
|
1551 |
|
|
|
1552 |
L<http://csrc.nist.gov/publications/fips/fips198/fips-198a.pdf>
|
|
|
1553 |
|
|
|
1554 |
=head1 AUTHOR
|
|
|
1555 |
|
|
|
1556 |
Mark Shelor <mshelor@cpan.org>
|
|
|
1557 |
|
|
|
1558 |
=head1 ACKNOWLEDGMENTS
|
|
|
1559 |
|
|
|
1560 |
The author is particularly grateful to
|
|
|
1561 |
|
|
|
1562 |
Gisle Aas
|
|
|
1563 |
Sean Burke
|
|
|
1564 |
Chris Carey
|
|
|
1565 |
Alexandr Ciornii
|
|
|
1566 |
Chris David
|
|
|
1567 |
Jim Doble
|
|
|
1568 |
Thomas Drugeon
|
|
|
1569 |
Julius Duque
|
|
|
1570 |
Jeffrey Friedl
|
|
|
1571 |
Robert Gilmour
|
|
|
1572 |
Brian Gladman
|
|
|
1573 |
Adam Kennedy
|
|
|
1574 |
Mark Lawrence
|
|
|
1575 |
Andy Lester
|
|
|
1576 |
Alex Muntada
|
|
|
1577 |
Steve Peters
|
|
|
1578 |
Chris Skiscim
|
|
|
1579 |
Martin Thurn
|
|
|
1580 |
Gunnar Wolf
|
|
|
1581 |
Adam Woodbury
|
|
|
1582 |
|
|
|
1583 |
"A candle in the bar was lighting up the dirty windows, on one of
|
|
|
1584 |
which was a notice, in white enamel letters, telling customers they
|
|
|
1585 |
could bring their own food: ON PEUT APPORTER SON MANGER, from which
|
|
|
1586 |
the M and the last R were missing."
|
|
|
1587 |
- Maigret's War of Nerves
|
|
|
1588 |
|
|
|
1589 |
=head1 COPYRIGHT AND LICENSE
|
|
|
1590 |
|
|
|
1591 |
Copyright (C) 2003-2017 Mark Shelor
|
|
|
1592 |
|
|
|
1593 |
This library is free software; you can redistribute it and/or modify
|
|
|
1594 |
it under the same terms as Perl itself.
|
|
|
1595 |
|
|
|
1596 |
L<perlartistic>
|
|
|
1597 |
|
|
|
1598 |
=cut
|