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