? 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 <andreas_kupries@users.sourceforge.net>
+
+	* Makefile.in (MODULES): Added module 'sha1'. This is another
+	  message digest like 'md5'.
+
 2001-05-01  Andreas Kupries <andreas_kupries@users.sourceforge.net>
 
 	* 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  <mig@utdt.edu>
+
+	* 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  <welch@ajubasolutions.com>
 
 	* 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  <mig@utdt.edu>
+
+	* 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 <andreas_kupries@users.sourceforge.net>
 
 	* 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 <andreas_kupries@users.sourceforge.net>
+
+	* New module, 'sha1'. The code is Don Libes's <libes@nist.gov>
+	  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 <libes@nist.gov>, 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 <dhagberg@millibits.com> and
+# is based on C code in FIPS 2104.
+#
+# For more info, see: http://expect.nist.gov/sha1pure
+#
+# - Don
+##################################################
+
+### Code speedups by Donal Fellows <fellowsd@cs.man.ac.uk> 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
