Diff

Differences From Artifact [a8b3b2afbe]:

To Artifact [235aac1913]:


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