1# sha256.tcl - Copyright (C) 2005 Pat Thoyts <patthoyts@users.sourceforge.net> 2# 3# SHA1 defined by FIPS 180-2, "The Secure Hash Standard" 4# HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication" 5# 6# This is an implementation of the secure hash algorithms specified in the 7# FIPS 180-2 document. 8# 9# This implementation permits incremental updating of the hash and 10# provides support for external compiled implementations using critcl. 11# 12# This implementation permits incremental updating of the hash and 13# provides support for external compiled implementations either using 14# critcl (sha256c). 15# 16# Ref: http://csrc.nist.gov/publications/fips/fips180-2/fips180-2.pdf 17# http://csrc.nist.gov/publications/fips/fips180-2/fips180-2withchangenotice.pdf 18# 19# ------------------------------------------------------------------------- 20# See the file "license.terms" for information on usage and redistribution 21# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 22# ------------------------------------------------------------------------- 23# 24 25# @mdgen EXCLUDE: sha256c.tcl 26 27package require Tcl 8.2; # tcl minimum version 28 29namespace eval ::sha2 { 30 variable version 1.0.3 31 variable rcsid {$Id: sha256.tcl,v 1.7 2010/07/06 20:16:39 andreas_kupries Exp $} 32 33 variable accel 34 array set accel {tcl 0 critcl 0} 35 variable loaded {} 36 37 namespace export sha256 hmac \ 38 SHA256Init SHA256Update SHA256Final 39 40 variable uid 41 if {![info exists uid]} { 42 set uid 0 43 } 44 45 variable K 46 if {![info exists K]} { 47 # FIPS 180-2: 4.2.2 SHA-256 constants 48 set K [list \ 49 0x428a2f98 0x71374491 0xb5c0fbcf 0xe9b5dba5 \ 50 0x3956c25b 0x59f111f1 0x923f82a4 0xab1c5ed5 \ 51 0xd807aa98 0x12835b01 0x243185be 0x550c7dc3 \ 52 0x72be5d74 0x80deb1fe 0x9bdc06a7 0xc19bf174 \ 53 0xe49b69c1 0xefbe4786 0x0fc19dc6 0x240ca1cc \ 54 0x2de92c6f 0x4a7484aa 0x5cb0a9dc 0x76f988da \ 55 0x983e5152 0xa831c66d 0xb00327c8 0xbf597fc7 \ 56 0xc6e00bf3 0xd5a79147 0x06ca6351 0x14292967 \ 57 0x27b70a85 0x2e1b2138 0x4d2c6dfc 0x53380d13 \ 58 0x650a7354 0x766a0abb 0x81c2c92e 0x92722c85 \ 59 0xa2bfe8a1 0xa81a664b 0xc24b8b70 0xc76c51a3 \ 60 0xd192e819 0xd6990624 0xf40e3585 0x106aa070 \ 61 0x19a4c116 0x1e376c08 0x2748774c 0x34b0bcb5 \ 62 0x391c0cb3 0x4ed8aa4a 0x5b9cca4f 0x682e6ff3 \ 63 0x748f82ee 0x78a5636f 0x84c87814 0x8cc70208 \ 64 0x90befffa 0xa4506ceb 0xbef9a3f7 0xc67178f2 \ 65 ] 66 } 67 68} 69 70# ------------------------------------------------------------------------- 71# Management of sha256 implementations. 72 73# LoadAccelerator -- 74# 75# This package can make use of a number of compiled extensions to 76# accelerate the digest computation. This procedure manages the 77# use of these extensions within the package. During normal usage 78# this should not be called, but the test package manipulates the 79# list of enabled accelerators. 80# 81proc ::sha2::LoadAccelerator {name} { 82 variable accel 83 set r 0 84 switch -exact -- $name { 85 tcl { 86 # Already present (this file) 87 set r 1 88 } 89 critcl { 90 if {![catch {package require tcllibc}] 91 || ![catch {package require sha256c}]} { 92 set r [expr {[info command ::sha2::sha256c_update] != {}}] 93 } 94 } 95 default { 96 return -code error "invalid accelerator $key:\ 97 must be one of [join [KnownImplementations] {, }]" 98 } 99 } 100 set accel($name) $r 101 return $r 102} 103 104# ::sha2::Implementations -- 105# 106# Determines which implementations are 107# present, i.e. loaded. 108# 109# Arguments: 110# None. 111# 112# Results: 113# A list of implementation keys. 114 115proc ::sha2::Implementations {} { 116 variable accel 117 set res {} 118 foreach n [array names accel] { 119 if {!$accel($n)} continue 120 lappend res $n 121 } 122 return $res 123} 124 125# ::sha2::KnownImplementations -- 126# 127# Determines which implementations are known 128# as possible implementations. 129# 130# Arguments: 131# None. 132# 133# Results: 134# A list of implementation keys. In the order 135# of preference, most prefered first. 136 137proc ::sha2::KnownImplementations {} { 138 return {critcl tcl} 139} 140 141proc ::sha2::Names {} { 142 return { 143 critcl {tcllibc based} 144 tcl {pure Tcl} 145 } 146} 147 148# ::sha2::SwitchTo -- 149# 150# Activates a loaded named implementation. 151# 152# Arguments: 153# key Name of the implementation to activate. 154# 155# Results: 156# None. 157 158proc ::sha2::SwitchTo {key} { 159 variable accel 160 variable loaded 161 162 if {[string equal $key $loaded]} { 163 # No change, nothing to do. 164 return 165 } elseif {![string equal $key ""]} { 166 # Validate the target implementation of the switch. 167 168 if {![info exists accel($key)]} { 169 return -code error "Unable to activate unknown implementation \"$key\"" 170 } elseif {![info exists accel($key)] || !$accel($key)} { 171 return -code error "Unable to activate missing implementation \"$key\"" 172 } 173 } 174 175 # Deactivate the previous implementation, if there was any. 176 177 if {![string equal $loaded ""]} { 178 foreach c { 179 SHA256Init SHA224Init 180 SHA256Final SHA224Final 181 SHA256Update 182 } { 183 rename ::sha2::$c ::sha2::${c}-${loaded} 184 } 185 } 186 187 # Activate the new implementation, if there is any. 188 189 if {![string equal $key ""]} { 190 foreach c { 191 SHA256Init SHA224Init 192 SHA256Final SHA224Final 193 SHA256Update 194 } { 195 rename ::sha2::${c}-${key} ::sha2::$c 196 } 197 } 198 199 # Remember the active implementation, for deactivation by future 200 # switches. 201 202 set loaded $key 203 return 204} 205 206# ------------------------------------------------------------------------- 207 208# SHA256Init -- 209# 210# Create and initialize an SHA256 state variable. This will be 211# cleaned up when we call SHA256Final 212# 213 214proc ::sha2::SHA256Init-tcl {} { 215 variable uid 216 set token [namespace current]::[incr uid] 217 upvar #0 $token tok 218 219 # FIPS 180-2: 5.3.2 Setting the initial hash value 220 array set tok \ 221 [list \ 222 A [expr {int(0x6a09e667)}] \ 223 B [expr {int(0xbb67ae85)}] \ 224 C [expr {int(0x3c6ef372)}] \ 225 D [expr {int(0xa54ff53a)}] \ 226 E [expr {int(0x510e527f)}] \ 227 F [expr {int(0x9b05688c)}] \ 228 G [expr {int(0x1f83d9ab)}] \ 229 H [expr {int(0x5be0cd19)}] \ 230 n 0 i "" v 256] 231 return $token 232} 233 234proc ::sha2::SHA256Init-critcl {} { 235 variable uid 236 set token [namespace current]::[incr uid] 237 upvar #0 $token tok 238 239 # FIPS 180-2: 5.3.2 Setting the initial hash value 240 set tok(sha256c) [sha256c_init256] 241 return $token 242} 243 244# SHA256Update -- 245# 246# This is called to add more data into the hash. You may call this 247# as many times as you require. Note that passing in "ABC" is equivalent 248# to passing these letters in as separate calls -- hence this proc 249# permits hashing of chunked data 250# 251# If we have a C-based implementation available, then we will use 252# it here in preference to the pure-Tcl implementation. 253# 254 255proc ::sha2::SHA256Update-tcl {token data} { 256 upvar #0 $token state 257 258 # Update the state values 259 incr state(n) [string length $data] 260 append state(i) $data 261 262 # Calculate the hash for any complete blocks 263 set len [string length $state(i)] 264 for {set n 0} {($n + 64) <= $len} {} { 265 SHA256Transform $token [string range $state(i) $n [incr n 64]] 266 } 267 268 # Adjust the state for the blocks completed. 269 set state(i) [string range $state(i) $n end] 270 return 271} 272 273proc ::sha2::SHA256Update-critcl {token data} { 274 upvar #0 $token state 275 276 set state(sha256c) [sha256c_update $data $state(sha256c)] 277 return 278} 279 280# SHA256Final -- 281# 282# This procedure is used to close the current hash and returns the 283# hash data. Once this procedure has been called the hash context 284# is freed and cannot be used again. 285# 286# Note that the output is 256 bits represented as binary data. 287# 288 289proc ::sha2::SHA256Final-tcl {token} { 290 upvar #0 $token state 291 SHA256Penultimate $token 292 293 # Output 294 set r [bytes $state(A)][bytes $state(B)][bytes $state(C)][bytes $state(D)][bytes $state(E)][bytes $state(F)][bytes $state(G)][bytes $state(H)] 295 unset state 296 return $r 297} 298 299proc ::sha2::SHA256Final-critcl {token} { 300 upvar #0 $token state 301 set r $state(sha256c) 302 unset state 303 return $r 304} 305 306# SHA256Penultimate -- 307# 308# 309proc ::sha2::SHA256Penultimate {token} { 310 upvar #0 $token state 311 312 # FIPS 180-2: 5.1.1: Padding the message 313 # 314 set len [string length $state(i)] 315 set pad [expr {56 - ($len % 64)}] 316 if {$len % 64 > 56} { 317 incr pad 64 318 } 319 if {$pad == 0} { 320 incr pad 64 321 } 322 append state(i) [binary format a$pad \x80] 323 324 # Append length in bits as big-endian wide int. 325 set dlen [expr {8 * $state(n)}] 326 append state(i) [binary format II 0 $dlen] 327 328 # Calculate the hash for the remaining block. 329 set len [string length $state(i)] 330 for {set n 0} {($n + 64) <= $len} {} { 331 SHA256Transform $token [string range $state(i) $n [incr n 64]] 332 } 333} 334 335# ------------------------------------------------------------------------- 336 337proc ::sha2::SHA224Init-tcl {} { 338 variable uid 339 set token [namespace current]::[incr uid] 340 upvar #0 $token tok 341 342 # FIPS 180-2 (change notice 1) (1): SHA-224 initialization values 343 array set tok \ 344 [list \ 345 A [expr {int(0xc1059ed8)}] \ 346 B [expr {int(0x367cd507)}] \ 347 C [expr {int(0x3070dd17)}] \ 348 D [expr {int(0xf70e5939)}] \ 349 E [expr {int(0xffc00b31)}] \ 350 F [expr {int(0x68581511)}] \ 351 G [expr {int(0x64f98fa7)}] \ 352 H [expr {int(0xbefa4fa4)}] \ 353 n 0 i "" v 224] 354 return $token 355} 356 357proc ::sha2::SHA224Init-critcl {} { 358 variable uid 359 set token [namespace current]::[incr uid] 360 upvar #0 $token tok 361 362 # FIPS 180-2 (change notice 1) (1): SHA-224 initialization values 363 set tok(sha256c) [sha256c_init224] 364 return $token 365} 366 367interp alias {} ::sha2::SHA224Update {} ::sha2::SHA256Update 368 369proc ::sha2::SHA224Final-tcl {token} { 370 upvar #0 $token state 371 SHA256Penultimate $token 372 373 # Output 374 set r [bytes $state(A)][bytes $state(B)][bytes $state(C)][bytes $state(D)][bytes $state(E)][bytes $state(F)][bytes $state(G)] 375 unset state 376 return $r 377} 378 379proc ::sha2::SHA224Final-critcl {token} { 380 upvar #0 $token state 381 # Trim result down to 224 bits (by 4 bytes). 382 # See output below, A..G, not A..H 383 set r [string range $state(sha256c) 0 end-4] 384 unset state 385 return $r 386} 387 388# ------------------------------------------------------------------------- 389# HMAC Hashed Message Authentication (RFC 2104) 390# 391# hmac = H(K xor opad, H(K xor ipad, text)) 392# 393 394# HMACInit -- 395# 396# This is equivalent to the SHA1Init procedure except that a key is 397# added into the algorithm 398# 399proc ::sha2::HMACInit {K} { 400 401 # Key K is adjusted to be 64 bytes long. If K is larger, then use 402 # the SHA1 digest of K and pad this instead. 403 set len [string length $K] 404 if {$len > 64} { 405 set tok [SHA256Init] 406 SHA256Update $tok $K 407 set K [SHA256Final $tok] 408 set len [string length $K] 409 } 410 set pad [expr {64 - $len}] 411 append K [string repeat \0 $pad] 412 413 # Cacluate the padding buffers. 414 set Ki {} 415 set Ko {} 416 binary scan $K i16 Ks 417 foreach k $Ks { 418 append Ki [binary format i [expr {$k ^ 0x36363636}]] 419 append Ko [binary format i [expr {$k ^ 0x5c5c5c5c}]] 420 } 421 422 set tok [SHA256Init] 423 SHA256Update $tok $Ki; # initialize with the inner pad 424 425 # preserve the Ko value for the final stage. 426 # FRINK: nocheck 427 set [subst $tok](Ko) $Ko 428 429 return $tok 430} 431 432# HMACUpdate -- 433# 434# Identical to calling SHA256Update 435# 436proc ::sha2::HMACUpdate {token data} { 437 SHA256Update $token $data 438 return 439} 440 441# HMACFinal -- 442# 443# This is equivalent to the SHA256Final procedure. The hash context is 444# closed and the binary representation of the hash result is returned. 445# 446proc ::sha2::HMACFinal {token} { 447 upvar #0 $token state 448 449 set tok [SHA256Init]; # init the outer hashing function 450 SHA256Update $tok $state(Ko); # prepare with the outer pad. 451 SHA256Update $tok [SHA256Final $token]; # hash the inner result 452 return [SHA256Final $tok] 453} 454 455# ------------------------------------------------------------------------- 456# Description: 457# This is the core SHA1 algorithm. It is a lot like the MD4 algorithm but 458# includes an extra round and a set of constant modifiers throughout. 459# 460set ::sha2::SHA256Transform_body { 461 variable K 462 upvar #0 $token state 463 464 # FIPS 180-2: 6.2.2 SHA-256 Hash computation. 465 binary scan $msg I* blocks 466 set blockLen [llength $blocks] 467 for {set i 0} {$i < $blockLen} {incr i 16} { 468 set W [lrange $blocks $i [expr {$i+15}]] 469 470 # FIPS 180-2: 6.2.2 (1) Prepare the message schedule 471 # For t = 16 to 64 472 # let Wt = (sigma1(Wt-2) + Wt-7 + sigma0(Wt-15) + Wt-16) 473 set t2 13 474 set t7 8 475 set t15 0 476 set t16 -1 477 for {set t 16} {$t < 64} {incr t} { 478 lappend W [expr {([sigma1 [lindex $W [incr t2]]] \ 479 + [lindex $W [incr t7]] \ 480 + [sigma0 [lindex $W [incr t15]]] \ 481 + [lindex $W [incr t16]]) & 0xffffffff}] 482 } 483 484 # FIPS 180-2: 6.2.2 (2) Initialise the working variables 485 set A $state(A) 486 set B $state(B) 487 set C $state(C) 488 set D $state(D) 489 set E $state(E) 490 set F $state(F) 491 set G $state(G) 492 set H $state(H) 493 494 # FIPS 180-2: 6.2.2 (3) Do permutation rounds 495 # For t = 0 to 63 do 496 # T1 = h + SIGMA1(e) + Ch(e,f,g) + Kt + Wt 497 # T2 = SIGMA0(a) + Maj(a,b,c) 498 # h = g; g = f; f = e; e = d + T1; d = c; c = b; b = a; 499 # a = T1 + T2 500 # 501 for {set t 0} {$t < 64} {incr t} { 502 set T1 [expr {($H + [SIGMA1 $E] + [Ch $E $F $G] 503 + [lindex $K $t] + [lindex $W $t]) & 0xffffffff}] 504 set T2 [expr {([SIGMA0 $A] + [Maj $A $B $C]) & 0xffffffff}] 505 set H $G 506 set G $F 507 set F $E 508 set E [expr {($D + $T1) & 0xffffffff}] 509 set D $C 510 set C $B 511 set B $A 512 set A [expr {($T1 + $T2) & 0xffffffff}] 513 } 514 515 # FIPS 180-2: 6.2.2 (4) Compute the intermediate hash 516 incr state(A) $A 517 incr state(B) $B 518 incr state(C) $C 519 incr state(D) $D 520 incr state(E) $E 521 incr state(F) $F 522 incr state(G) $G 523 incr state(H) $H 524 } 525 526 return 527} 528 529# ------------------------------------------------------------------------- 530 531# FIPS 180-2: 4.1.2 equation 4.2 532proc ::sha2::Ch {x y z} { 533 return [expr {($x & $y) ^ (~$x & $z)}] 534} 535 536# FIPS 180-2: 4.1.2 equation 4.3 537proc ::sha2::Maj {x y z} { 538 return [expr {($x & $y) ^ ($x & $z) ^ ($y & $z)}] 539} 540 541# FIPS 180-2: 4.1.2 equation 4.4 542# (x >>> 2) ^ (x >>> 13) ^ (x >>> 22) 543proc ::sha2::SIGMA0 {x} { 544 return [expr {[>>> $x 2] ^ [>>> $x 13] ^ [>>> $x 22]}] 545} 546 547# FIPS 180-2: 4.1.2 equation 4.5 548# (x >>> 6) ^ (x >>> 11) ^ (x >>> 25) 549proc ::sha2::SIGMA1 {x} { 550 return [expr {[>>> $x 6] ^ [>>> $x 11] ^ [>>> $x 25]}] 551} 552 553# FIPS 180-2: 4.1.2 equation 4.6 554# s0 = (x >>> 7) ^ (x >>> 18) ^ (x >> 3) 555proc ::sha2::sigma0 {x} { 556 #return [expr {[>>> $x 7] ^ [>>> $x 18] ^ (($x >> 3) & 0x1fffffff)}] 557 return [expr {((($x<<25) | (($x>>7) & (0x7FFFFFFF>>6))) \ 558 ^ (($x<<14) | (($x>>18) & (0x7FFFFFFF>>17))) & 0xFFFFFFFF) \ 559 ^ (($x>>3) & 0x1fffffff)}] 560} 561 562# FIPS 180-2: 4.1.2 equation 4.7 563# s1 = (x >>> 17) ^ (x >>> 19) ^ (x >> 10) 564proc ::sha2::sigma1 {x} { 565 #return [expr {[>>> $x 17] ^ [>>> $x 19] ^ (($x >> 10) & 0x003fffff)}] 566 return [expr {((($x<<15) | (($x>>17) & (0x7FFFFFFF>>16))) \ 567 ^ (($x<<13) | (($x>>19) & (0x7FFFFFFF>>18))) & 0xFFFFFFFF) \ 568 ^ (($x >> 10) & 0x003fffff)}] 569} 570 571# 32bit rotate-right 572proc ::sha2::>>> {v n} { 573 return [expr {(($v << (32 - $n)) \ 574 | (($v >> $n) & (0x7FFFFFFF >> ($n - 1)))) \ 575 & 0xFFFFFFFF}] 576} 577 578# 32bit rotate-left 579proc ::sha2::<<< {v n} { 580 return [expr {((($v << $n) \ 581 | (($v >> (32 - $n)) \ 582 & (0x7FFFFFFF >> (31 - $n))))) \ 583 & 0xFFFFFFFF}] 584} 585 586# ------------------------------------------------------------------------- 587# We speed up the SHA256Transform code while maintaining readability in the 588# source code by substituting inline for a number of functions. 589# The idea is to reduce the number of [expr] calls. 590 591# Inline the Ch function 592regsub -all -line \ 593 {\[Ch (\$[ABCDEFGH]) (\$[ABCDEFGH]) (\$[ABCDEFGH])\]} \ 594 $::sha2::SHA256Transform_body \ 595 {((\1 \& \2) ^ ((~\1) \& \3))} \ 596 ::sha2::SHA256Transform_body 597 598# Inline the Maj function 599regsub -all -line \ 600 {\[Maj (\$[ABCDEFGH]) (\$[ABCDEFGH]) (\$[ABCDEFGH])\]} \ 601 $::sha2::SHA256Transform_body \ 602 {((\1 \& \2) ^ (\1 \& \3) ^ (\2 \& \3))} \ 603 ::sha2::SHA256Transform_body 604 605 606# Inline the SIGMA0 function 607regsub -all -line \ 608 {\[SIGMA0 (\$[ABCDEFGH])\]} \ 609 $::sha2::SHA256Transform_body \ 610 {((((\1<<30) | ((\1>>2) \& (0x7FFFFFFF>>1))) \& 0xFFFFFFFF) \ 611 ^ (((\1<<19) | ((\1>>13) \& (0x7FFFFFFF>>12))) \& 0xFFFFFFFF) \ 612 ^ (((\1<<10) | ((\1>>22) \& (0x7FFFFFFF>>21))) \& 0xFFFFFFFF) \ 613 )} \ 614 ::sha2::SHA256Transform_body 615 616# Inline the SIGMA1 function 617regsub -all -line \ 618 {\[SIGMA1 (\$[ABCDEFGH])\]} \ 619 $::sha2::SHA256Transform_body \ 620 {((((\1<<26) | ((\1>>6) \& (0x7FFFFFFF>>5))) \& 0xFFFFFFFF) \ 621 ^ (((\1<<21) | ((\1>>11) \& (0x7FFFFFFF>>10))) \& 0xFFFFFFFF) \ 622 ^ (((\1<<7) | ((\1>>25) \& (0x7FFFFFFF>>24))) \& 0xFFFFFFFF) \ 623 )} \ 624 ::sha2::SHA256Transform_body 625 626proc ::sha2::SHA256Transform {token msg} $::sha2::SHA256Transform_body 627 628# ------------------------------------------------------------------------- 629 630# Convert a integer value into a binary string in big-endian order. 631proc ::sha2::byte {n v} {expr {((0xFF << (8 * $n)) & $v) >> (8 * $n)}} 632proc ::sha2::bytes {v} { 633 #format %c%c%c%c [byte 3 $v] [byte 2 $v] [byte 1 $v] [byte 0 $v] 634 format %c%c%c%c \ 635 [expr {((0xFF000000 & $v) >> 24) & 0xFF}] \ 636 [expr {(0xFF0000 & $v) >> 16}] \ 637 [expr {(0xFF00 & $v) >> 8}] \ 638 [expr {0xFF & $v}] 639} 640 641# ------------------------------------------------------------------------- 642 643proc ::sha2::Hex {data} { 644 binary scan $data H* result 645 return $result 646} 647 648# ------------------------------------------------------------------------- 649 650# Description: 651# Pop the nth element off a list. Used in options processing. 652# 653proc ::sha2::Pop {varname {nth 0}} { 654 upvar $varname args 655 set r [lindex $args $nth] 656 set args [lreplace $args $nth $nth] 657 return $r 658} 659 660# ------------------------------------------------------------------------- 661 662# fileevent handler for chunked file hashing. 663# 664proc ::sha2::Chunk {token channel {chunksize 4096}} { 665 upvar #0 $token state 666 667 if {[eof $channel]} { 668 fileevent $channel readable {} 669 set state(reading) 0 670 } 671 672 SHA256Update $token [read $channel $chunksize] 673} 674 675# ------------------------------------------------------------------------- 676 677proc ::sha2::_sha256 {ver args} { 678 array set opts {-hex 0 -filename {} -channel {} -chunksize 4096} 679 if {[llength $args] == 1} { 680 set opts(-hex) 1 681 } else { 682 while {[string match -* [set option [lindex $args 0]]]} { 683 switch -glob -- $option { 684 -hex { set opts(-hex) 1 } 685 -bin { set opts(-hex) 0 } 686 -file* { set opts(-filename) [Pop args 1] } 687 -channel { set opts(-channel) [Pop args 1] } 688 -chunksize { set opts(-chunksize) [Pop args 1] } 689 default { 690 if {[llength $args] == 1} { break } 691 if {[string compare $option "--"] == 0} { Pop args; break } 692 set err [join [lsort [concat -bin [array names opts]]] ", "] 693 return -code error "bad option $option:\ 694 must be one of $err" 695 } 696 } 697 Pop args 698 } 699 } 700 701 if {$opts(-filename) != {}} { 702 set opts(-channel) [open $opts(-filename) r] 703 fconfigure $opts(-channel) -translation binary 704 } 705 706 if {$opts(-channel) == {}} { 707 708 if {[llength $args] != 1} { 709 return -code error "wrong # args: should be\ 710 \"[namespace current]::sha$ver ?-hex|-bin? -filename file\ 711 | -channel channel | string\"" 712 } 713 set tok [SHA${ver}Init] 714 SHA${ver}Update $tok [lindex $args 0] 715 set r [SHA${ver}Final $tok] 716 717 } else { 718 719 set tok [SHA${ver}Init] 720 # FRINK: nocheck 721 set [subst $tok](reading) 1 722 fileevent $opts(-channel) readable \ 723 [list [namespace origin Chunk] \ 724 $tok $opts(-channel) $opts(-chunksize)] 725 # FRINK: nocheck 726 vwait [subst $tok](reading) 727 set r [SHA${ver}Final $tok] 728 729 # If we opened the channel - we should close it too. 730 if {$opts(-filename) != {}} { 731 close $opts(-channel) 732 } 733 } 734 735 if {$opts(-hex)} { 736 set r [Hex $r] 737 } 738 return $r 739} 740 741interp alias {} ::sha2::sha256 {} ::sha2::_sha256 256 742interp alias {} ::sha2::sha224 {} ::sha2::_sha256 224 743 744# ------------------------------------------------------------------------- 745 746proc ::sha2::hmac {args} { 747 array set opts {-hex 1 -filename {} -channel {} -chunksize 4096} 748 if {[llength $args] != 2} { 749 while {[string match -* [set option [lindex $args 0]]]} { 750 switch -glob -- $option { 751 -key { set opts(-key) [Pop args 1] } 752 -hex { set opts(-hex) 1 } 753 -bin { set opts(-hex) 0 } 754 -file* { set opts(-filename) [Pop args 1] } 755 -channel { set opts(-channel) [Pop args 1] } 756 -chunksize { set opts(-chunksize) [Pop args 1] } 757 default { 758 if {[llength $args] == 1} { break } 759 if {[string compare $option "--"] == 0} { Pop args; break } 760 set err [join [lsort [array names opts]] ", "] 761 return -code error "bad option $option:\ 762 must be one of $err" 763 } 764 } 765 Pop args 766 } 767 } 768 769 if {[llength $args] == 2} { 770 set opts(-key) [Pop args] 771 } 772 773 if {![info exists opts(-key)]} { 774 return -code error "wrong # args:\ 775 should be \"hmac ?-hex? -key key -filename file | string\"" 776 } 777 778 if {$opts(-filename) != {}} { 779 set opts(-channel) [open $opts(-filename) r] 780 fconfigure $opts(-channel) -translation binary 781 } 782 783 if {$opts(-channel) == {}} { 784 785 if {[llength $args] != 1} { 786 return -code error "wrong # args:\ 787 should be \"hmac ?-hex? -key key -filename file | string\"" 788 } 789 set tok [HMACInit $opts(-key)] 790 HMACUpdate $tok [lindex $args 0] 791 set r [HMACFinal $tok] 792 793 } else { 794 795 set tok [HMACInit $opts(-key)] 796 # FRINK: nocheck 797 set [subst $tok](reading) 1 798 fileevent $opts(-channel) readable \ 799 [list [namespace origin Chunk] \ 800 $tok $opts(-channel) $opts(-chunksize)] 801 # FRINK: nocheck 802 vwait [subst $tok](reading) 803 set r [HMACFinal $tok] 804 805 # If we opened the channel - we should close it too. 806 if {$opts(-filename) != {}} { 807 close $opts(-channel) 808 } 809 } 810 811 if {$opts(-hex)} { 812 set r [Hex $r] 813 } 814 return $r 815} 816 817# ------------------------------------------------------------------------- 818 819# Try and load a compiled extension to help. 820namespace eval ::sha2 { 821 variable e {} 822 foreach e [KnownImplementations] { 823 if {[LoadAccelerator $e]} { 824 SwitchTo $e 825 break 826 } 827 } 828 unset e 829} 830 831package provide sha256 $::sha2::version 832 833# ------------------------------------------------------------------------- 834# Local Variables: 835# mode: tcl 836# indent-tabs-mode: nil 837# End: 838