sha256.tcl

Go to the documentation of this file.

/*  sha256.tcl - Copyright (C) 2005 Pat Thoyts <patthoyts@users.sourceforge.net>*/
/* */
/*  SHA1 defined by FIPS 180-2, "The Secure Hash Standard"*/
/*  HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication"*/
/* */
/*  This is an implementation of the secure hash algorithms specified in the*/
/*  FIPS 180-2 document.*/
/* */
/*  This implementation permits incremental updating of the hash and */
/*  provides support for external compiled implementations using critcl.*/
/* */
/*  This implementation permits incremental updating of the hash and */
/*  provides support for external compiled implementations either using*/
/*  critcl (sha256c).*/
/* */
/*  Ref: http://csrc.nist.gov/publications/fips/fips180-2/fips180-2.pdf*/
/*       http://csrc.nist.gov/publications/fips/fips180-2/fips180-2withchangenotice.pdf*/
/* */
/*  -------------------------------------------------------------------------*/
/*  See the file "license.terms" for information on usage and redistribution*/
/*  of this file, and for a DISCLAIMER OF ALL WARRANTIES.*/
/*  -------------------------------------------------------------------------*/
/* */

/*  @mdgen EXCLUDE: sha256c.tcl*/

package require Tcl 8.2;                /*  tcl minimum version*/

namespace ::sha2 {
    variable version 1.0.2
    variable rcsid {$Id: sha256.tcl,v 1.6 2007/05/03 21:41:10 andreas_kupries Exp $}

    variable  accel
    array  accel =  {tcl 0 critcl 0}
    variable  

    namespace export sha256 hmac \
            SHA256Init SHA256Update SHA256Final

    variable uid
    if {![info exists uid]} {
         uid =  0
    }

    variable K
    if {![info exists K]} {
        /*  FIPS 180-2: 4.2.2 SHA-256 constants*/
         K =  [list \
                   0x428a2f98 0x71374491 0xb5c0fbcf 0xe9b5dba5 \
                   0x3956c25b 0x59f111f1 0x923f82a4 0xab1c5ed5 \
                   0xd807aa98 0x12835b01 0x243185be 0x550c7dc3 \
                   0x72be5d74 0x80deb1fe 0x9bdc06a7 0xc19bf174 \
                   0xe49b69c1 0xefbe4786 0x0fc19dc6 0x240ca1cc \
                   0x2de92c6f 0x4a7484aa 0x5cb0a9dc 0x76f988da \
                   0x983e5152 0xa831c66d 0xb00327c8 0xbf597fc7 \
                   0xc6e00bf3 0xd5a79147 0x06ca6351 0x14292967 \
                   0x27b70a85 0x2e1b2138 0x4d2c6dfc 0x53380d13 \
                   0x650a7354 0x766a0abb 0x81c2c92e 0x92722c85 \
                   0xa2bfe8a1 0xa81a664b 0xc24b8b70 0xc76c51a3 \
                   0xd192e819 0xd6990624 0xf40e3585 0x106aa070 \
                   0x19a4c116 0x1e376c08 0x2748774c 0x34b0bcb5 \
                   0x391c0cb3 0x4ed8aa4a 0x5b9cca4f 0x682e6ff3 \
                   0x748f82ee 0x78a5636f 0x84c87814 0x8cc70208 \
                   0x90befffa 0xa4506ceb 0xbef9a3f7 0xc67178f2 \
                  ]
    }
    
}

/*  -------------------------------------------------------------------------*/
/*  Management of sha256 implementations.*/

/*  LoadAccelerator --*/
/* */
/*  This package can make use of a number of compiled extensions to*/
/*  accelerate the digest computation. This procedure manages the*/
/*  use of these extensions within the package. During normal usage*/
/*  this should not be called, but the test package manipulates the*/
/*  list of enabled accelerators.*/
/* */
ret  ::sha2::LoadAccelerator (type name) {
    variable accel
    set r 0
    switch -exact -- $name {
        tcl {
            # Already present (this file)
            set r 1
        }
        critcl {
            if {![catch {package require tcllibc}]
                || ![catch {package require sha256c}]} {
                set r [expr {[info command ::sha2::sha256c_update] != {}}]
            }
        }
        default {
            return -code error "invalid accelerator $key:\
                must be one of [join [KnownImplementations] {, }]"
        }
    }
    set accel($name) $r
    return $r
}

/*  ::sha2::Implementations --*/
/* */
/*  Determines which implementations are*/
/*  present, i.e. loaded.*/
/* */
/*  Arguments:*/
/*  None.*/
/* */
/*  Results:*/
/*  A list of implementation keys.*/

ret  ::sha2::Implementations () {
    variable accel
    set res {}
    foreach n [array names accel] {
    if {!$accel($n)} continue
    lappend res $n
    }
    return $res
}

/*  ::sha2::KnownImplementations --*/
/* */
/*  Determines which implementations are known*/
/*  as possible implementations.*/
/* */
/*  Arguments:*/
/*  None.*/
/* */
/*  Results:*/
/*  A list of implementation keys. In the order*/
/*  of preference, most prefered first.*/

ret  ::sha2::KnownImplementations () {
    return {critcl tcl}
}

ret  ::sha2::Names () {
    return {
    critcl   {tcllibc based}
    tcl      {pure Tcl}
    }
}

/*  ::sha2::SwitchTo --*/
/* */
/*  Activates a loaded named implementation.*/
/* */
/*  Arguments:*/
/*  key Name of the implementation to activate.*/
/* */
/*  Results:*/
/*  None.*/

ret  ::sha2::SwitchTo (type key) {
    variable accel
    variable loaded

    if {[string equal $key $loaded]} {
    # No change, nothing to do.
    return
    } elseif {![string equal $key ""]} {
    # Validate the target implementation of the switch.

    if {![info exists accel($key)]} {
        return -code error "Unable to activate unknown implementation \"$key\""
    } elseif {![info exists accel($key)] || !$accel($key)} {
        return -code error "Unable to activate missing implementation \"$key\""
    }
    }

    # Deactivate the previous implementation, if there was any.

    if {![string equal $loaded ""]} {
        foreach c {
            SHA256Init   SHA224Init
            SHA256Final  SHA224Final
            SHA256Update
        } {
            rename ::sha2::$c ::sha2::${c}-${loaded}
        }
    }

    # Activate the new implementation, if there is any.

    if {![string equal $key ""]} {
        foreach c {
            SHA256Init   SHA224Init
            SHA256Final  SHA224Final
            SHA256Update
        } {
            rename ::sha2::${c}-${key} ::sha2::$c
        }
    }

    # Remember the active implementation, for deactivation by future
    # switches.

    set loaded $key
    return
}

/*  -------------------------------------------------------------------------*/

/*  SHA256Init --*/
/* */
/*    Create and initialize an SHA256 state variable. This will be*/
/*    cleaned up when we call SHA256Final*/
/* */

ret  ::sha2::SHA256Init-tcl () {
    variable uid
    set token [namespace current]::[incr uid]
    upvar #0 $token tok

    # FIPS 180-2: 5.3.2 Setting the initial hash value
    array set tok \
            [list \
            A [expr {int(0x6a09e667)}] \
            B [expr {int(0xbb67ae85)}] \
            C [expr {int(0x3c6ef372)}] \
            D [expr {int(0xa54ff53a)}] \
            E [expr {int(0x510e527f)}] \
            F [expr {int(0x9b05688c)}] \
            G [expr {int(0x1f83d9ab)}] \
            H [expr {int(0x5be0cd19)}] \
            n 0 i "" v 256]
    return $token
}

ret  ::sha2::SHA256Init-critcl () {
    variable uid
    set token [namespace current]::[incr uid]
    upvar #0 $token tok

    # FIPS 180-2: 5.3.2 Setting the initial hash value
    set tok(sha256c) [sha256c_init256]
    return $token
}

/*  SHA256Update --*/
/* */
/*    This is called to add more data into the hash. You may call this*/
/*    as many times as you require. Note that passing in "ABC" is equivalent*/
/*    to passing these letters in as separate calls -- hence this proc */
/*    permits hashing of chunked data*/
/* */
/*    If we have a C-based implementation available, then we will use*/
/*    it here in preference to the pure-Tcl implementation.*/
/* */

ret  ::sha2::SHA256Update-tcl (type token , type data) {
    upvar #0 $token state

    # Update the state values
    incr   state(n) [string length $data]
    append state(i) $data

    # Calculate the hash for any complete blocks
    set len [string length $state(i)]
    for {set n 0} {($n + 64) <= $len} {} {
        SHA256Transform $token [string range $state(i) $n [incr n 64]]
    }

    # Adjust the state for the blocks completed.
    set state(i) [string range $state(i) $n end]
    return
}

ret  ::sha2::SHA256Update-critcl (type token , type data) {
    upvar #0 $token state

    set state(sha256c) [sha256c_update $data $state(sha256c)]
    return
}

/*  SHA256Final --*/
/* */
/*     This procedure is used to close the current hash and returns the*/
/*     hash data. Once this procedure has been called the hash context*/
/*     is freed and cannot be used again.*/
/* */
/*     Note that the output is 256 bits represented as binary data.*/
/* */

ret  ::sha2::SHA256Final-tcl (type token) {
    upvar #0 $token state
    SHA256Penultimate $token
    
    # Output
    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)]
    unset state
    return $r
}

ret  ::sha2::SHA256Final-critcl (type token) {
    upvar #0 $token state
    set r $state(sha256c)
    unset  state
    return $r
}

/*  SHA256Penultimate --*/
/* */
/* */
ret  ::sha2::SHA256Penultimate (type token) {
    upvar #0 $token state

    # FIPS 180-2: 5.1.1: Padding the message
    #
    set len [string length $state(i)]
    set pad [expr {56 - ($len % 64)}]
    if {$len % 64 > 56} {
        incr pad 64
    }
    if {$pad == 0} {
        incr pad 64
    }
    append state(i) [binary format a$pad \x80]

    # Append length in bits as big-endian wide int.
    set dlen [expr {8 * $state(n)}]
    append state(i) [binary format II 0 $dlen]

    # Calculate the hash for the remaining block.
    set len [string length $state(i)]
    for {set n 0} {($n + 64) <= $len} {} {
        SHA256Transform $token [string range $state(i) $n [incr n 64]]
    }
}

/*  -------------------------------------------------------------------------*/

ret  ::sha2::SHA224Init-tcl () {
    variable uid
    set token [namespace current]::[incr uid]
    upvar #0 $token tok

    # FIPS 180-2 (change notice 1) (1): SHA-224 initialization values
    array set tok \
            [list \
            A [expr {int(0xc1059ed8)}] \
            B [expr {int(0x367cd507)}] \
            C [expr {int(0x3070dd17)}] \
            D [expr {int(0xf70e5939)}] \
            E [expr {int(0xffc00b31)}] \
            F [expr {int(0x68581511)}] \
            G [expr {int(0x64f98fa7)}] \
            H [expr {int(0xbefa4fa4)}] \
            n 0 i "" v 224]
    return $token
}

ret  ::sha2::SHA224Init-critcl () {
    variable uid
    set token [namespace current]::[incr uid]
    upvar #0 $token tok

    # FIPS 180-2 (change notice 1) (1): SHA-224 initialization values
    set tok(sha256c) [sha256c_init224]
    return $token
}

interp alias {} ::sha2::SHA224Update {} ::sha2::SHA256Update

ret  ::sha2::SHA224Final-tcl (type token) {
    upvar #0 $token state
    SHA256Penultimate $token
    
    # Output
    set r [bytes $state(A)][bytes $state(B)][bytes $state(C)][bytes $state(D)][bytes $state(E)][bytes $state(F)][bytes $state(G)]
    unset state
    return $r
}

ret  ::sha2::SHA224Final-critcl (type token) {
    upvar #0 $token state
    # Trim result down to 224 bits (by 4 bytes).
    # See output below, A..G, not A..H
    set r [string range $state(sha256c) 0 end-4]
    unset state
    return $r
}

/*  -------------------------------------------------------------------------*/
/*  HMAC Hashed Message Authentication (RFC 2104)*/
/* */
/*  hmac = H(K xor opad, H(K xor ipad, text))*/
/* */

/*  HMACInit --*/
/* */
/*     This is equivalent to the SHA1Init procedure except that a key is*/
/*     added into the algorithm*/
/* */
ret  ::sha2::HMACInit (type K) {

    # Key K is adjusted to be 64 bytes long. If K is larger, then use
    # the SHA1 digest of K and pad this instead.
    set len [string length $K]
    if {$len > 64} {
        set tok [SHA256Init]
        SHA256Update $tok $K
        set K [SHA256Final $tok]
        set len [string length $K]
    }
    set pad [expr {64 - $len}]
    append K [string repeat \0 $pad]

    # Cacluate the padding buffers.
    set Ki {}
    set Ko {}
    binary scan $K i16 Ks
    foreach k $Ks {
        append Ki [binary format i [expr {$k ^ 0x36363636}]]
        append Ko [binary format i [expr {$k ^ 0x5c5c5c5c}]]
    }

    set tok [SHA256Init]
    SHA256Update $tok $Ki;                 # initialize with the inner pad
    
    # preserve the Ko value for the final stage.
    # FRINK: nocheck
    set [subst $tok](Ko) $Ko

    return $tok
}

/*  HMACUpdate --*/
/* */
/*     Identical to calling SHA256Update*/
/* */
ret  ::sha2::HMACUpdate (type token , type data) {
    SHA256Update $token $data
    return
}

/*  HMACFinal --*/
/* */
/*     This is equivalent to the SHA256Final procedure. The hash context is*/
/*     closed and the binary representation of the hash result is returned.*/
/* */
ret  ::sha2::HMACFinal (type token) {
    upvar #0 $token state

    set tok [SHA256Init];                 # init the outer hashing function
    SHA256Update $tok $state(Ko);         # prepare with the outer pad.
    SHA256Update $tok [SHA256Final $token]; # hash the inner result
    return [SHA256Final $tok]
}

/*  -------------------------------------------------------------------------*/
/*  Description:*/
/*   This is the core SHA1 algorithm. It is a lot like the MD4 algorithm but*/
/*   includes an extra round and a set of constant modifiers throughout.*/
/* */
 ::sha2 = ::SHA256Transform_body {
    variable K
    upvar /* 0 $token state*/

    /*  FIPS 180-2: 6.2.2 SHA-256 Hash computation.*/
    binary scan $msg I* blocks
     blockLen =  [llength $blocks]
    for { i =  0} {$i < $blockLen} {incr i 16} {
         W =  [lrange $blocks $i [expr {$i+15}]]

        /*  FIPS 180-2: 6.2.2 (1) Prepare the message schedule*/
        /*  For t = 16 to 64 */
        /*    let Wt = (sigma1(Wt-2) + Wt-7 + sigma0(Wt-15) + Wt-16)*/
         t2 =   13
         t7 =    8
         t15 =   0
         t16 =  -1
        for { t =  16} {$t < 64} {incr t} {
            lappend W [expr {[sigma1 [lindex $W [incr t2]]] \
                                 + [lindex $W [incr t7]] \
                                 + [sigma0 [lindex $W [incr t15]]] \
                                 + [lindex $W [incr t16]]}]
        }
        
        /*  FIPS 180-2: 6.2.2 (2) Initialise the working variables*/
         A =  $state(A)
         B =  $state(B)
         C =  $state(C)
         D =  $state(D)
         E =  $state(E)
         F =  $state(F)
         G =  $state(G)
         H =  $state(H)

        /*  FIPS 180-2: 6.2.2 (3) Do permutation rounds*/
        /*  For t = 0 to 63 do*/
        /*    T1 = h + SIGMA1(e) + Ch(e,f,g) + Kt + Wt*/
        /*    T2 = SIGMA0(a) + Maj(a,b,c)*/
        /*    h = g; g = f;  f = e;  e = d + T1;  d = c;  c = b; b = a;*/
        /*    a = T1 + T2*/
        /* */
        for { t =  0} {$t < 64} {incr t} {
             T1 =  [expr {($H + [SIGMA1 $E] + [Ch $E $F $G] 
                          + [lindex $K $t] + [lindex $W $t]) & 0xffffffff}]
             T2 =  [expr {([SIGMA0 $A] + [Maj $A $B $C]) & 0xffffffff}]
             H =  $G
             G =  $F
             F =  $E
             E =  [expr {($D + $T1) & 0xffffffff}]
             D =  $C
             C =  $B
             B =  $A
             A =  [expr {($T1 + $T2) & 0xffffffff}]
        }

        /*  FIPS 180-2: 6.2.2 (4) Compute the intermediate hash*/
        incr state(A) $A
        incr state(B) $B
        incr state(C) $C
        incr state(D) $D
        incr state(E) $E
        incr state(F) $F
        incr state(G) $G
        incr state(H) $H
    }

    return
}

/*  -------------------------------------------------------------------------*/

/*  FIPS 180-2: 4.1.2 equation 4.2*/
ret  ::sha2::Ch (type x , type y , type z) {
    return [expr {($x & $y) ^ (~$x & $z)}]
}

/*  FIPS 180-2: 4.1.2 equation 4.3*/
ret  ::sha2::Maj (type x , type y , type z) {
    return [expr {($x & $y) ^ ($x & $z) ^ ($y & $z)}]
}

/*  FIPS 180-2: 4.1.2 equation 4.4*/
/*   (x >>> 2) ^ (x >>> 13) ^ (x >>> 22)*/
ret  ::sha2::SIGMA0 (type x) {
    return [expr {[>>> $x 2] ^ [>>> $x 13] ^ [>>> $x 22]}]
}

/*  FIPS 180-2: 4.1.2 equation 4.5*/
/*   (x >>> 6) ^ (x >>> 11) ^ (x >>> 25)*/
ret  ::sha2::SIGMA1 (type x) {
    return [expr {[>>> $x 6] ^ [>>> $x 11] ^ [>>> $x 25]}]
}

/*  FIPS 180-2: 4.1.2 equation 4.6*/
/*   s0 = (x >>> 7)  ^ (x >>> 18) ^ (x >> 3)*/
ret  ::sha2::sigma0 (type x) {
    #return [expr {[>>> $x 7] ^ [>>> $x 18] ^ (($x >> 3) & 0x1fffffff)}]
    return [expr {((($x<<25) | (($x>>7) & (0x7FFFFFFF>>6))) \
                 ^ (($x<<14) | (($x>>18) & (0x7FFFFFFF>>17))) & 0xFFFFFFFF) \
                 ^ (($x>>3) & 0x1fffffff)}]
}

/*  FIPS 180-2: 4.1.2 equation 4.7*/
/*   s1 = (x >>> 17) ^ (x >>> 19) ^ (x >> 10)*/
ret  ::sha2::sigma1 (type x) {
    #return [expr {[>>> $x 17] ^ [>>> $x 19] ^ (($x >> 10) & 0x003fffff)}]
    return [expr {((($x<<15) | (($x>>17) & (0x7FFFFFFF>>16))) \
                 ^ (($x<<13) | (($x>>19) & (0x7FFFFFFF>>18))) & 0xFFFFFFFF) \
                 ^ (($x >> 10) & 0x003fffff)}]
}

/*  32bit rotate-right*/
ret  ::sha2::>>> (type v , type n) {
    return [expr {(($v << (32 - $n)) \
                       | (($v >> $n) & (0x7FFFFFFF >> ($n - 1)))) \
                      & 0xFFFFFFFF}]
}

/*  32bit rotate-left*/
ret  ::sha2::<<< (type v , type n) {
    return [expr {((($v << $n) \
                        | (($v >> (32 - $n)) \
                               & (0x7FFFFFFF >> (31 - $n))))) \
                      & 0xFFFFFFFF}]
}

/*  -------------------------------------------------------------------------*/
/*  We speed up the SHA256Transform code while maintaining readability in the*/
/*  source code by substituting inline for a number of functions.*/
/*  The idea is to reduce the number of [expr] calls.*/

/*  Inline the Ch function*/
regsub -all -line \
    {\[Ch (\$[ABCDEFGH]) (\$[ABCDEFGH]) (\$[ABCDEFGH])\]} \
    $::sha2::SHA256Transform_body \
    {((\1 \& \2) ^ ((~\1) \& \3))} \
    ::sha2::SHA256Transform_body

/*  Inline the Maj function*/
regsub -all -line \
    {\[Maj (\$[ABCDEFGH]) (\$[ABCDEFGH]) (\$[ABCDEFGH])\]} \
    $::sha2::SHA256Transform_body \
    {((\1 \& \2) ^ (\1 \& \3) ^ (\2 \& \3))} \
    ::sha2::SHA256Transform_body


/*  Inline the SIGMA0 function*/
regsub -all -line \
    {\[SIGMA0 (\$[ABCDEFGH])\]} \
    $::sha2::SHA256Transform_body \
    {((((\1<<30) | ((\1>>2) \& (0x7FFFFFFF>>1))) \& 0xFFFFFFFF) \
          ^ (((\1<<19) | ((\1>>13) \& (0x7FFFFFFF>>12))) \& 0xFFFFFFFF) \
          ^ (((\1<<10) | ((\1>>22) \& (0x7FFFFFFF>>21))) \& 0xFFFFFFFF) \
          )} \
    ::sha2::SHA256Transform_body

/*  Inline the SIGMA1 function*/
regsub -all -line \
    {\[SIGMA1 (\$[ABCDEFGH])\]} \
    $::sha2::SHA256Transform_body \
    {((((\1<<26) | ((\1>>6) \& (0x7FFFFFFF>>5))) \& 0xFFFFFFFF) \
          ^ (((\1<<21) | ((\1>>11) \& (0x7FFFFFFF>>10))) \& 0xFFFFFFFF) \
          ^ (((\1<<7) | ((\1>>25) \& (0x7FFFFFFF>>24))) \& 0xFFFFFFFF) \
          )} \
    ::sha2::SHA256Transform_body

ret  ::sha2::SHA256Transform (type token , type msg) $::sha2::SHA256Transform_body

# -------------------------------------------------------------------------

# Convert a integer value into a binary string in big-endian order.
proc ::sha2::byte {n v} {expr {((0xFF << (8 * $n)) & $v) >> (8 * $n)}}
ret  ::sha2::bytes (type v) { 
    #format %c%c%c%c [byte 3 $v] [byte 2 $v] [byte 1 $v] [byte 0 $v]
    format %c%c%c%c \
        [expr {((0xFF000000 & $v) >> 24) & 0xFF}] \
        [expr {(0xFF0000 & $v) >> 16}] \
        [expr {(0xFF00 & $v) >> 8}] \
        [expr {0xFF & $v}]
}

/*  -------------------------------------------------------------------------*/

ret  ::sha2::Hex (type data) {
    binary scan $data H* result
    return $result
}

/*  -------------------------------------------------------------------------*/

/*  Description:*/
/*   Pop the nth element off a list. Used in options processing.*/
/* */
ret  ::sha2::Pop (type varname , optional nth =0) {
    upvar $varname args
    set r [lindex $args $nth]
    set args [lreplace $args $nth $nth]
    return $r
}

/*  -------------------------------------------------------------------------*/

/*  fileevent handler for chunked file hashing.*/
/* */
ret  ::sha2::Chunk (type token , type channel , optional chunksize =4096) {
    upvar #0 $token state
    
    if {[eof $channel]} {
        fileevent $channel readable {}
        set state(reading) 0
    }
        
    SHA256Update $token [read $channel $chunksize]
}

/*  -------------------------------------------------------------------------*/

ret  ::sha2::_sha256 (type ver , type args) {
    array set opts {-hex 0 -filename {} -channel {} -chunksize 4096}
    if {[llength $args] == 1} {
        set opts(-hex) 1
    } else {
        while {[string match -* [set option [lindex $args 0]]]} {
            switch -glob -- $option {
                -hex       { set opts(-hex) 1 }
                -bin       { set opts(-hex) 0 }
                -file*     { set opts(-filename) [Pop args 1] }
                -channel   { set opts(-channel) [Pop args 1] }
                -chunksize { set opts(-chunksize) [Pop args 1] }
                default {
                    if {[llength $args] == 1} { break }
                    if {[string compare $option "--"] == 0} { Pop args; break }
                    set err [join [lsort [concat -bin [array names opts]]] ", "]
                    return -code error "bad option $option:\
                    must be one of $err"
                }
            }
            Pop args
        }
    }

    if {$opts(-filename) != {}} {
        set opts(-channel) [open $opts(-filename) r]
        fconfigure $opts(-channel) -translation binary
    }

    if {$opts(-channel) == {}} {

        if {[llength $args] != 1} {
            return -code error "wrong # args: should be\
                \"[namespace current]::sha$ver ?-hex|-bin? -filename file\
                | -channel channel | string\""
        }
        set tok [SHA${ver}Init]
        SHA${ver}Update $tok [lindex $args 0]
        set r [SHA${ver}Final $tok]

    } else {

        set tok [SHA${ver}Init]
        # FRINK: nocheck
        set [subst $tok](reading) 1
        fileevent $opts(-channel) readable \
            [list [namespace origin Chunk] \
                 $tok $opts(-channel) $opts(-chunksize)]
        # FRINK: nocheck
        vwait [subst $tok](reading)
        set r [SHA${ver}Final $tok]

        # If we opened the channel - we should close it too.
        if {$opts(-filename) != {}} {
            close $opts(-channel)
        }
    }
    
    if {$opts(-hex)} {
        set r [Hex $r]
    }
    return $r
}

interp alias {} ::sha2::sha256 {} ::sha2::_sha256 256
interp alias {} ::sha2::sha224 {} ::sha2::_sha256 224

/*  -------------------------------------------------------------------------*/

ret  ::sha2::hmac (type args) {
    array set opts {-hex 1 -filename {} -channel {} -chunksize 4096}
    if {[llength $args] != 2} {
        while {[string match -* [set option [lindex $args 0]]]} {
            switch -glob -- $option {
                -key       { set opts(-key) [Pop args 1] }
                -hex       { set opts(-hex) 1 }
                -bin       { set opts(-hex) 0 }
                -file*     { set opts(-filename) [Pop args 1] }
                -channel   { set opts(-channel) [Pop args 1] }
                -chunksize { set opts(-chunksize) [Pop args 1] }
                default {
                    if {[llength $args] == 1} { break }
                    if {[string compare $option "--"] == 0} { Pop args; break }
                    set err [join [lsort [array names opts]] ", "]
                    return -code error "bad option $option:\
                    must be one of $err"
                }
            }
            Pop args
        }
    }

    if {[llength $args] == 2} {
        set opts(-key) [Pop args]
    }

    if {![info exists opts(-key)]} {
        return -code error "wrong # args:\
            should be \"hmac ?-hex? -key key -filename file | string\""
    }

    if {$opts(-filename) != {}} {
        set opts(-channel) [open $opts(-filename) r]
        fconfigure $opts(-channel) -translation binary
    }

    if {$opts(-channel) == {}} {

        if {[llength $args] != 1} {
            return -code error "wrong # args:\
                should be \"hmac ?-hex? -key key -filename file | string\""
        }
        set tok [HMACInit $opts(-key)]
        HMACUpdate $tok [lindex $args 0]
        set r [HMACFinal $tok]

    } else {

        set tok [HMACInit $opts(-key)]
        # FRINK: nocheck
        set [subst $tok](reading) 1
        fileevent $opts(-channel) readable \
            [list [namespace origin Chunk] \
                 $tok $opts(-channel) $opts(-chunksize)]
        # FRINK: nocheck
        vwait [subst $tok](reading)
        set r [HMACFinal $tok]

        # If we opened the channel - we should close it too.
        if {$opts(-filename) != {}} {
            close $opts(-channel)
        }
    }
    
    if {$opts(-hex)} {
        set r [Hex $r]
    }
    return $r
}

/*  -------------------------------------------------------------------------*/

/*  Try and load a compiled extension to help.*/
namespace ::sha2 {
    variable e {}
    foreach e [KnownImplementations] {
    if {[LoadAccelerator $e]} {
        SwitchTo $e
        break
    }
    }
    un e = 
}

package provide sha256 $::sha2::version

/*  -------------------------------------------------------------------------*/
/*  Local Variables:*/
/*    mode: tcl*/
/*    indent-tabs-mode: nil*/
/*  End:*/