Attachment "1.diff" to
ticket [429695ffff]
added by
andreas_kupries
2001-06-22 21:31:34.
? frinked
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/ChangeLog,v
retrieving revision 1.53
diff -u -r1.53 ChangeLog
--- ChangeLog 2001/05/01 19:01:23 1.53
+++ ChangeLog 2001/06/22 14:28:45
@@ -1,3 +1,8 @@
+2001-06-21 Andreas Kupries <[email protected]>
+
+ * Makefile.in (MODULES): Added module 'sha1'. This is another
+ message digest like 'md5'.
+
2001-05-01 Andreas Kupries <[email protected]>
* Makefile.in (MODULES): Added module 'report'.
Index: Makefile.in
===================================================================
RCS file: /cvsroot/tcllib/tcllib/Makefile.in,v
retrieving revision 1.44
diff -u -r1.44 Makefile.in
--- Makefile.in 2001/05/01 19:01:23 1.44
+++ Makefile.in 2001/06/22 14:28:47
@@ -41,6 +41,9 @@
# MD5 hash digest
MD5=md5
+# SHA1 hash digest
+SHA1=sha1
+
# Data structures (stack, queue, tree)
STRUCT=struct
@@ -106,7 +109,8 @@
$(URI) \
$(LOGGER) \
$(HTMLPARSE) \
- $(REPORT)
+ $(REPORT) \
+ $(SHA1)
#========================================================================
# Nothing of the variables below this line need to be changed. Please
Index: modules/base64/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/base64/ChangeLog,v
retrieving revision 1.7
diff -u -r1.7 ChangeLog
--- modules/base64/ChangeLog 2000/10/11 20:04:11 1.7
+++ modules/base64/ChangeLog 2001/06/22 14:28:47
@@ -1,3 +1,14 @@
+2001-06-02 Miguel Sofer <[email protected]>
+
+ * base64.tcl: Greatly increased speed, obtained by: using lists
+ instead of arrays, splitting the input with [binary scan],
+ taking the bytes to be encoded three at a time, and
+ reformulating the decoding algorithm to be purely
+ arithmetic. Improved backwards compatibility, now runs with
+ Tcl8.0.
+
+ Nudged version to 2.2
+
2000-10-11 Brent Welch <[email protected]>
* base64.tcl: Fixed bug in base64::decode where trailing
Index: modules/base64/base64.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/base64/base64.tcl,v
retrieving revision 1.8
diff -u -r1.8 base64.tcl
--- modules/base64/base64.tcl 2000/10/11 20:04:11 1.8
+++ modules/base64/base64.tcl 2001/06/22 14:28:51
@@ -13,162 +13,289 @@
# Version 1.0 implemented Base64_Encode, Bae64_Decode
# Version 2.0 uses the base64 namespace
# Version 2.1 fixes various decode bugs and adds options to encode
+# Version 2.2 is much faster, Tcl8.0 compatible
namespace eval base64 {
- variable i 0
- variable char
- variable base64
- variable base64_en
- foreach char {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z \
- a b c d e f g h i j k l m n o p q r s t u v w x y z \
- 0 1 2 3 4 5 6 7 8 9 + /} {
- set base64($char) $i
- set base64_en($i) $char
- incr i
- }
-
- namespace export *
}
-# base64::encode --
-#
-# Base64 encode a given string.
-#
-# Arguments:
-# args ?-maxlen maxlen? ?-wrapchar wrapchar? string
-#
-# If maxlen is 0, the output is not wrapped.
-#
-# Results:
-# A Base64 encoded version of $string, wrapped at $maxlen characters
-# by $wrapchar.
+if {![catch {package require Trf 2.0}]} {
+ # Trf is available, so implement the functionality provided here
+ # in terms of calls to Trf for speed.
+
+ # base64::encode --
+ #
+ # Base64 encode a given string.
+ #
+ # Arguments:
+ # args ?-maxlen maxlen? ?-wrapchar wrapchar? string
+ #
+ # If maxlen is 0, the output is not wrapped.
+ #
+ # Results:
+ # A Base64 encoded version of $string, wrapped at $maxlen characters
+ # by $wrapchar.
+
+ proc base64::encode {args} {
+ # Set the default wrapchar and maximum line length to match the output
+ # of GNU uuencode 4.2. Various RFC's allow for different wrapping
+ # characters and wraplengths, so these may be overridden by command line
+ # options.
+ set wrapchar "\n"
+ set maxlen 60
+
+ if { [llength $args] == 0 } {
+ error "wrong # args: should be \"[lindex [info level 0] 0]\
+ ?-maxlen maxlen? ?-wrapchar wrapchar? string\""
+ }
-proc base64::encode {args} {
- variable base64_en
+ set optionStrings [list "-maxlen" "-wrapchar"]
+ for {set i 0} {$i < [llength $args] - 1} {incr i} {
+ set arg [lindex $args $i]
+ set index [lsearch -glob $optionStrings "${arg}*"]
+ if { $index == -1 } {
+ error "unknown option \"$arg\": must be -maxlen or -wrapchar"
+ }
+ incr i
+ if { $i >= [llength $args] - 1 } {
+ error "value for \"$arg\" missing"
+ }
+ set val [lindex $args $i]
+ set [string range [lindex $optionStrings $index] 1 end] $val
+ }
- # Set the default wrapchar and maximum line length to match the output
- # of GNU uuencode 4.2. Various RFC's allow for different wrapping
- # characters and wraplengths, so these may be overridden by command line
- # options.
- set wrapchar "\n"
- set maxlen 60
-
- if { [llength $args] == 0 } {
- error "wrong # args: should be \"[lindex [info level 0] 0]\
- ?-maxlen maxlen? ?-wrapchar wrapchar? string\""
- }
+ # [string is] requires Tcl8.2; this works with 8.0 too
+ if {[catch {expr {$maxlen % 2}}]} {
+ error "expected integer but got \"$maxlen\""
+ }
- set optionStrings [list "-maxlen" "-wrapchar"]
- for {set i 0} {$i < [llength $args] - 1} {incr i} {
- set arg [lindex $args $i]
- set index [lsearch -glob $optionStrings "${arg}*"]
- if { $index == -1 } {
- error "unknown option \"$arg\": must be -maxlen or -wrapchar"
- }
- incr i
- if { $i >= [llength $args] - 1 } {
- error "value for \"$arg\" missing"
+ set string [lindex $args end]
+ set result [::base64 -mode encode -- $string]
+ regsub -all \n $result {} result
+
+ if {$maxlen > 0} {
+ set res ""
+ set edge [expr {$maxlen - 1}]
+ while {[string length $result] > $maxlen} {
+ append res [string range $result 0 $edge]$wrapchar
+ set result [string range $result $maxlen end]
+ }
+ if {[string length $result] > 0} {
+ append res $result
+ }
+ set result $res
}
- set val [lindex $args $i]
- set [string range [lindex $optionStrings $index] 1 end] $val
+
+ return $result
}
-
- if { ![string is integer -strict $maxlen] } {
- error "expected integer but got \"$maxlen\""
+
+ # base64::decode --
+ #
+ # Base64 decode a given string.
+ #
+ # Arguments:
+ # string The string to decode. Characters not in the base64
+ # alphabet are ignored (e.g., newlines)
+ #
+ # Results:
+ # The decoded value.
+
+ proc base64::decode {string} {
+ ::base64 -mode decode -- $string
}
- set string [lindex $args end]
+} else {
+ # Without Trf use a pure tcl implementation
- set result {}
- set state 0
- set length 0
- foreach {c} [split $string {}] {
- # Do the line length check before appending so that we don't get an
- # extra newline if the output is a multiple of $maxlen chars long.
- if {$maxlen && $length >= $maxlen} {
- append result $wrapchar
- set length 0
- }
- scan $c %c x
- switch [incr state] {
- 1 { append result $base64_en([expr {($x >>2) & 0x3F}]) }
- 2 { append result \
- $base64_en([expr {(($old << 4) & 0x30) | (($x >> 4) & 0xF)}]) }
- 3 { append result \
- $base64_en([expr {(($old << 2) & 0x3C) | (($x >> 6) & 0x3)}])
- append result $base64_en([expr {($x & 0x3F)}])
- incr length
- set state 0}
+ namespace eval base64 {
+ variable base64 {}
+ variable base64_en {}
+
+ # We create the auxiliary array base64_tmp, it will be unset later.
+
+ set i 0
+ foreach char {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z \
+ a b c d e f g h i j k l m n o p q r s t u v w x y z \
+ 0 1 2 3 4 5 6 7 8 9 + /} {
+ set base64_tmp($char) $i
+ lappend base64_en $char
+ incr i
}
- set old $x
- incr length
- }
- set x 0
- switch $state {
- 0 { # OK }
- 1 { append result $base64_en([expr {(($old << 4) & 0x30)}])== }
- 2 { append result $base64_en([expr {(($old << 2) & 0x3C)}])= }
+
+ #
+ # Create base64 as list: to code for instance C<->3, specify
+ # that [lindex $base64 67] be 3 (C is 67 in ascii); non-coded
+ # ascii chars get a {}. we later use the fact that lindex on a
+ # non-existing index returns {}, and that [expr {} < 0] is true
+ #
+
+ # the last ascii char is 'z'
+ scan z %c len
+ for {set i 0} {$i <= $len} {incr i} {
+ set char [format %c $i]
+ set val {}
+ if {[info exists base64_tmp($char)]} {
+ set val $base64_tmp($char)
+ } else {
+ set val {}
+ }
+ lappend base64 $val
+ }
+
+ # code the character "=" as -1; used to signal end of message
+ scan = %c i
+ set base64 [lreplace $base64 $i $i -1]
+
+ # remove unneeded variables
+ unset base64_tmp i char len val
+
+ namespace export *
}
- return $result
-}
-# base64::decode --
-#
-# Base64 decode a given string.
-#
-# Arguments:
-# string The string to decode. Characters not in the base64
-# alphabet are ignored (e.g., newlines)
-#
-# Results:
-# The decoded value.
-
-proc base64::decode {string} {
- variable base64
-
- set output {}
- set group 0
- set j 18
- foreach char [split $string {}] {
- if {[string compare $char "="]} {
- # RFC 2045 says that line breaks and other characters not part
- # of the Base64 alphabet must be ignored, and that the decoder
- # can optionally emit a warning or reject the message. We opt
- # not to do so, but to just ignore the character.
+ # base64::encode --
+ #
+ # Base64 encode a given string.
+ #
+ # Arguments:
+ # args ?-maxlen maxlen? ?-wrapchar wrapchar? string
+ #
+ # If maxlen is 0, the output is not wrapped.
+ #
+ # Results:
+ # A Base64 encoded version of $string, wrapped at $maxlen characters
+ # by $wrapchar.
+
+ proc base64::encode {args} {
+ set base64_en $::base64::base64_en
+
+ # Set the default wrapchar and maximum line length to match the output
+ # of GNU uuencode 4.2. Various RFC's allow for different wrapping
+ # characters and wraplengths, so these may be overridden by command line
+ # options.
+ set wrapchar "\n"
+ set maxlen 60
+
+ if { [llength $args] == 0 } {
+ error "wrong # args: should be \"[lindex [info level 0] 0]\
+ ?-maxlen maxlen? ?-wrapchar wrapchar? string\""
+ }
- if { ![info exists base64($char)] } {
- continue
+ set optionStrings [list "-maxlen" "-wrapchar"]
+ for {set i 0} {$i < [llength $args] - 1} {incr i} {
+ set arg [lindex $args $i]
+ set index [lsearch -glob $optionStrings "${arg}*"]
+ if { $index == -1 } {
+ error "unknown option \"$arg\": must be -maxlen or -wrapchar"
+ }
+ incr i
+ if { $i >= [llength $args] - 1 } {
+ error "value for \"$arg\" missing"
}
- set bits $base64($char)
- set group [expr {$group | ($bits << $j)}]
- if {[incr j -6] < 0} {
- scan [format %06x $group] %2x%2x%2x a b c
- append output [format %c%c%c $a $b $c]
- set group 0
- set j 18
- }
- } else {
- # = indicates end of data. Output whatever chars are left.
- # The encoding algorithm dictates that we can only have 1 or 2
- # padding characters. If j is 6, we have 12 bits of input
- # (enough for 1 8-bit output). If j is 0, we have 18 bits of
- # input (enough for 2 8-bit outputs).
- # It is crucial to scan three hex digits even though we
- # discard c - older code used %04x and scanned 2 hex digits
- # but really ended up generating 5 or 6 (not 4!) digits and
- # resulted in alignment errors.
-
- scan [format %06x $group] %2x%2x%2x a b c
- if {$j == 6} {
- append output [format %c $a]
- } elseif {$j == 0} {
- append output [format %c%c $a $b]
+ set val [lindex $args $i]
+ set [string range [lindex $optionStrings $index] 1 end] $val
+ }
+
+ # [string is] requires Tcl8.2; this works with 8.0 too
+ if {[catch {expr {$maxlen % 2}}]} {
+ error "expected integer but got \"$maxlen\""
+ }
+
+ set string [lindex $args end]
+
+ set result {}
+ set state 0
+ set length 0
+
+
+ # Process the input bytes 3-by-3
+
+ binary scan $string c* X
+ foreach {x y z} $X {
+ # Do the line length check before appending so that we don't get an
+ # extra newline if the output is a multiple of $maxlen chars long.
+ if {$maxlen && $length >= $maxlen} {
+ append result $wrapchar
+ set length 0
+ }
+
+ append result [lindex $base64_en [expr {($x >>2) & 0x3F}]]
+ if {$y != {}} {
+ append result [lindex $base64_en [expr {(($x << 4) & 0x30) | (($y >> 4) & 0xF)}]]
+ if {$z != {}} {
+ append result \
+ [lindex $base64_en [expr {(($y << 2) & 0x3C) | (($z >> 6) & 0x3)}]]
+ append result [lindex $base64_en [expr {($z & 0x3F)}]]
+ } else {
+ set state 2
+ break
+ }
+ } else {
+ set state 1
+ break
+ }
+ incr length 4
+ }
+ if {$state == 1} {
+ append result [lindex $base64_en [expr {(($x << 4) & 0x30)}]]==
+ } elseif {$state == 2} {
+ append result [lindex $base64_en [expr {(($y << 2) & 0x3C)}]]=
+ }
+ return $result
+ }
+
+ # base64::decode --
+ #
+ # Base64 decode a given string.
+ #
+ # Arguments:
+ # string The string to decode. Characters not in the base64
+ # alphabet are ignored (e.g., newlines)
+ #
+ # Results:
+ # The decoded value.
+
+ proc base64::decode {string} {
+ set base64 $::base64::base64
+
+ binary scan $string c* X
+ foreach x $X {
+ set bits [lindex $base64 $x]
+ if {$bits >= 0} {
+ if {[llength [lappend nums $bits]] == 4} {
+ foreach {v w x y} $nums break
+ set a [expr {($v << 2) | ($w >> 4)}]
+ set b [expr {(($w & 0xF) << 4) | ($x >> 2)}]
+ set c [expr {(($x & 0x3) << 6) | $y}]
+ append output [binary format ccc $a $b $c]
+ set nums {}
+ }
+ } elseif {$bits == -1} {
+ # = indicates end of data. Output whatever chars are left.
+ # The encoding algorithm dictates that we can only have 1 or 2
+ # padding characters. If x=={}, we have 12 bits of input
+ # (enough for 1 8-bit output). If x!={}, we have 18 bits of
+ # input (enough for 2 8-bit outputs).
+
+ foreach {v w x} $nums break
+ set a [expr {($v << 2) | (($w & 0x30) >> 4)}]
+
+ if {$x == {}} {
+ append output [binary format c $a ]
+ } else {
+ set b [expr {(($w & 0xF) << 4) | (($x & 0x3C) >> 2)}]
+ append output [binary format cc $a $b]
+ }
+ break
+ } else {
+ # RFC 2045 says that line breaks and other characters not part
+ # of the Base64 alphabet must be ignored, and that the decoder
+ # can optionally emit a warning or reject the message. We opt
+ # not to do so, but to just ignore the character.
+ continue
}
- break
}
+ return $output
}
- return $output
}
-package provide base64 2.1
+package provide base64 2.2
Index: modules/base64/base64.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/base64/base64.test,v
retrieving revision 1.6
diff -u -r1.6 base64.test
--- modules/base64/base64.test 2000/10/11 17:21:49 1.6
+++ modules/base64/base64.test 2001/06/22 14:28:51
@@ -18,7 +18,16 @@
set auto_path [linsert $auto_path 0 [file dirname [info script]]]
}
-source [file join [file dirname [info script]] base64.tcl]
+#source [file join [file dirname [info script]] base64.tcl]
+
+package require base64
+if {[catch {package present Trf}]} {
+ puts "base64 [package present base64] (pure Tcl)"
+} else {
+ puts "base64 [package present base64] (Trf based)"
+}
+
+
test base64-1.1 {base64::encode} {
base64::encode "this is a test\n"
Index: modules/base64/pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/base64/pkgIndex.tcl,v
retrieving revision 1.2
diff -u -r1.2 pkgIndex.tcl
--- modules/base64/pkgIndex.tcl 2000/10/11 20:37:14 1.2
+++ modules/base64/pkgIndex.tcl 2001/06/22 14:28:51
@@ -8,4 +8,4 @@
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.
-package ifneeded base64 2.1 [list source [file join $dir base64.tcl]]
+package ifneeded base64 2.2 [list source [file join $dir base64.tcl]]
Index: modules/md5/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/md5/ChangeLog,v
retrieving revision 1.3
diff -u -r1.3 ChangeLog
--- modules/md5/ChangeLog 2001/06/19 17:21:57 1.3
+++ modules/md5/ChangeLog 2001/06/22 14:28:51
@@ -2,6 +2,14 @@
* md5.n: Fixed nroff trouble.
+2001-06-02 Miguel Sofer <[email protected]>
+
+ * md5.tcl: modified the pure Tcl code to run almost 5 times
+ faster, by inlining (via regsub) function calls and using local
+ variables instead of arrays.
+
+ Bumped version number to 1.4
+
2001-04-25 Andreas Kupries <[email protected]>
* md5.test: Added tests of "md5::hmac". This allows us to test the
Index: modules/md5/md5.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/md5/md5.tcl,v
retrieving revision 1.2
diff -u -r1.2 md5.tcl
--- modules/md5/md5.tcl 2001/04/25 15:30:03 1.2
+++ modules/md5/md5.tcl 2001/06/22 14:28:54
@@ -18,6 +18,8 @@
# For more info, see: http://expect.nist.gov/md5pure
#
# - Don
+#
+# Modified by Miguel Sofer to use inlines and simple variables
##################################################
namespace eval ::md5 {
@@ -77,37 +79,7 @@
} else {
# Without Trf use the all-tcl implementation by Don Libes.
- namespace eval ::md5 {
- variable i
- variable t
- variable T
-
- set i 0
- foreach t {
- 0xd76aa478 0xe8c7b756 0x242070db 0xc1bdceee
- 0xf57c0faf 0x4787c62a 0xa8304613 0xfd469501
- 0x698098d8 0x8b44f7af 0xffff5bb1 0x895cd7be
- 0x6b901122 0xfd987193 0xa679438e 0x49b40821
-
- 0xf61e2562 0xc040b340 0x265e5a51 0xe9b6c7aa
- 0xd62f105d 0x2441453 0xd8a1e681 0xe7d3fbc8
- 0x21e1cde6 0xc33707d6 0xf4d50d87 0x455a14ed
- 0xa9e3e905 0xfcefa3f8 0x676f02d9 0x8d2a4c8a
-
- 0xfffa3942 0x8771f681 0x6d9d6122 0xfde5380c
- 0xa4beea44 0x4bdecfa9 0xf6bb4b60 0xbebfbc70
- 0x289b7ec6 0xeaa127fa 0xd4ef3085 0x4881d05
- 0xd9d4d039 0xe6db99e5 0x1fa27cf8 0xc4ac5665
-
- 0xf4292244 0x432aff97 0xab9423a7 0xfc93a039
- 0x655b59c3 0x8f0ccc92 0xffeff47d 0x85845dd1
- 0x6fa87e4f 0xfe2ce6e0 0xa3014314 0x4e0811a1
- 0xf7537e82 0xbd3af235 0x2ad7d2bb 0xeb86d391
- } {
- incr i
- set T($i) [expr {$t}]
- }
- }
+ # T will be inlined after the definition of md5body
# test md5
#
@@ -150,15 +122,19 @@
#
proc ::md5::time {} {
foreach len {10 50 100 500 1000 5000 10000} {
- set time [::time {md5 [format %$len.0s ""]} 10]
+ set time [::time {md5 [format %$len.0s ""]} 100]
regexp "\[0-9]*" $time msec
puts "input length $len: [expr {$msec/1000}] milliseconds per interation"
}
}
- proc ::md5::md5 {msg} {
- variable T
-
+ #
+ # We just define the body of md5pure::md5 here; later we
+ # regsub to inline a few function calls for speed
+ #
+
+ set ::md5::md5body {
+
#
# 3.1 Step 1. Append Padding Bits
#
@@ -177,7 +153,7 @@
# append single 1b followed by 0b's
append msg [binary format "a$padLen" \200]
-
+
#
# 3.2 Step 2. Append Length
#
@@ -186,15 +162,15 @@
# code demonstrates little-endian
# This step limits our input to size 2^32b or 2^24B
append msg [binary format "i1i1" [expr {8*$msgLen}] 0]
-
+
#
# 3.3 Step 3. Initialize MD Buffer
#
- set A [expr {0x67452301}]
- set B [expr {0xefcdab89}]
- set C [expr {0x98badcfe}]
- set D [expr {0x10325476}]
+ set A [expr 0x67452301]
+ set B [expr 0xefcdab89]
+ set C [expr 0x98badcfe]
+ set D [expr 0x10325476]
#
# 3.4 Step 4. Process Message in 16-Word Blocks
@@ -204,19 +180,11 @@
# RFC doesn't say whether to use little- or big-endian
# code says little-endian
binary scan $msg i* blocks
- set i 0
- foreach b $blocks {
- set M($i) $b
- incr i
- }
+ set len [llength $blocks]
- set blockLen [array size M]
-
- for {set i 0} {$i < $blockLen/16} {incr i} {
- # copy block i into X
- for {set j 0} {$j<16} {incr j} {
- set X($j) $M([expr {$i*16+$j}])
- }
+ # loop over the message taking 16 blocks at a time
+
+ foreach {X0 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15} $blocks {
# Save A as AA, B as BB, C as CC, and D as DD.
set AA $A
@@ -228,100 +196,100 @@
# Let [abcd k s i] denote the operation
# a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s).
# [ABCD 0 7 1] [DABC 1 12 2] [CDAB 2 17 3] [BCDA 3 22 4]
- set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X(0) + $T(1) }] 7]}]
- set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X(1) + $T(2) }] 12]}]
- set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X(2) + $T(3) }] 17]}]
- set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X(3) + $T(4) }] 22]}]
+ set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X0 + $T01}] 7]}]
+ set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X1 + $T02}] 12]}]
+ set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X2 + $T03}] 17]}]
+ set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X3 + $T04}] 22]}]
# [ABCD 4 7 5] [DABC 5 12 6] [CDAB 6 17 7] [BCDA 7 22 8]
- set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X(4) + $T(5) }] 7]}]
- set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X(5) + $T(6) }] 12]}]
- set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X(6) + $T(7) }] 17]}]
- set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X(7) + $T(8) }] 22]}]
+ set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X4 + $T05}] 7]}]
+ set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X5 + $T06}] 12]}]
+ set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X6 + $T07}] 17]}]
+ set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X7 + $T08}] 22]}]
# [ABCD 8 7 9] [DABC 9 12 10] [CDAB 10 17 11] [BCDA 11 22 12]
- set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X(8) + $T(9) }] 7]}]
- set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X(9) + $T(10)}] 12]}]
- set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X(10) + $T(11)}] 17]}]
- set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X(11) + $T(12)}] 22]}]
+ set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X8 + $T09}] 7]}]
+ set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X9 + $T10}] 12]}]
+ set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X10 + $T11}] 17]}]
+ set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X11 + $T12}] 22]}]
# [ABCD 12 7 13] [DABC 13 12 14] [CDAB 14 17 15] [BCDA 15 22 16]
- set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X(12) + $T(13)}] 7]}]
- set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X(13) + $T(14)}] 12]}]
- set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X(14) + $T(15)}] 17]}]
- set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X(15) + $T(16)}] 22]}]
+ set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X12 + $T13}] 7]}]
+ set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X13 + $T14}] 12]}]
+ set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X14 + $T15}] 17]}]
+ set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X15 + $T16}] 22]}]
# Round 2.
# Let [abcd k s i] denote the operation
# a = b + ((a + G(b,c,d) + X[k] + T[i]) <<< s).
# Do the following 16 operations.
# [ABCD 1 5 17] [DABC 6 9 18] [CDAB 11 14 19] [BCDA 0 20 20]
- set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X(1) + $T(17)}] 5]}]
- set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X(6) + $T(18)}] 9]}]
- set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X(11) + $T(19)}] 14]}]
- set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X(0) + $T(20)}] 20]}]
+ set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X1 + $T17}] 5]}]
+ set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X6 + $T18}] 9]}]
+ set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X11 + $T19}] 14]}]
+ set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X0 + $T20}] 20]}]
# [ABCD 5 5 21] [DABC 10 9 22] [CDAB 15 14 23] [BCDA 4 20 24]
- set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X(5) + $T(21)}] 5]}]
- set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X(10) + $T(22)}] 9]}]
- set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X(15) + $T(23)}] 14]}]
- set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X(4) + $T(24)}] 20]}]
+ set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X5 + $T21}] 5]}]
+ set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X10 + $T22}] 9]}]
+ set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X15 + $T23}] 14]}]
+ set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X4 + $T24}] 20]}]
# [ABCD 9 5 25] [DABC 14 9 26] [CDAB 3 14 27] [BCDA 8 20 28]
- set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X(9) + $T(25)}] 5]}]
- set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X(14) + $T(26)}] 9]}]
- set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X(3) + $T(27)}] 14]}]
- set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X(8) + $T(28)}] 20]}]
+ set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X9 + $T25}] 5]}]
+ set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X14 + $T26}] 9]}]
+ set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X3 + $T27}] 14]}]
+ set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X8 + $T28}] 20]}]
# [ABCD 13 5 29] [DABC 2 9 30] [CDAB 7 14 31] [BCDA 12 20 32]
- set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X(13) + $T(29)}] 5]}]
- set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X(2) + $T(30)}] 9]}]
- set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X(7) + $T(31)}] 14]}]
- set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X(12) + $T(32)}] 20]}]
+ set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X13 + $T29}] 5]}]
+ set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X2 + $T30}] 9]}]
+ set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X7 + $T31}] 14]}]
+ set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X12 + $T32}] 20]}]
# Round 3.
# Let [abcd k s t] [sic] denote the operation
# a = b + ((a + H(b,c,d) + X[k] + T[i]) <<< s).
# Do the following 16 operations.
# [ABCD 5 4 33] [DABC 8 11 34] [CDAB 11 16 35] [BCDA 14 23 36]
- set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X(5) + $T(33)}] 4]}]
- set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X(8) + $T(34)}] 11]}]
- set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X(11) + $T(35)}] 16]}]
- set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X(14) + $T(36)}] 23]}]
- # [ABCD 1 4 37] [DABC 4 11 38] [CDAB 7 16 39] [BCDA 10 23 40]
- set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X(1) + $T(37)}] 4]}]
- set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X(4) + $T(38)}] 11]}]
- set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X(7) + $T(39)}] 16]}]
- set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X(10) + $T(40)}] 23]}]
+ set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X5 + $T33}] 4]}]
+ set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X8 + $T34}] 11]}]
+ set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X11 + $T35}] 16]}]
+ set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X14 + $T36}] 23]}]
+ # [ABCD 1 4 37] [DABC 4 11 38] [CDAB 7 16 39] [BCDA 10 23 40]
+ set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X1 + $T37}] 4]}]
+ set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X4 + $T38}] 11]}]
+ set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X7 + $T39}] 16]}]
+ set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X10 + $T40}] 23]}]
# [ABCD 13 4 41] [DABC 0 11 42] [CDAB 3 16 43] [BCDA 6 23 44]
- set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X(13) + $T(41)}] 4]}]
- set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X(0) + $T(42)}] 11]}]
- set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X(3) + $T(43)}] 16]}]
- set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X(6) + $T(44)}] 23]}]
+ set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X13 + $T41}] 4]}]
+ set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X0 + $T42}] 11]}]
+ set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X3 + $T43}] 16]}]
+ set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X6 + $T44}] 23]}]
# [ABCD 9 4 45] [DABC 12 11 46] [CDAB 15 16 47] [BCDA 2 23 48]
- set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X(9) + $T(45)}] 4]}]
- set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X(12) + $T(46)}] 11]}]
- set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X(15) + $T(47)}] 16]}]
- set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X(2) + $T(48)}] 23]}]
-
+ set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X9 + $T45}] 4]}]
+ set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X12 + $T46}] 11]}]
+ set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X15 + $T47}] 16]}]
+ set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X2 + $T48}] 23]}]
+
# Round 4.
# Let [abcd k s t] [sic] denote the operation
# a = b + ((a + I(b,c,d) + X[k] + T[i]) <<< s).
# Do the following 16 operations.
# [ABCD 0 6 49] [DABC 7 10 50] [CDAB 14 15 51] [BCDA 5 21 52]
- set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X(0) + $T(49)}] 6]}]
- set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X(7) + $T(50)}] 10]}]
- set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X(14) + $T(51)}] 15]}]
- set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X(5) + $T(52)}] 21]}]
+ set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X0 + $T49}] 6]}]
+ set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X7 + $T50}] 10]}]
+ set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X14 + $T51}] 15]}]
+ set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X5 + $T52}] 21]}]
# [ABCD 12 6 53] [DABC 3 10 54] [CDAB 10 15 55] [BCDA 1 21 56]
- set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X(12) + $T(53)}] 6]}]
- set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X(3) + $T(54)}] 10]}]
- set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X(10) + $T(55)}] 15]}]
- set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X(1) + $T(56)}] 21]}]
+ set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X12 + $T53}] 6]}]
+ set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X3 + $T54}] 10]}]
+ set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X10 + $T55}] 15]}]
+ set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X1 + $T56}] 21]}]
# [ABCD 8 6 57] [DABC 15 10 58] [CDAB 6 15 59] [BCDA 13 21 60]
- set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X(8) + $T(57)}] 6]}]
- set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X(15) + $T(58)}] 10]}]
- set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X(6) + $T(59)}] 15]}]
- set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X(13) + $T(60)}] 21]}]
+ set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X8 + $T57}] 6]}]
+ set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X15 + $T58}] 10]}]
+ set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X6 + $T59}] 15]}]
+ set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X13 + $T60}] 21]}]
# [ABCD 4 6 61] [DABC 11 10 62] [CDAB 2 15 63] [BCDA 9 21 64]
- set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X(4) + $T(61)}] 6]}]
- set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X(11) + $T(62)}] 10]}]
- set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X(2) + $T(63)}] 15]}]
- set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X(9) + $T(64)}] 21]}]
+ set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X4 + $T61}] 6]}]
+ set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X11 + $T62}] 10]}]
+ set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X2 + $T63}] 15]}]
+ set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X9 + $T64}] 21]}]
# Then perform the following additions. (That is increment each
# of the four registers by the value it had before this block
@@ -332,34 +300,93 @@
incr D $DD
}
# 3.5 Step 5. Output
-
+
# ... begin with the low-order byte of A, and end with the high-order byte
# of D.
-
+
return [bytes $A][bytes $B][bytes $C][bytes $D]
}
+ #
+ # Here we inline/regsub the functions F, G, H, I and <<<
+ #
+
+ namespace eval ::md5 {
+ #proc md5pure::F {x y z} {expr {(($x & $y) | ((~$x) & $z))}}
+ regsub -all {\[ *F +(\$.) +(\$.) +(\$.) *\]} $md5body {((\1 \& \2) | ((~\1) \& \3))} md5body
- # bitwise left-rotate
- proc ::md5::<<< {x i} {
- # This works by bitwise-ORing together right piece and left
- # piece so that the (original) right piece becomes the left
- # piece and vice versa.
- #
- # The (original) right piece is a simple left shift.
- # The (original) left piece should be a simple right shift
- # but Tcl does sign extension on right shifts so we
- # shift it 1 bit, mask off the sign, and finally shift
- # it the rest of the way.
+ #proc md5pure::G {x y z} {expr {(($x & $z) | ($y & (~$z)))}}
+ regsub -all {\[ *G +(\$.) +(\$.) +(\$.) *\]} $md5body {((\1 \& \3) | (\2 \& (~\3)))} md5body
+
+ #proc md5pure::H {x y z} {expr {$x ^ $y ^ $z}}
+ regsub -all {\[ *H +(\$.) +(\$.) +(\$.) *\]} $md5body {(\1 ^ \2 ^ \3)} md5body
+
+ #proc md5pure::I {x y z} {expr {$y ^ ($x | (~$z))}}
+ regsub -all {\[ *I +(\$.) +(\$.) +(\$.) *\]} $md5body {(\2 ^ (\1 | (~\3)))} md5body
+
+ # bitwise left-rotate
+ if 0 {
+ proc md5pure::<<< {x i} {
+ # This works by bitwise-ORing together right piece and left
+ # piece so that the (original) right piece becomes the left
+ # piece and vice versa.
+ #
+ # The (original) right piece is a simple left shift.
+ # The (original) left piece should be a simple right shift
+ # but Tcl does sign extension on right shifts so we
+ # shift it 1 bit, mask off the sign, and finally shift
+ # it the rest of the way.
+
+ expr {($x << $i) | ((($x >> 1) & 0x7fffffff) >> (31-$i))}
+ }
+ }
+ # inline <<<
+ regsub -all {\[ *<<< +\[ *expr +({[^\}]*})\] +([0-9]+) *\]} $md5body {(([set x [expr \1]] << \2) | ((($x >> 1) \& 0x7fffffff) >> (31-\2)))} md5body
+
+ # inline the values of T
+ set map {}
+ foreach \
+ tName {
+ T01 T02 T03 T04 T05 T06 T07 T08 T09 T10
+ T11 T12 T13 T14 T15 T16 T17 T18 T19 T20
+ T21 T22 T23 T24 T25 T26 T27 T28 T29 T30
+ T31 T32 T33 T34 T35 T36 T37 T38 T39 T40
+ T41 T42 T43 T44 T45 T46 T47 T48 T49 T50
+ T51 T52 T53 T54 T55 T56 T57 T58 T59 T60
+ T61 T62 T63 T64 } \
+ tVal {
+ 0xd76aa478 0xe8c7b756 0x242070db 0xc1bdceee
+ 0xf57c0faf 0x4787c62a 0xa8304613 0xfd469501
+ 0x698098d8 0x8b44f7af 0xffff5bb1 0x895cd7be
+ 0x6b901122 0xfd987193 0xa679438e 0x49b40821
+
+ 0xf61e2562 0xc040b340 0x265e5a51 0xe9b6c7aa
+ 0xd62f105d 0x2441453 0xd8a1e681 0xe7d3fbc8
+ 0x21e1cde6 0xc33707d6 0xf4d50d87 0x455a14ed
+ 0xa9e3e905 0xfcefa3f8 0x676f02d9 0x8d2a4c8a
+
+ 0xfffa3942 0x8771f681 0x6d9d6122 0xfde5380c
+ 0xa4beea44 0x4bdecfa9 0xf6bb4b60 0xbebfbc70
+ 0x289b7ec6 0xeaa127fa 0xd4ef3085 0x4881d05
+ 0xd9d4d039 0xe6db99e5 0x1fa27cf8 0xc4ac5665
+
+ 0xf4292244 0x432aff97 0xab9423a7 0xfc93a039
+ 0x655b59c3 0x8f0ccc92 0xffeff47d 0x85845dd1
+ 0x6fa87e4f 0xfe2ce6e0 0xa3014314 0x4e0811a1
+ 0xf7537e82 0xbd3af235 0x2ad7d2bb 0xeb86d391
+ } {
+ lappend map \$$tName $tVal
+ }
+ set md5body [string map $map $md5body]
- expr {($x << $i) | ((($x >> 1) & 0x7fffffff) >> (31-$i))}
+
+ # Finally, define the proc
+ proc md5 {msg} $md5body
+
+ # unset auxiliary variables
+ unset md5body tName tVal map
}
-
- proc ::md5::F {x y z} {expr {(($x & $y) | ((~$x) & $z))}}
- proc ::md5::G {x y z} {expr {(($x & $z) | ($y & (~$z)))}}
- proc ::md5::H {x y z} {expr {$x ^ $y ^ $z}}
- proc ::md5::I {x y z} {expr {$y ^ ($x | (~$z))}}
-
+
proc ::md5::byte0 {i} {expr {0xff & $i}}
proc ::md5::byte1 {i} {expr {(0xff00 & $i) >> 8}}
proc ::md5::byte2 {i} {expr {(0xff0000 & $i) >> 16}}
@@ -402,5 +429,6 @@
md5 $k_opad
}
}
+
+package provide md5 1.4
-package provide md5 1.3
Index: modules/md5/pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/md5/pkgIndex.tcl,v
retrieving revision 1.2
diff -u -r1.2 pkgIndex.tcl
--- modules/md5/pkgIndex.tcl 2001/04/25 15:30:03 1.2
+++ modules/md5/pkgIndex.tcl 2001/06/22 14:28:54
@@ -8,4 +8,4 @@
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.
-package ifneeded md5 1.3 [list source [file join $dir md5.tcl]]
+package ifneeded md5 1.4 [list source [file join $dir md5.tcl]]
Index: modules/sha1/ChangeLog
===================================================================
RCS file: ChangeLog
diff -N ChangeLog
--- /dev/null Thu May 24 22:33:05 2001
+++ ChangeLog Fri Jun 22 07:28:54 2001
@@ -0,0 +1,6 @@
+2001-06-21 Andreas Kupries <[email protected]>
+
+ * New module, 'sha1'. The code is Don Libes's <[email protected]>
+ sha1pure, with Donal K. Fellows's patches to speed it up, and
+ extended with a soft dependency on Trf to allow higher speed if
+ the environment is right.
Index: modules/sha1/pkgIndex.tcl
===================================================================
RCS file: pkgIndex.tcl
diff -N pkgIndex.tcl
--- /dev/null Thu May 24 22:33:05 2001
+++ pkgIndex.tcl Fri Jun 22 07:28:54 2001
@@ -0,0 +1,11 @@
+# Tcl package index file, version 1.1
+# This file is generated by the "pkg_mkIndex" command
+# and sourced either when an application starts up or
+# by a "package unknown" script. It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands. When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+
+package ifneeded sha1 1.0 [list source [file join $dir sha1.tcl]]
Index: modules/sha1/sha1.n
===================================================================
RCS file: sha1.n
diff -N sha1.n
--- /dev/null Thu May 24 22:33:05 2001
+++ sha1.n Fri Jun 22 07:28:54 2001
@@ -0,0 +1,45 @@
+'\" Copyright (c) 2001 ActiveState Tool Corp.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id: sha1.n,v 1.2 2001/06/19 17:21:57 andreas_kupries Exp $
+'\"
+.so man.macros
+.TH sha1 n 1.0 Sha1 "sha1 hash"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+::sha1::sha1 \- Perform sha1 hashing
+.SH SYNOPSIS
+\fBpackage require sha1 ?1.0?\fR
+.sp
+\fB::sha1::sha1\fR \fImsg\fR?
+.sp
+\fB::sha1::hmac\fR \fIkey text\fR
+.sp
+.BE
+.SH DESCRIPTION
+.PP
+This package provides commands to compute a SHA1 digests of arbitrary
+messages.
+.SH COMMANDSS
+.TP
+\fB::sha1::sha1\fR \fImsg\fR
+The command takes a message and returns the SHA1 digest of this message
+as a hexadecimal string.
+.TP
+\fB::sha1::hmac\fR \fIkey text\fR
+The command takes a key string and a text and returns the hmac of the
+text nder the chosen key as a hexadecimal string.
+.SH EXAMPLES
+.PP
+.CS
+% sha1::sha1 "hello world"
+2aae6c35c94fcfb415dbe95f408b9ce91ee846ed
+.CE
+.PP
+.CS
+% sha1::hmac "our little secret" "hello world"
+a7ed9d62819b9788e22171d9108a00c370104526
+.CE
+.SH KEYWORDS
+sha1, hashing, security
Index: modules/sha1/sha1.tcl
===================================================================
RCS file: sha1.tcl
diff -N sha1.tcl
--- /dev/null Thu May 24 22:33:05 2001
+++ sha1.tcl Fri Jun 22 07:28:54 2001
@@ -0,0 +1,330 @@
+##################################################
+#
+# sha1.tcl - SHA1 in Tcl
+# Author: Don Libes <[email protected]>, May 2001
+# Version 1.0.0
+#
+# SHA1 defined by FIPS 180-1, "The SHA1 Message-Digest Algorithm",
+# http://www.itl.nist.gov/fipspubs/fip180-1.htm
+# HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication"
+#
+# Some of the comments below come right out of FIPS 180-1; That's why
+# they have such peculiar numbers. In addition, I have retained
+# original syntax, etc. from the FIPS. All remaining bugs are mine.
+#
+# HMAC implementation by D. J. Hagberg <[email protected]> and
+# is based on C code in FIPS 2104.
+#
+# For more info, see: http://expect.nist.gov/sha1pure
+#
+# - Don
+##################################################
+
+### Code speedups by Donal Fellows <[email protected]> who may well
+### have added some extra bugs of his own... :^)
+
+### Changed the code to use Trf if this package is present on the
+### system requiring the sha1 package. Analogous to md5.
+
+namespace eval ::sha1 {
+}
+
+if {![catch {package require Trf 2.0}]} {
+ # Trf is available, so implement the functionality provided here
+ # in terms of calls to Trf for speed.
+
+ proc ::sha1::sha1 {msg} {
+ string tolower [::hex -mode encode [::sha1 $msg]]
+ }
+
+ # hmac: hash for message authentication
+
+ # SHA1 of Trf and SHA1 as defined by this package have slightly
+ # different results. Trf returns the digest in binary, here we get
+ # it as hex-string. In the computation of the HMAC the latter
+ # requires back conversion into binary in some places. With Trf we
+ # can use omit these. (Not all, the first place must not the changed,
+ # see [x]
+
+ proc ::sha1::hmac {key text} {
+ # if key is longer than 64 bytes, reset it to SHA1(key). If shorter,
+ # pad it out with null (\x00) chars.
+ set keyLen [string length $key]
+ if {$keyLen > 64} {
+ set key [binary format H32 [sha1 $key]]
+ # [x] set key [::sha1 $key]
+ set keyLen [string length $key]
+ }
+
+ # ensure the key is padded out to 64 chars with nulls.
+ set padLen [expr {64 - $keyLen}]
+ append key [binary format "a$padLen" {}]
+
+ # Split apart the key into a list of 16 little-endian words
+ binary scan $key i16 blocks
+
+ # XOR key with ipad and opad values
+ set k_ipad {}
+ set k_opad {}
+ foreach i $blocks {
+ append k_ipad [binary format i [expr {$i ^ 0x36363636}]]
+ append k_opad [binary format i [expr {$i ^ 0x5c5c5c5c}]]
+ }
+
+ # Perform inner sha1, appending its results to the outer key
+ append k_ipad $text
+ #append k_opad [binary format H* [sha1 $k_ipad]]
+ append k_opad [::sha1 $k_ipad]
+
+ # Perform outer sha1
+ #sha1 $k_opad
+ string tolower [::hex -mode encode [::sha1 $k_opad]]
+ }
+
+} else {
+ # Without Trf use the all-tcl implementation by Don Libes.
+
+ namespace eval sha1 {
+ variable K
+
+ proc initK {} {
+ variable K {}
+ foreach t {
+ 0x5A827999
+ 0x6ED9EBA1
+ 0x8F1BBCDC
+ 0xCA62C1D6
+ } {
+ for {set i 0} {$i < 20} {incr i} {
+ lappend K $t
+ }
+ }
+ }
+ initK
+ }
+
+ # test sha1
+ #
+ # This proc is not necessary during runtime and may be omitted if you
+ # are simply inserting this file into a production program.
+ #
+ proc sha1::test {} {
+ foreach {msg expected} {
+ "abc"
+ "a9993e364706816aba3e25717850c26c9cd0d89d"
+ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
+ "84983e441c3bd26ebaae4aa1f95129e5e54670f1"
+ "[string repeat a 1000000]"
+ "34aa973cd4c4daa4f61eeb2bdbad27316534016f"
+ } {
+ puts "testing: sha1 \"$msg\""
+ set msg [subst $msg]
+ set msgLen [string length $msg]
+ if {$msgLen > 10000} {
+ puts "warning: msg length = $msgLen; this may take a while . . ."
+ }
+ set computed [sha1 $msg]
+ puts "expected: $expected"
+ puts "computed: $computed"
+ if {0 != [string compare $computed $expected]} {
+ puts "FAILED"
+ } else {
+ puts "SUCCEEDED"
+ }
+ }
+ }
+
+ # time sha1
+ #
+ # This proc is not necessary during runtime and may be omitted if you
+ # are simply inserting this file into a production program.
+ #
+ proc sha1::time {} {
+ foreach len {10 50 100 500 1000 5000 10000} {
+ set time [::time {sha1 [format %$len.0s ""]} 10]
+ regexp "\[0-9]*" $time msec
+ puts "input length $len: [expr {$msec/1000}] milliseconds per interation"
+ }
+ }
+
+ proc sha1::sha1 {msg} {
+ variable K
+
+ #
+ # 4. MESSAGE PADDING
+ #
+
+ # pad to 512 bits (512/8 = 64 bytes)
+
+ set msgLen [string length $msg]
+
+ # last 8 bytes are reserved for msgLen
+ # plus 1 for "1"
+
+ set padLen [expr {56 - $msgLen%64}]
+ if {$msgLen % 64 >= 56} {
+ incr padLen 64
+ }
+
+ # 4a. and b. append single 1b followed by 0b's
+ append msg [binary format "a$padLen" \200]
+
+ # 4c. append 64-bit length
+ # Our implementation obviously limits string length to 32bits.
+ append msg \0\0\0\0[binary format "I" [expr {8*$msgLen}]]
+
+ #
+ # 7. COMPUTING THE MESSAGE DIGEST
+ #
+
+ # initial H buffer
+
+ set H0 0x67452301
+ set H1 0xEFCDAB89
+ set H2 0x98BADCFE
+ set H3 0x10325476
+ set H4 0xC3D2E1F0
+
+ #
+ # process message in 16-word blocks (64-byte blocks)
+ #
+
+ # convert message to array of 32-bit integers
+ # each block of 16-words is stored in M($i,0-16)
+
+ binary scan $msg I* words
+ set blockLen [llength $words]
+
+ for {set i 0} {$i < $blockLen} {incr i 16} {
+ # 7a. Divide M[i] into 16 words W[0], W[1], ...
+ set W [lrange $words $i [expr {$i+15}]]
+
+ # 7b. For t = 16 to 79 let W[t] = ....
+ set t 16
+ set t3 12
+ set t8 7
+ set t14 1
+ set t16 -1
+ for {} {$t < 80} {incr t} {
+ set x [expr {[lindex $W [incr t3]] ^ [lindex $W [incr t8]] ^ \
+ [lindex $W [incr t14]] ^ [lindex $W [incr t16]]}]
+ lappend W [expr {($x << 1) | (($x >> 31) & 1)}]
+ }
+
+ # 7c. Let A = H[0] ....
+ set A $H0
+ set B $H1
+ set C $H2
+ set D $H3
+ set E $H4
+
+ # 7d. For t = 0 to 79 do
+ for {set t 0} {$t < 20} {incr t} {
+ set TEMP [expr {(($A << 5) | (($A >> 27) & 0x1f)) + \
+ (($B & $C) | ((~$B) & $D)) \
+ + $E + [lindex $W $t] + [lindex $K $t]}]
+ set E $D
+ set D $C
+ set C [expr {($B << 30) | (($B >> 2) & 0x3fffffff)}]
+ set B $A
+ set A $TEMP
+ }
+ for {} {$t<40} {incr t} {
+ set TEMP [expr {(($A << 5) | (($A >> 27) & 0x1f)) + \
+ ($B ^ $C ^ $D) \
+ + $E + [lindex $W $t] + [lindex $K $t]}]
+ set E $D
+ set D $C
+ set C [expr {($B << 30) | (($B >> 2) & 0x3fffffff)}]
+ set B $A
+ set A $TEMP
+ }
+ for {} {$t<60} {incr t} {
+ set TEMP [expr {(($A << 5) | (($A >> 27) & 0x1f)) + \
+ (($B & $C) | ($B & $D) | ($C & $D)) \
+ + $E + [lindex $W $t] + [lindex $K $t]}]
+ set E $D
+ set D $C
+ set C [expr {($B << 30) | (($B >> 2) & 0x3fffffff)}]
+ set B $A
+ set A $TEMP
+ }
+ for {} {$t<80} {incr t} {
+ set TEMP [expr {(($A << 5) | (($A >> 27) & 0x1f)) + \
+ ($B ^ $C ^ $D) \
+ + $E + [lindex $W $t] + [lindex $K $t]}]
+ set E $D
+ set D $C
+ set C [expr {($B << 30) | (($B >> 2) & 0x3fffffff)}]
+ set B $A
+ set A $TEMP
+ }
+
+ incr H0 $A
+ incr H1 $B
+ incr H2 $C
+ incr H3 $D
+ incr H4 $E
+ }
+
+ return [format %0.8x%0.8x%0.8x%0.8x%0.8x $H0 $H1 $H2 $H3 $H4]
+ }
+
+ ### These procedures are either inlined or replaced with a normal [format]!
+ #
+ #proc sha1::f {t B C D} {
+ # switch [expr {$t/20}] {
+ # 0 {
+ # expr {($B & $C) | ((~$B) & $D)}
+ # } 1 - 3 {
+ # expr {$B ^ $C ^ $D}
+ # } 2 {
+ # expr {($B & $C) | ($B & $D) | ($C & $D)}
+ # }
+ # }
+ #}
+ #
+ #proc sha1::byte0 {i} {expr {0xff & $i}}
+ #proc sha1::byte1 {i} {expr {(0xff00 & $i) >> 8}}
+ #proc sha1::byte2 {i} {expr {(0xff0000 & $i) >> 16}}
+ #proc sha1::byte3 {i} {expr {((0xff000000 & $i) >> 24) & 0xff}}
+ #
+ #proc sha1::bytes {i} {
+ # format %0.2x%0.2x%0.2x%0.2x [byte3 $i] [byte2 $i] [byte1 $i] [byte0 $i]
+ #}
+
+ # hmac: hash for message authentication
+ proc sha1::hmac {key text} {
+ # if key is longer than 64 bytes, reset it to SHA1(key). If shorter,
+ # pad it out with null (\x00) chars.
+ set keyLen [string length $key]
+ if {$keyLen > 64} {
+ set key [binary format H32 [sha1 $key]]
+ set keyLen [string length $key]
+ }
+
+ # ensure the key is padded out to 64 chars with nulls.
+ set padLen [expr {64 - $keyLen}]
+ append key [binary format "a$padLen" {}]
+
+ # Split apart the key into a list of 16 little-endian words
+ binary scan $key i16 blocks
+
+ # XOR key with ipad and opad values
+ set k_ipad {}
+ set k_opad {}
+ foreach i $blocks {
+ append k_ipad [binary format i [expr {$i ^ 0x36363636}]]
+ append k_opad [binary format i [expr {$i ^ 0x5c5c5c5c}]]
+ }
+
+ # Perform inner sha1, appending its results to the outer key
+ append k_ipad $text
+ append k_opad [binary format H* [sha1 $k_ipad]]
+
+ # Perform outer sha1
+ sha1 $k_opad
+ }
+}
+
+package provide sha1 1.0
Index: modules/sha1/sha1.test
===================================================================
RCS file: sha1.test
diff -N sha1.test
--- /dev/null Thu May 24 22:33:05 2001
+++ sha1.test Fri Jun 22 07:28:54 2001
@@ -0,0 +1,70 @@
+# -*- tcl -*-
+# sha1.test: tests for the sha1 commands
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 2001 by ActiveState Tool Corp.
+# All rights reserved.
+#
+# RCS: @(#) $Id: sha1.test,v 1.2 2001/04/25 15:30:03 andreas_kupries Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import ::tcltest::*
+}
+
+package require sha1
+if {[catch {package present Trf}]} {
+ puts "sha1 [package present sha1] (pure Tcl)"
+} else {
+ puts "sha1 [package present sha1] (Trf based)"
+}
+
+
+test sha1-1.0 {sha1} {
+ catch {::sha1::sha1} result
+ set result
+} {no value given for parameter "msg" to "::sha1::sha1"}
+
+test sha1-1.1 {sha1} {
+ catch {::sha1::hmac} result
+ set result
+} {no value given for parameter "key" to "::sha1::hmac"}
+
+test sha1-1.2 {sha1} {
+ catch {::sha1::hmac key} result
+ set result
+} {no value given for parameter "text" to "::sha1::hmac"}
+
+
+foreach {n msg expected} {
+ 1 "abc"
+ "a9993e364706816aba3e25717850c26c9cd0d89d"
+ 2 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
+ "84983e441c3bd26ebaae4aa1f95129e5e54670f1"
+} {
+ test sha1-2.$n {sha1} {
+ ::sha1::sha1 $msg
+ } $expected ; # {}
+}
+
+foreach {n key text expected} {
+ 1 "" "" "fbdb1d1b18aa6c08324b7d64b71fb76370690e1d"
+ 2 "foo" "hello" "4c883e9bc42763641bba04185d492de00de7ce2c"
+ 3 "bar" "world" "a905e79f51faa446cb5a3888b577e34577ef7fce"
+ 4 "key" "text" "369e2959eb49450338b212748f77d8ded74847bb"
+ 5 "sha1" "hmac" "2660aeeccf432596e56f8f8260de971322e8935b"
+ 6 "hmac" "sha1" "170523fd610da92dd4b4fb948a01a8365d66511a"
+ 7 "sha1" "sha1" "5154473317173f66212fc59365233ffd9cbaab94"
+ 8 "hmac" "hmac" "9e08393f6ac829c4385930ea38567dad582d958f"
+ 9 "01234567abcdefgh01234567abcdefgh01234567abcdefgh01234567abcdefgh==" "hello world"
+ "6541c34492618a052c12cb9f88fb795d97595b34"
+} {
+ test sha1-3.$n {hmac} {
+ ::sha1::hmac $key $text
+ } $expected ; # {}
+}
+
+::tcltest::cleanupTests
