1# sha1.tcl - 2# 3# Copyright (C) 2001 Don Libes <libes@nist.gov> 4# Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net> 5# 6# SHA1 defined by FIPS 180-1, "The SHA1 Message-Digest Algorithm" 7# HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication" 8# 9# This is an implementation of SHA1 based upon the example code given in 10# FIPS 180-1 and upon the tcllib MD4 implementation and taking some ideas 11# and methods from the earlier tcllib sha1 version by Don Libes. 12# 13# This implementation permits incremental updating of the hash and 14# provides support for external compiled implementations either using 15# critcl (sha1c) or Trf. 16# 17# ref: http://www.itl.nist.gov/fipspubs/fip180-1.htm 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: sha1c.tcl 24 25package require Tcl 8.2; # tcl minimum version 26 27namespace eval ::sha1 { 28 variable accel 29 array set accel {critcl 0 cryptkit 0 trf 0} 30 31 namespace export sha1 hmac SHA1Init SHA1Update SHA1Final 32 33 variable uid 34 if {![info exists uid]} { 35 set uid 0 36 } 37} 38 39# ------------------------------------------------------------------------- 40 41# SHA1Init -- 42# 43# Create and initialize an SHA1 state variable. This will be 44# cleaned up when we call SHA1Final 45# 46proc ::sha1::SHA1Init {} { 47 variable accel 48 variable uid 49 set token [namespace current]::[incr uid] 50 upvar #0 $token state 51 52 # FIPS 180-1: 7 - Initialize the hash state 53 array set state \ 54 [list \ 55 A [expr {int(0x67452301)}] \ 56 B [expr {int(0xEFCDAB89)}] \ 57 C [expr {int(0x98BADCFE)}] \ 58 D [expr {int(0x10325476)}] \ 59 E [expr {int(0xC3D2E1F0)}] \ 60 n 0 i "" ] 61 if {$accel(cryptkit)} { 62 cryptkit::cryptCreateContext state(ckctx) CRYPT_UNUSED CRYPT_ALGO_SHA 63 } elseif {$accel(trf)} { 64 set s {} 65 switch -exact -- $::tcl_platform(platform) { 66 windows { set s [open NUL w] } 67 unix { set s [open /dev/null w] } 68 } 69 if {$s != {}} { 70 fconfigure $s -translation binary -buffering none 71 ::sha1 -attach $s -mode write \ 72 -read-type variable \ 73 -read-destination [subst $token](trfread) \ 74 -write-type variable \ 75 -write-destination [subst $token](trfwrite) 76 array set state [list trfread 0 trfwrite 0 trf $s] 77 } 78 } 79 return $token 80} 81 82# SHA1Update -- 83# 84# This is called to add more data into the hash. You may call this 85# as many times as you require. Note that passing in "ABC" is equivalent 86# to passing these letters in as separate calls -- hence this proc 87# permits hashing of chunked data 88# 89# If we have a C-based implementation available, then we will use 90# it here in preference to the pure-Tcl implementation. 91# 92proc ::sha1::SHA1Update {token data} { 93 variable accel 94 upvar #0 $token state 95 96 if {$accel(critcl)} { 97 if {[info exists state(sha1c)]} { 98 set state(sha1c) [sha1c $data $state(sha1c)] 99 } else { 100 set state(sha1c) [sha1c $data] 101 } 102 return 103 } elseif {[info exists state(ckctx)]} { 104 if {[string length $data] > 0} { 105 cryptkit::cryptEncrypt $state(ckctx) $data 106 } 107 return 108 } elseif {[info exists state(trf)]} { 109 puts -nonewline $state(trf) $data 110 return 111 } 112 113 # Update the state values 114 incr state(n) [string length $data] 115 append state(i) $data 116 117 # Calculate the hash for any complete blocks 118 set len [string length $state(i)] 119 for {set n 0} {($n + 64) <= $len} {} { 120 SHA1Transform $token [string range $state(i) $n [incr n 64]] 121 } 122 123 # Adjust the state for the blocks completed. 124 set state(i) [string range $state(i) $n end] 125 return 126} 127 128# SHA1Final -- 129# 130# This procedure is used to close the current hash and returns the 131# hash data. Once this procedure has been called the hash context 132# is freed and cannot be used again. 133# 134# Note that the output is 160 bits represented as binary data. 135# 136proc ::sha1::SHA1Final {token} { 137 upvar #0 $token state 138 139 # Check for either of the C-compiled versions. 140 if {[info exists state(sha1c)]} { 141 set r $state(sha1c) 142 unset state 143 return $r 144 } elseif {[info exists state(ckctx)]} { 145 cryptkit::cryptEncrypt $state(ckctx) "" 146 cryptkit::cryptGetAttributeString $state(ckctx) \ 147 CRYPT_CTXINFO_HASHVALUE r 20 148 cryptkit::cryptDestroyContext $state(ckctx) 149 # If nothing was hashed, we get no r variable set! 150 if {[info exists r]} { 151 unset state 152 return $r 153 } 154 } elseif {[info exists state(trf)]} { 155 close $state(trf) 156 set r $state(trfwrite) 157 unset state 158 return $r 159 } 160 161 # Padding 162 # 163 set len [string length $state(i)] 164 set pad [expr {56 - ($len % 64)}] 165 if {$len % 64 > 56} { 166 incr pad 64 167 } 168 if {$pad == 0} { 169 incr pad 64 170 } 171 append state(i) [binary format a$pad \x80] 172 173 # Append length in bits as big-endian wide int. 174 set dlen [expr {8 * $state(n)}] 175 append state(i) [binary format II 0 $dlen] 176 177 # Calculate the hash for the remaining block. 178 set len [string length $state(i)] 179 for {set n 0} {($n + 64) <= $len} {} { 180 SHA1Transform $token [string range $state(i) $n [incr n 64]] 181 } 182 183 # Output 184 set r [bytes $state(A)][bytes $state(B)][bytes $state(C)][bytes $state(D)][bytes $state(E)] 185 unset state 186 return $r 187} 188 189# ------------------------------------------------------------------------- 190# HMAC Hashed Message Authentication (RFC 2104) 191# 192# hmac = H(K xor opad, H(K xor ipad, text)) 193# 194 195# HMACInit -- 196# 197# This is equivalent to the SHA1Init procedure except that a key is 198# added into the algorithm 199# 200proc ::sha1::HMACInit {K} { 201 202 # Key K is adjusted to be 64 bytes long. If K is larger, then use 203 # the SHA1 digest of K and pad this instead. 204 set len [string length $K] 205 if {$len > 64} { 206 set tok [SHA1Init] 207 SHA1Update $tok $K 208 set K [SHA1Final $tok] 209 set len [string length $K] 210 } 211 set pad [expr {64 - $len}] 212 append K [string repeat \0 $pad] 213 214 # Cacluate the padding buffers. 215 set Ki {} 216 set Ko {} 217 binary scan $K i16 Ks 218 foreach k $Ks { 219 append Ki [binary format i [expr {$k ^ 0x36363636}]] 220 append Ko [binary format i [expr {$k ^ 0x5c5c5c5c}]] 221 } 222 223 set tok [SHA1Init] 224 SHA1Update $tok $Ki; # initialize with the inner pad 225 226 # preserve the Ko value for the final stage. 227 # FRINK: nocheck 228 set [subst $tok](Ko) $Ko 229 230 return $tok 231} 232 233# HMACUpdate -- 234# 235# Identical to calling SHA1Update 236# 237proc ::sha1::HMACUpdate {token data} { 238 SHA1Update $token $data 239 return 240} 241 242# HMACFinal -- 243# 244# This is equivalent to the SHA1Final procedure. The hash context is 245# closed and the binary representation of the hash result is returned. 246# 247proc ::sha1::HMACFinal {token} { 248 upvar #0 $token state 249 250 set tok [SHA1Init]; # init the outer hashing function 251 SHA1Update $tok $state(Ko); # prepare with the outer pad. 252 SHA1Update $tok [SHA1Final $token]; # hash the inner result 253 return [SHA1Final $tok] 254} 255 256# ------------------------------------------------------------------------- 257# Description: 258# This is the core SHA1 algorithm. It is a lot like the MD4 algorithm but 259# includes an extra round and a set of constant modifiers throughout. 260# 261set ::sha1::SHA1Transform_body { 262 upvar #0 $token state 263 264 # FIPS 180-1: 7a: Process Message in 16-Word Blocks 265 binary scan $msg I* blocks 266 set blockLen [llength $blocks] 267 for {set i 0} {$i < $blockLen} {incr i 16} { 268 set W [lrange $blocks $i [expr {$i+15}]] 269 270 # FIPS 180-1: 7b: Expand the input into 80 words 271 # For t = 16 to 79 272 # let Wt = (Wt-3 ^ Wt-8 ^ Wt-14 ^ Wt-16) <<< 1 273 set t3 12 274 set t8 7 275 set t14 1 276 set t16 -1 277 for {set t 16} {$t < 80} {incr t} { 278 set x [expr {[lindex $W [incr t3]] ^ [lindex $W [incr t8]] ^ \ 279 [lindex $W [incr t14]] ^ [lindex $W [incr t16]]}] 280 lappend W [expr {int(($x << 1) | (($x >> 31) & 1))}] 281 } 282 283 # FIPS 180-1: 7c: Copy hash state. 284 set A $state(A) 285 set B $state(B) 286 set C $state(C) 287 set D $state(D) 288 set E $state(E) 289 290 # FIPS 180-1: 7d: Do permutation rounds 291 # For t = 0 to 79 do 292 # TEMP = (A<<<5) + ft(B,C,D) + E + Wt + Kt; 293 # E = D; D = C; C = S30(B); B = A; A = TEMP; 294 295 # Round 1: ft(B,C,D) = (B & C) | (~B & D) ( 0 <= t <= 19) 296 for {set t 0} {$t < 20} {incr t} { 297 set TEMP [F1 $A $B $C $D $E [lindex $W $t]] 298 set E $D 299 set D $C 300 set C [rotl32 $B 30] 301 set B $A 302 set A $TEMP 303 } 304 305 # Round 2: ft(B,C,D) = (B ^ C ^ D) ( 20 <= t <= 39) 306 for {} {$t < 40} {incr t} { 307 set TEMP [F2 $A $B $C $D $E [lindex $W $t]] 308 set E $D 309 set D $C 310 set C [rotl32 $B 30] 311 set B $A 312 set A $TEMP 313 } 314 315 # Round 3: ft(B,C,D) = ((B & C) | (B & D) | (C & D)) ( 40 <= t <= 59) 316 for {} {$t < 60} {incr t} { 317 set TEMP [F3 $A $B $C $D $E [lindex $W $t]] 318 set E $D 319 set D $C 320 set C [rotl32 $B 30] 321 set B $A 322 set A $TEMP 323 } 324 325 # Round 4: ft(B,C,D) = (B ^ C ^ D) ( 60 <= t <= 79) 326 for {} {$t < 80} {incr t} { 327 set TEMP [F4 $A $B $C $D $E [lindex $W $t]] 328 set E $D 329 set D $C 330 set C [rotl32 $B 30] 331 set B $A 332 set A $TEMP 333 } 334 335 # Then perform the following additions. (That is, increment each 336 # of the four registers by the value it had before this block 337 # was started.) 338 incr state(A) $A 339 incr state(B) $B 340 incr state(C) $C 341 incr state(D) $D 342 incr state(E) $E 343 } 344 345 return 346} 347 348proc ::sha1::F1 {A B C D E W} { 349 expr {(((($A << 5) & 0xffffffff) | (($A >> 27) & 0x1f)) \ 350 + ($D ^ ($B & ($C ^ $D))) + $E + $W + 0x5a827999) & 0xffffffff} 351} 352 353proc ::sha1::F2 {A B C D E W} { 354 expr {(((($A << 5) & 0xffffffff) | (($A >> 27) & 0x1f)) \ 355 + ($B ^ $C ^ $D) + $E + $W + 0x6ed9eba1) & 0xffffffff} 356} 357 358proc ::sha1::F3 {A B C D E W} { 359 expr {(((($A << 5) & 0xffffffff)| (($A >> 27) & 0x1f)) \ 360 + (($B & $C) | ($D & ($B | $C))) + $E + $W + 0x8f1bbcdc) & 0xffffffff} 361} 362 363proc ::sha1::F4 {A B C D E W} { 364 expr {(((($A << 5) & 0xffffffff)| (($A >> 27) & 0x1f)) \ 365 + ($B ^ $C ^ $D) + $E + $W + 0xca62c1d6) & 0xffffffff} 366} 367 368proc ::sha1::rotl32 {v n} { 369 return [expr {((($v << $n) \ 370 | (($v >> (32 - $n)) \ 371 & (0x7FFFFFFF >> (31 - $n))))) \ 372 & 0xFFFFFFFF}] 373} 374 375 376# ------------------------------------------------------------------------- 377# 378# In order to get this code to go as fast as possible while leaving 379# the main code readable we can substitute the above function bodies 380# into the transform procedure. This inlines the code for us an avoids 381# a procedure call overhead within the loops. 382# 383# We can do some minor tweaking to improve speed on Tcl < 8.5 where we 384# know our arithmetic is limited to 64 bits. On > 8.5 we may have 385# unconstrained integer arithmetic and must avoid letting it run away. 386# 387 388regsub -all -line \ 389 {\[F1 \$A \$B \$C \$D \$E (\[.*?\])\]} \ 390 $::sha1::SHA1Transform_body \ 391 {[expr {(rotl32($A,5) + ($D ^ ($B \& ($C ^ $D))) + $E + \1 + 0x5a827999) \& 0xffffffff}]} \ 392 ::sha1::SHA1Transform_body_tmp 393 394regsub -all -line \ 395 {\[F2 \$A \$B \$C \$D \$E (\[.*?\])\]} \ 396 $::sha1::SHA1Transform_body_tmp \ 397 {[expr {(rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0x6ed9eba1) \& 0xffffffff}]} \ 398 ::sha1::SHA1Transform_body_tmp 399 400regsub -all -line \ 401 {\[F3 \$A \$B \$C \$D \$E (\[.*?\])\]} \ 402 $::sha1::SHA1Transform_body_tmp \ 403 {[expr {(rotl32($A,5) + (($B \& $C) | ($D \& ($B | $C))) + $E + \1 + 0x8f1bbcdc) \& 0xffffffff}]} \ 404 ::sha1::SHA1Transform_body_tmp 405 406regsub -all -line \ 407 {\[F4 \$A \$B \$C \$D \$E (\[.*?\])\]} \ 408 $::sha1::SHA1Transform_body_tmp \ 409 {[expr {(rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0xca62c1d6) \& 0xffffffff}]} \ 410 ::sha1::SHA1Transform_body_tmp 411 412regsub -all -line \ 413 {rotl32\(\$A,5\)} \ 414 $::sha1::SHA1Transform_body_tmp \ 415 {((($A << 5) \& 0xffffffff) | (($A >> 27) \& 0x1f))} \ 416 ::sha1::SHA1Transform_body_tmp 417 418regsub -all -line \ 419 {\[rotl32 \$B 30\]} \ 420 $::sha1::SHA1Transform_body_tmp \ 421 {[expr {int(($B << 30) | (($B >> 2) \& 0x3fffffff))}]} \ 422 ::sha1::SHA1Transform_body_tmp 423# 424# Version 2 avoids a few truncations to 32 bits in non-essential places. 425# 426regsub -all -line \ 427 {\[F1 \$A \$B \$C \$D \$E (\[.*?\])\]} \ 428 $::sha1::SHA1Transform_body \ 429 {[expr {rotl32($A,5) + ($D ^ ($B \& ($C ^ $D))) + $E + \1 + 0x5a827999}]} \ 430 ::sha1::SHA1Transform_body_tmp2 431 432regsub -all -line \ 433 {\[F2 \$A \$B \$C \$D \$E (\[.*?\])\]} \ 434 $::sha1::SHA1Transform_body_tmp2 \ 435 {[expr {rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0x6ed9eba1}]} \ 436 ::sha1::SHA1Transform_body_tmp2 437 438regsub -all -line \ 439 {\[F3 \$A \$B \$C \$D \$E (\[.*?\])\]} \ 440 $::sha1::SHA1Transform_body_tmp2 \ 441 {[expr {rotl32($A,5) + (($B \& $C) | ($D \& ($B | $C))) + $E + \1 + 0x8f1bbcdc}]} \ 442 ::sha1::SHA1Transform_body_tmp2 443 444regsub -all -line \ 445 {\[F4 \$A \$B \$C \$D \$E (\[.*?\])\]} \ 446 $::sha1::SHA1Transform_body_tmp2 \ 447 {[expr {rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0xca62c1d6}]} \ 448 ::sha1::SHA1Transform_body_tmp2 449 450regsub -all -line \ 451 {rotl32\(\$A,5\)} \ 452 $::sha1::SHA1Transform_body_tmp2 \ 453 {(($A << 5) | (($A >> 27) \& 0x1f))} \ 454 ::sha1::SHA1Transform_body_tmp2 455 456regsub -all -line \ 457 {\[rotl32 \$B 30\]} \ 458 $::sha1::SHA1Transform_body_tmp2 \ 459 {[expr {($B << 30) | (($B >> 2) \& 0x3fffffff)}]} \ 460 ::sha1::SHA1Transform_body_tmp2 461 462if {[package vsatisfies [package provide Tcl] 8.5]} { 463 proc ::sha1::SHA1Transform {token msg} $::sha1::SHA1Transform_body_tmp 464} else { 465 proc ::sha1::SHA1Transform {token msg} $::sha1::SHA1Transform_body_tmp2 466} 467 468unset ::sha1::SHA1Transform_body_tmp 469unset ::sha1::SHA1Transform_body_tmp2 470 471# ------------------------------------------------------------------------- 472 473proc ::sha1::byte {n v} {expr {((0xFF << (8 * $n)) & $v) >> (8 * $n)}} 474proc ::sha1::bytes {v} { 475 #format %c%c%c%c [byte 0 $v] [byte 1 $v] [byte 2 $v] [byte 3 $v] 476 format %c%c%c%c \ 477 [expr {((0xFF000000 & $v) >> 24) & 0xFF}] \ 478 [expr {(0xFF0000 & $v) >> 16}] \ 479 [expr {(0xFF00 & $v) >> 8}] \ 480 [expr {0xFF & $v}] 481} 482 483# ------------------------------------------------------------------------- 484 485proc ::sha1::Hex {data} { 486 binary scan $data H* result 487 return $result 488} 489 490# ------------------------------------------------------------------------- 491 492# LoadAccelerator -- 493# 494# This package can make use of a number of compiled extensions to 495# accelerate the digest computation. This procedure manages the 496# use of these extensions within the package. During normal usage 497# this should not be called, but the test package manipulates the 498# list of enabled accelerators. 499# 500proc ::sha1::LoadAccelerator {name} { 501 variable accel 502 set r 0 503 switch -exact -- $name { 504 critcl { 505 if {![catch {package require tcllibc}] 506 || ![catch {package require sha1c}]} { 507 set r [expr {[info commands ::sha1::sha1c] != {}}] 508 } 509 } 510 cryptkit { 511 if {![catch {package require cryptkit}]} { 512 set r [expr {![catch {cryptkit::cryptInit}]}] 513 } 514 } 515 trf { 516 if {![catch {package require Trf}]} { 517 set r [expr {![catch {::sha1 aa} msg]}] 518 } 519 } 520 default { 521 return -code error "invalid accelerator package:\ 522 must be one of [join [array names accel] {, }]" 523 } 524 } 525 set accel($name) $r 526} 527 528# ------------------------------------------------------------------------- 529 530# Description: 531# Pop the nth element off a list. Used in options processing. 532# 533proc ::sha1::Pop {varname {nth 0}} { 534 upvar $varname args 535 set r [lindex $args $nth] 536 set args [lreplace $args $nth $nth] 537 return $r 538} 539 540# ------------------------------------------------------------------------- 541 542# fileevent handler for chunked file hashing. 543# 544proc ::sha1::Chunk {token channel {chunksize 4096}} { 545 upvar #0 $token state 546 547 if {[eof $channel]} { 548 fileevent $channel readable {} 549 set state(reading) 0 550 } 551 552 SHA1Update $token [read $channel $chunksize] 553} 554 555# ------------------------------------------------------------------------- 556 557proc ::sha1::sha1 {args} { 558 array set opts {-hex 0 -filename {} -channel {} -chunksize 4096} 559 if {[llength $args] == 1} { 560 set opts(-hex) 1 561 } else { 562 while {[string match -* [set option [lindex $args 0]]]} { 563 switch -glob -- $option { 564 -hex { set opts(-hex) 1 } 565 -bin { set opts(-hex) 0 } 566 -file* { set opts(-filename) [Pop args 1] } 567 -channel { set opts(-channel) [Pop args 1] } 568 -chunksize { set opts(-chunksize) [Pop args 1] } 569 default { 570 if {[llength $args] == 1} { break } 571 if {[string compare $option "--"] == 0} { Pop args; break } 572 set err [join [lsort [concat -bin [array names opts]]] ", "] 573 return -code error "bad option $option:\ 574 must be one of $err" 575 } 576 } 577 Pop args 578 } 579 } 580 581 if {$opts(-filename) != {}} { 582 set opts(-channel) [open $opts(-filename) r] 583 fconfigure $opts(-channel) -translation binary 584 } 585 586 if {$opts(-channel) == {}} { 587 588 if {[llength $args] != 1} { 589 return -code error "wrong # args:\ 590 should be \"sha1 ?-hex? -filename file | string\"" 591 } 592 set tok [SHA1Init] 593 SHA1Update $tok [lindex $args 0] 594 set r [SHA1Final $tok] 595 596 } else { 597 598 set tok [SHA1Init] 599 # FRINK: nocheck 600 set [subst $tok](reading) 1 601 fileevent $opts(-channel) readable \ 602 [list [namespace origin Chunk] \ 603 $tok $opts(-channel) $opts(-chunksize)] 604 # FRINK: nocheck 605 vwait [subst $tok](reading) 606 set r [SHA1Final $tok] 607 608 # If we opened the channel - we should close it too. 609 if {$opts(-filename) != {}} { 610 close $opts(-channel) 611 } 612 } 613 614 if {$opts(-hex)} { 615 set r [Hex $r] 616 } 617 return $r 618} 619 620# ------------------------------------------------------------------------- 621 622proc ::sha1::hmac {args} { 623 array set opts {-hex 1 -filename {} -channel {} -chunksize 4096} 624 if {[llength $args] != 2} { 625 while {[string match -* [set option [lindex $args 0]]]} { 626 switch -glob -- $option { 627 -key { set opts(-key) [Pop args 1] } 628 -hex { set opts(-hex) 1 } 629 -bin { set opts(-hex) 0 } 630 -file* { set opts(-filename) [Pop args 1] } 631 -channel { set opts(-channel) [Pop args 1] } 632 -chunksize { set opts(-chunksize) [Pop args 1] } 633 default { 634 if {[llength $args] == 1} { break } 635 if {[string compare $option "--"] == 0} { Pop args; break } 636 set err [join [lsort [array names opts]] ", "] 637 return -code error "bad option $option:\ 638 must be one of $err" 639 } 640 } 641 Pop args 642 } 643 } 644 645 if {[llength $args] == 2} { 646 set opts(-key) [Pop args] 647 } 648 649 if {![info exists opts(-key)]} { 650 return -code error "wrong # args:\ 651 should be \"hmac ?-hex? -key key -filename file | string\"" 652 } 653 654 if {$opts(-filename) != {}} { 655 set opts(-channel) [open $opts(-filename) r] 656 fconfigure $opts(-channel) -translation binary 657 } 658 659 if {$opts(-channel) == {}} { 660 661 if {[llength $args] != 1} { 662 return -code error "wrong # args:\ 663 should be \"hmac ?-hex? -key key -filename file | string\"" 664 } 665 set tok [HMACInit $opts(-key)] 666 HMACUpdate $tok [lindex $args 0] 667 set r [HMACFinal $tok] 668 669 } else { 670 671 set tok [HMACInit $opts(-key)] 672 # FRINK: nocheck 673 set [subst $tok](reading) 1 674 fileevent $opts(-channel) readable \ 675 [list [namespace origin Chunk] \ 676 $tok $opts(-channel) $opts(-chunksize)] 677 # FRINK: nocheck 678 vwait [subst $tok](reading) 679 set r [HMACFinal $tok] 680 681 # If we opened the channel - we should close it too. 682 if {$opts(-filename) != {}} { 683 close $opts(-channel) 684 } 685 } 686 687 if {$opts(-hex)} { 688 set r [Hex $r] 689 } 690 return $r 691} 692 693# ------------------------------------------------------------------------- 694 695# Try and load a compiled extension to help. 696namespace eval ::sha1 { 697 variable e {} 698 foreach e {critcl cryptkit trf} { if {[LoadAccelerator $e]} { break } } 699 unset e 700} 701 702package provide sha1 1.1.1 703 704# ------------------------------------------------------------------------- 705# Local Variables: 706# mode: tcl 707# indent-tabs-mode: nil 708# End: 709 710 711