1package Digest::SHA::PurePerl; 2 3require 5.003000; 4 5use strict; 6use warnings; 7use vars qw($VERSION @ISA @EXPORT_OK); 8use Fcntl qw(O_RDONLY); 9use integer; 10use Carp qw(croak); 11 12$VERSION = '5.96'; 13 14require Exporter; 15@ISA = qw(Exporter); 16@EXPORT_OK = (); # see "SHA and HMAC-SHA functions" below 17 18# Inherit from Digest::base if possible 19 20eval { 21 require Digest::base; 22 push(@ISA, 'Digest::base'); 23}; 24 25# ref. src/sha.c and sha/sha64bit.c from Digest::SHA 26 27my $MAX32 = 0xffffffff; 28 29my $uses64bit = (((1 << 16) << 16) << 16) << 15; 30 31my @H01 = ( # SHA-1 initial hash value 32 0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476, 33 0xc3d2e1f0 34); 35 36my @H0224 = ( # SHA-224 initial hash value 37 0xc1059ed8, 0x367cd507, 0x3070dd17, 0xf70e5939, 38 0xffc00b31, 0x68581511, 0x64f98fa7, 0xbefa4fa4 39); 40 41my @H0256 = ( # SHA-256 initial hash value 42 0x6a09e667, 0xbb67ae85, 0x3c6ef372, 0xa54ff53a, 43 0x510e527f, 0x9b05688c, 0x1f83d9ab, 0x5be0cd19 44); 45 46my(@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 53sub _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 60sub _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 67sub _c_Ch { my($x, $y, $z) = @_; "($z ^ ($x & ($y ^ $z)))" } 68sub _c_Pa { my($x, $y, $z) = @_; "($x ^ $y ^ $z)" } 69sub _c_Ma { my($x, $y, $z) = @_; "(($x & $y) | ($z & ($x | $y)))" } 70 71sub _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 76sub _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 81sub _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 87sub _c_SIGMA1 { 88 my($x) = @_; 89 "(" . _c_ROTR($x, 6) . " ^ " . _c_ROTR($x, 11) . " ^ " . 90 _c_ROTR($x, 25) . ")"; 91} 92 93sub _c_sigma0 { 94 my($x) = @_; 95 "(" . _c_ROTR($x, 7) . " ^ " . _c_ROTR($x, 18) . " ^ " . 96 _c_SR32($x, 3) . ")"; 97} 98 99sub _c_sigma1 { 100 my($x) = @_; 101 "(" . _c_ROTR($x, 17) . " ^ " . _c_ROTR($x, 19) . " ^ " . 102 _c_SR32($x, 10) . ")"; 103} 104 105sub _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 111sub _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 117sub _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 123sub _c_M11Ch { my($k, $w) = @_; _c_M1Ch('$a', '$b', '$c', '$d', '$e', $k, $w) } 124sub _c_M11Pa { my($k, $w) = @_; _c_M1Pa('$a', '$b', '$c', '$d', '$e', $k, $w) } 125sub _c_M11Ma { my($k, $w) = @_; _c_M1Ma('$a', '$b', '$c', '$d', '$e', $k, $w) } 126sub _c_M12Ch { my($k, $w) = @_; _c_M1Ch('$e', '$a', '$b', '$c', '$d', $k, $w) } 127sub _c_M12Pa { my($k, $w) = @_; _c_M1Pa('$e', '$a', '$b', '$c', '$d', $k, $w) } 128sub _c_M12Ma { my($k, $w) = @_; _c_M1Ma('$e', '$a', '$b', '$c', '$d', $k, $w) } 129sub _c_M13Ch { my($k, $w) = @_; _c_M1Ch('$d', '$e', '$a', '$b', '$c', $k, $w) } 130sub _c_M13Pa { my($k, $w) = @_; _c_M1Pa('$d', '$e', '$a', '$b', '$c', $k, $w) } 131sub _c_M13Ma { my($k, $w) = @_; _c_M1Ma('$d', '$e', '$a', '$b', '$c', $k, $w) } 132sub _c_M14Ch { my($k, $w) = @_; _c_M1Ch('$c', '$d', '$e', '$a', '$b', $k, $w) } 133sub _c_M14Pa { my($k, $w) = @_; _c_M1Pa('$c', '$d', '$e', '$a', '$b', $k, $w) } 134sub _c_M14Ma { my($k, $w) = @_; _c_M1Ma('$c', '$d', '$e', '$a', '$b', $k, $w) } 135sub _c_M15Ch { my($k, $w) = @_; _c_M1Ch('$b', '$c', '$d', '$e', '$a', $k, $w) } 136sub _c_M15Pa { my($k, $w) = @_; _c_M1Pa('$b', '$c', '$d', '$e', '$a', $k, $w) } 137sub _c_M15Ma { my($k, $w) = @_; _c_M1Ma('$b', '$c', '$d', '$e', '$a', $k, $w) } 138 139sub _c_W11 { my($s) = @_; '$W[' . (($s + 0) & 0xf) . ']' } 140sub _c_W12 { my($s) = @_; '$W[' . (($s + 13) & 0xf) . ']' } 141sub _c_W13 { my($s) = @_; '$W[' . (($s + 8) & 0xf) . ']' } 142sub _c_W14 { my($s) = @_; '$W[' . (($s + 2) & 0xf) . ']' } 143 144sub _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 153my $sha1_code = ' 154 155my($K1, $K2, $K3, $K4) = ( # SHA-1 constants 156 0x5a827999, 0x6ed9eba1, 0x8f1bbcdc, 0xca62c1d6 157); 158 159sub _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 212eval($sha1_code); 213 214sub _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 221sub _c_M21 { _c_M2('$a', '$b', '$c', '$d', '$e', '$f', '$g', '$h', $_[0]) } 222sub _c_M22 { _c_M2('$h', '$a', '$b', '$c', '$d', '$e', '$f', '$g', $_[0]) } 223sub _c_M23 { _c_M2('$g', '$h', '$a', '$b', '$c', '$d', '$e', '$f', $_[0]) } 224sub _c_M24 { _c_M2('$f', '$g', '$h', '$a', '$b', '$c', '$d', '$e', $_[0]) } 225sub _c_M25 { _c_M2('$e', '$f', '$g', '$h', '$a', '$b', '$c', '$d', $_[0]) } 226sub _c_M26 { _c_M2('$d', '$e', '$f', '$g', '$h', '$a', '$b', '$c', $_[0]) } 227sub _c_M27 { _c_M2('$c', '$d', '$e', '$f', '$g', '$h', '$a', '$b', $_[0]) } 228sub _c_M28 { _c_M2('$b', '$c', '$d', '$e', '$f', '$g', '$h', '$a', $_[0]) } 229 230sub _c_W21 { my($s) = @_; '$W[' . (($s + 0) & 0xf) . ']' } 231sub _c_W22 { my($s) = @_; '$W[' . (($s + 14) & 0xf) . ']' } 232sub _c_W23 { my($s) = @_; '$W[' . (($s + 9) & 0xf) . ']' } 233sub _c_W24 { my($s) = @_; '$W[' . (($s + 1) & 0xf) . ']' } 234 235sub _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 243my $sha256_code = ' 244 245my @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 264sub _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 300eval($sha256_code); 301 302sub _sha512_placeholder { return } 303my $sha512 = \&_sha512_placeholder; 304 305my $_64bit_code = ' 306 307no warnings qw(portable); 308 309my @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 358use warnings; 359 360sub _c_SL64 { my($x, $n) = @_; "($x << $n)" } 361 362sub _c_SR64 { 363 my($x, $n) = @_; 364 my $mask = (1 << (64 - $n)) - 1; 365 "(($x >> $n) & $mask)"; 366} 367 368sub _c_ROTRQ { 369 my($x, $n) = @_; 370 "(" . _c_SR64($x, $n) . " | " . _c_SL64($x, 64 - $n) . ")"; 371} 372 373sub _c_SIGMAQ0 { 374 my($x) = @_; 375 "(" . _c_ROTRQ($x, 28) . " ^ " . _c_ROTRQ($x, 34) . " ^ " . 376 _c_ROTRQ($x, 39) . ")"; 377} 378 379sub _c_SIGMAQ1 { 380 my($x) = @_; 381 "(" . _c_ROTRQ($x, 14) . " ^ " . _c_ROTRQ($x, 18) . " ^ " . 382 _c_ROTRQ($x, 41) . ")"; 383} 384 385sub _c_sigmaQ0 { 386 my($x) = @_; 387 "(" . _c_ROTRQ($x, 1) . " ^ " . _c_ROTRQ($x, 8) . " ^ " . 388 _c_SR64($x, 7) . ")"; 389} 390 391sub _c_sigmaQ1 { 392 my($x) = @_; 393 "(" . _c_ROTRQ($x, 19) . " ^ " . _c_ROTRQ($x, 61) . " ^ " . 394 _c_SR64($x, 6) . ")"; 395} 396 397my $sha512_code = q/ 398sub _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 423eval($sha512_code); 424$sha512 = \&_sha512; 425 426'; 427 428eval($_64bit_code) if $uses64bit; 429 430sub _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 438sub _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 446sub _BYTECNT { 447 my($bitcnt) = @_; 448 $bitcnt > 0 ? 1 + (($bitcnt - 1) >> 3) : 0; 449} 450 451sub _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 461sub _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 479sub _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 488sub _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 505sub _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 526sub _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 553sub _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 577my $no_downgrade = 'sub utf8::downgrade { 1 }'; 578 579my $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 603my $WSE = 'Wide character in subroutine entry'; 604my $MWS = 16384; 605 606sub _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 620sub _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 646sub _shadigest { my($self) = @_; _digcpy($self); $self->{digest} } 647 648sub _shahex { 649 my($self) = @_; 650 _digcpy($self); 651 join("", unpack("H*", $self->{digest})); 652} 653 654sub _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 666sub _shadsize { my($self) = @_; $self->{digestlen} } 667 668sub _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 681sub _shadup { my($self) = @_; my($copy); _shacpy($copy, $self) } 682 683sub _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 709sub _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 0 <= $s{$_} or return; 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 759sub _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 781sub _hmacWrite { 782 my($bytestr_r, $bytecnt, $self) = @_; 783 _shaWrite($bytestr_r, $bytecnt, $self->{isha}); 784} 785 786sub _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 794sub _hmacdigest { my($self) = @_; _shadigest($self->{osha}) } 795sub _hmachex { my($self) = @_; _shahex($self->{osha}) } 796sub _hmacbase64 { my($self) = @_; _shabase64($self->{osha}) } 797 798# SHA and HMAC-SHA functions 799 800my @suffix_extern = ("", "_hex", "_base64"); 801my @suffix_intern = ("digest", "hex", "base64"); 802 803my($i, $alg); 804for $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 827sub hashsize { my $self = shift; _shadsize($self) << 3 } 828sub algorithm { my $self = shift; $self->{alg} } 829 830sub add { 831 my $self = shift; 832 for (@_) { _shaWrite(\$_, length($_), $self) } 833 $self; 834} 835 836sub digest { 837 my $self = shift; 838 _shafinish($self); 839 my $rsp = _shadigest($self); 840 _sharewind($self); 841 $rsp; 842} 843 844sub hexdigest { 845 my $self = shift; 846 _shafinish($self); 847 my $rsp = _shahex($self); 848 _sharewind($self); 849 $rsp; 850} 851 852sub b64digest { 853 my $self = shift; 854 _shafinish($self); 855 my $rsp = _shabase64($self); 856 _sharewind($self); 857 $rsp; 858} 859 860sub 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 877sub clone { 878 my $self = shift; 879 my $copy = _shadup($self) or return; 880 bless($copy, ref($self)); 881} 882 883BEGIN { *reset = \&new } 884 885sub 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 896sub _bail { 897 my $msg = shift; 898 899 $msg .= ": $!"; 900 croak $msg; 901} 902 903sub _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 934sub 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 983sub getstate { 984 my $self = shift; 985 986 return _shadump($self); 987} 988 989sub 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 1002sub 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 1017sub 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 10311; 1032__END__ 1033 1034=head1 NAME 1035 1036Digest::SHA::PurePerl - Perl implementation of SHA-1/224/256/384/512 1037 1038=head1 SYNOPSIS 1039 1040In 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 1076From 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 1094Digest::SHA::PurePerl is a complete implementation of the NIST Secure 1095Hash Standard. It gives Perl programmers a convenient way to calculate 1096SHA-1, SHA-224, SHA-256, SHA-384, SHA-512, SHA-512/224, and SHA-512/256 1097message digests. The module can handle all types of input, including 1098partial-byte data. 1099 1100=head1 DESCRIPTION 1101 1102Digest::SHA::PurePerl is written entirely in Perl. If your platform 1103has a C compiler, you should install the functionally equivalent 1104(but much faster) L<Digest::SHA> module. 1105 1106The programming interface is easy to use: it's the same one found 1107in CPAN's L<Digest> module. So, if your applications currently 1108use L<Digest::MD5> and you'd prefer the stronger security of SHA, 1109it's a simple matter to convert them. 1110 1111The interface provides two ways to calculate digests: all-at-once, 1112or in stages. To illustrate, the following short program computes 1113the 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 1131To calculate the digest of an n-bit message where I<n> is not a 1132multiple of 8, use the I<add_bits()> method. For example, consider 1133the 446-bit message consisting of the bit-string "110" repeated 1134148 times, followed by "11". Here's how to display its SHA-1 1135digest: 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 1142Note that for larger bit-strings, it's more efficient to use the 1143two-argument version I<add_bits($data, $nbits)>, where I<$data> is 1144in the customary packed binary format used for Perl strings. 1145 1146The module also lets you save intermediate SHA states to a string. The 1147I<getstate()> method generates portable, human-readable text describing 1148the current state of computation. You can subsequently restore that 1149state with I<putstate()> to resume where the calculation left off. 1150 1151To 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 1156As an added convenience, the Digest::SHA::PurePerl module offers 1157routines to calculate keyed hashes using the HMAC-SHA-1/224/256/384/512 1158algorithms. These services exist in functional form only, and 1159mimic the style and behavior of the I<sha()>, I<sha_hex()>, and 1160I<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 1169Perl supports Unicode strings as of version 5.6. Such strings may 1170contain wide characters, namely, characters whose ordinal values are 1171greater than 255. This can cause problems for digest algorithms such 1172as SHA that are specified to operate on sequences of bytes. 1173 1174The rule by which Digest::SHA::PurePerl handles a Unicode string is easy 1175to state, but potentially confusing to grasp: the string is interpreted 1176as a sequence of byte values, where each byte value is equal to the 1177ordinal value (viz. code point) of its corresponding Unicode character. 1178That way, the Unicode string 'abc' has exactly the same digest value as 1179the ordinary string 'abc'. 1180 1181Since a wide character does not fit into a byte, the Digest::SHA::PurePerl 1182routines croak if they encounter one. Whereas if a Unicode string 1183contains no wide characters, the module accepts it quite happily. 1184The 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 1192Be aware that the digest routines silently convert UTF-8 input into its 1193equivalent byte sequence in the native encoding (cf. utf8::downgrade). 1194This side effect influences only the way Perl stores the data internally, 1195but otherwise leaves the actual value of the data intact. 1196 1197=head1 NIST STATEMENT ON SHA-1 1198 1199NIST acknowledges that the work of Prof. Xiaoyun Wang constitutes a 1200practical collision attack on SHA-1. Therefore, NIST encourages the 1201rapid adoption of the SHA-2 hash functions (e.g. SHA-256) for applications 1202requiring strong collision resistance, such as digital signatures. 1203 1204ref. L<http://csrc.nist.gov/groups/ST/hash/statement.html> 1205 1206=head1 PADDING OF BASE64 DIGESTS 1207 1208By convention, CPAN Digest modules do B<not> pad their Base64 output. 1209Problems can occur when feeding such digests to other software that 1210expects properly padded Base64 encodings. 1211 1212For the time being, any necessary padding must be done by the user. 1213Fortunately, this is a simple operation: if the length of a Base64-encoded 1214digest isn't a multiple of 4, simply append "=" characters to the end 1215of the digest until it is: 1216 1217 while (length($b64_digest) % 4) { 1218 $b64_digest .= '='; 1219 } 1220 1221To illustrate, I<sha256_base64("abc")> is computed to be 1222 1223 ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0 1224 1225which has a length of 43. So, the properly padded version is 1226 1227 ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0= 1228 1229=head1 EXPORT 1230 1231None by default. 1232 1233=head1 EXPORTABLE FUNCTIONS 1234 1235Provided your Perl installation supports 64-bit integers, all of 1236these functions will be available for use. Otherwise, you won't 1237be able to perform the SHA-384 and SHA-512 transforms, both of 1238which require 64-bit operations. 1239 1240I<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 1258Logically joins the arguments into a single string, and returns 1259its 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 1275Logically joins the arguments into a single string, and returns 1276its 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 1292Logically joins the arguments into a single string, and returns 1293its SHA-1/224/256/384/512 digest encoded as a Base64 string. 1294 1295It's important to note that the resulting string does B<not> contain 1296the padding characters typical of Base64 encodings. This omission is 1297deliberate, and is done to maintain compatibility with the family of 1298CPAN Digest modules. See L</"PADDING OF BASE64 DIGESTS"> for details. 1299 1300=back 1301 1302I<OOP style> 1303 1304=over 4 1305 1306=item B<new($alg)> 1307 1308Returns a new Digest::SHA::PurePerl object. Allowed values for 1309I<$alg> are 1, 224, 256, 384, 512, 512224, or 512256. It's also 1310possible to use common string representations of the algorithm 1311(e.g. "sha256", "SHA-384"). If the argument is missing, SHA-1 will 1312be used by default. 1313 1314Invoking I<new> as an instance method will reset the object to the 1315initial state associated with I<$alg>. If the argument is missing, 1316the object will continue using the same algorithm that was selected 1317at creation. 1318 1319=item B<reset($alg)> 1320 1321This method has exactly the same effect as I<new($alg)>. In fact, 1322I<reset> is just an alias for I<new>. 1323 1324=item B<hashsize> 1325 1326Returns the number of digest bits for this object. The values are 1327160, 224, 256, 384, 512, 224, and 256 for SHA-1, SHA-224, SHA-256, 1328SHA-384, SHA-512, SHA-512/224, and SHA-512/256, respectively. 1329 1330=item B<algorithm> 1331 1332Returns the digest algorithm for this object. The values are 1, 1333224, 256, 384, 512, 512224, and 512256 for SHA-1, SHA-224, SHA-256, 1334SHA-384, SHA-512, SHA-512/224, and SHA-512/256, respectively. 1335 1336=item B<clone> 1337 1338Returns a duplicate copy of the object. 1339 1340=item B<add($data, ...)> 1341 1342Logically joins the arguments into a single string, and uses it to 1343update the current digest state. In other words, the following 1344statements 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 1351The return value is the updated object itself. 1352 1353=item B<add_bits($data, $nbits)> 1354 1355=item B<add_bits($bits)> 1356 1357Updates the current digest state by appending bits to it. The 1358return value is the updated object itself. 1359 1360The first form causes the most-significant I<$nbits> of I<$data> 1361to be appended to the stream. The I<$data> argument is in the 1362customary binary format used for Perl strings. 1363 1364The second form takes an ASCII string of "0" and "1" characters as 1365its argument. It's equivalent to 1366 1367 $sha->add_bits(pack("B*", $bits), length($bits)); 1368 1369So, 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 1376Reads from I<FILE> until EOF, and appends that data to the current 1377state. The return value is the updated object itself. 1378 1379=item B<addfile($filename [, $mode])> 1380 1381Reads the contents of I<$filename>, and appends that data to the current 1382state. The return value is the updated object itself. 1383 1384By default, I<$filename> is simply opened and read; no special modes 1385or I/O disciplines are used. To change this, set the optional I<$mode> 1386argument 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 1396The "U" mode is modeled on Python's "Universal Newlines" concept, whereby 1397DOS and Mac OS line terminators are converted internally to UNIX newlines 1398before processing. This ensures consistent digest values when working 1399simultaneously across multiple file systems. B<The "U" mode influences 1400only text files>, namely those passing Perl's I<-T> test; binary files 1401are processed with no translation whatsoever. 1402 1403The "p" mode differs from "U" only in that it treats "\r\r\n" as a single 1404newline, a quirky feature designed to accommodate legacy applications that 1405occasionally added an extra carriage return before DOS line terminators. 1406The "p" mode will be phased out eventually in favor of the cleaner and 1407more well-established Universal Newlines concept. 1408 1409The BITS mode ("0") interprets the contents of I<$filename> as a logical 1410stream of bits, where each ASCII '0' or '1' character represents a 0 or 14111 bit, respectively. All other characters are ignored. This provides 1412a convenient way to calculate the digest values of partial-byte data 1413by using files, rather than having to write separate programs employing 1414the I<add_bits> method. 1415 1416=item B<getstate> 1417 1418Returns a string containing a portable, human-readable representation 1419of the current SHA state. 1420 1421=item B<putstate($str)> 1422 1423Returns a Digest::SHA object representing the SHA state contained 1424in I<$str>. The format of I<$str> matches the format of the output 1425produced by method I<getstate>. If called as a class method, a new 1426object is created; if called as an instance method, the object is reset 1427to the state contained in I<$str>. 1428 1429=item B<dump($filename)> 1430 1431Writes the output of I<getstate> to I<$filename>. If the argument is 1432missing, or equal to the empty string, the state information will be 1433written to STDOUT. 1434 1435=item B<load($filename)> 1436 1437Returns a Digest::SHA object that results from calling I<putstate> on 1438the contents of I<$filename>. If the argument is missing, or equal to 1439the empty string, the state information will be read from STDIN. 1440 1441=item B<digest> 1442 1443Returns the digest encoded as a binary string. 1444 1445Note that the I<digest> method is a read-once operation. Once it 1446has been performed, the Digest::SHA::PurePerl object is automatically 1447reset in preparation for calculating another digest value. Call 1448I<$sha-E<gt>clone-E<gt>digest> if it's necessary to preserve the 1449original digest state. 1450 1451=item B<hexdigest> 1452 1453Returns the digest encoded as a hexadecimal string. 1454 1455Like I<digest>, this method is a read-once operation. Call 1456I<$sha-E<gt>clone-E<gt>hexdigest> if it's necessary to preserve 1457the original digest state. 1458 1459=item B<b64digest> 1460 1461Returns the digest encoded as a Base64 string. 1462 1463Like I<digest>, this method is a read-once operation. Call 1464I<$sha-E<gt>clone-E<gt>b64digest> if it's necessary to preserve 1465the original digest state. 1466 1467It's important to note that the resulting string does B<not> contain 1468the padding characters typical of Base64 encodings. This omission is 1469deliberate, and is done to maintain compatibility with the family of 1470CPAN Digest modules. See L</"PADDING OF BASE64 DIGESTS"> for details. 1471 1472=back 1473 1474I<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 1492Returns the HMAC-SHA-1/224/256/384/512 digest of I<$data>/I<$key>, 1493with the result encoded as a binary string. Multiple I<$data> 1494arguments are allowed, provided that I<$key> is the last argument 1495in 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 1511Returns the HMAC-SHA-1/224/256/384/512 digest of I<$data>/I<$key>, 1512with the result encoded as a hexadecimal string. Multiple I<$data> 1513arguments are allowed, provided that I<$key> is the last argument 1514in 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 1530Returns the HMAC-SHA-1/224/256/384/512 digest of I<$data>/I<$key>, 1531with the result encoded as a Base64 string. Multiple I<$data> 1532arguments are allowed, provided that I<$key> is the last argument 1533in the list. 1534 1535It's important to note that the resulting string does B<not> contain 1536the padding characters typical of Base64 encodings. This omission is 1537deliberate, and is done to maintain compatibility with the family of 1538CPAN Digest modules. See L</"PADDING OF BASE64 DIGESTS"> for details. 1539 1540=back 1541 1542=head1 SEE ALSO 1543 1544L<Digest>, L<Digest::SHA> 1545 1546The Secure Hash Standard (Draft FIPS PUB 180-4) can be found at: 1547 1548L<http://csrc.nist.gov/publications/drafts/fips180-4/Draft-FIPS180-4_Feb2011.pdf> 1549 1550The Keyed-Hash Message Authentication Code (HMAC): 1551 1552L<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 1560The author is particularly grateful to 1561 1562 Gisle Aas 1563 Sean Burke 1564 Chris Carey 1565 Alexandr Ciornii 1566 Jim Doble 1567 Thomas Drugeon 1568 Julius Duque 1569 Jeffrey Friedl 1570 Robert Gilmour 1571 Brian Gladman 1572 Adam Kennedy 1573 Mark Lawrence 1574 Andy Lester 1575 Alex Muntada 1576 Steve Peters 1577 Chris Skiscim 1578 Martin Thurn 1579 Gunnar Wolf 1580 Adam Woodbury 1581 1582"A candle in the bar was lighting up the dirty windows, on one of 1583which was a notice, in white enamel letters, telling customers they 1584could bring their own food: ON PEUT APPORTER SON MANGER, from which 1585the M and the last R were missing." 1586- Maigret's War of Nerves 1587 1588=head1 COPYRIGHT AND LICENSE 1589 1590Copyright (C) 2003-2016 Mark Shelor 1591 1592This library is free software; you can redistribute it and/or modify 1593it under the same terms as Perl itself. 1594 1595L<perlartistic> 1596 1597=cut 1598