Tcl Library Source Code

Artifact Content
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Artifact b47454aa1688516a8bde3a1a1b86c087888f91a4:


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