Added support for 8.6's zlib integration.

3 files changed, 182 insertions, 138 deletions

diff --git a/ChangeLog b/ChangeLog
index a544df3..118a7bf 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2009-02-24  Donal K. Fellows  <dkf@users.sf.net>
+
+	* library/http/http.tcl (geturl, Eof): Added support for 8.6's built
+	in zlib routines.
+
 2009-02-22  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>
 
 	* tests/lrange.test:    Revert commits of 20080723. Those were
diff --git a/library/http/http.tcl b/library/http/http.tcl
index fab054f..a98e145 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -1,19 +1,19 @@
 # http.tcl --
 #
 #	Client-side HTTP for GET, POST, and HEAD commands. These routines can
-#	be used in untrusted code that uses the Safesock security policy. These
-#	procedures use a callback interface to avoid using vwait, which is not
-#	defined in the safe base.
+#	be used in untrusted code that uses the Safesock security policy.
+#	These procedures use a callback interface to avoid using vwait, which
+#	is not defined in the safe base.
 #
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: http.tcl,v 1.72 2008/10/23 23:17:38 patthoyts Exp $
+# RCS: @(#) $Id: http.tcl,v 1.73 2009/02/24 14:39:15 dkf Exp $
 
 package require Tcl 8.4
-# Keep this in sync with pkgIndex.tcl and with the install directories
-# in Makefiles
-package provide http 2.7.2
+# Keep this in sync with pkgIndex.tcl and with the install directories in
+# Makefiles
+package provide http 2.7.3
 
 namespace eval http {
     # Allow resourcing to not clobber existing data
@@ -32,9 +32,9 @@ namespace eval http {
 
     proc init {} {
 	# Set up the map for quoting chars. RFC3986 Section 2.3 say percent
-	# encode all except: "... percent-encoded octets in the ranges of ALPHA
-	# (%41-%5A and %61-%7A), DIGIT (%30-%39), hyphen (%2D), period (%2E),
-	# underscore (%5F), or tilde (%7E) should not be created by URI
+	# encode all except: "... percent-encoded octets in the ranges of
+	# ALPHA (%41-%5A and %61-%7A), DIGIT (%30-%39), hyphen (%2D), period
+	# (%2E), underscore (%5F), or tilde (%7E) should not be created by URI
 	# producers ..."
 	for {set i 0} {$i <= 256} {incr i} {
 	    set c [format %c $i]
@@ -101,9 +101,9 @@ proc http::Log {args} {}
 #     See documentation for details.
 #
 # Arguments:
-#     proto           URL protocol prefix, e.g. https
-#     port            Default port for protocol
-#     command         Command to use to create socket
+#     proto	URL protocol prefix, e.g. https
+#     port	Default port for protocol
+#     command	Command to use to create socket
 # Results:
 #     list of port and command that was registered.
 
@@ -117,7 +117,7 @@ proc http::register {proto port command} {
 #     Unregisters URL protocol handler
 #
 # Arguments:
-#     proto           URL protocol prefix, e.g. https
+#     proto	URL protocol prefix, e.g. https
 # Results:
 #     list of port and command that was unregistered.
 
@@ -152,21 +152,19 @@ proc http::config {args} {
 	return $result
     }
     set options [string map {- ""} $options]
-    set pat ^-([join $options |])$
+    set pat ^-(?:[join $options |])$
     if {[llength $args] == 1} {
 	set flag [lindex $args 0]
-	if {[regexp -- $pat $flag]} {
-	    return $http($flag)
-	} else {
+	if {![regexp -- $pat $flag]} {
 	    return -code error "Unknown option $flag, must be: $usage"
 	}
+	return $http($flag)
     } else {
 	foreach {flag value} $args {
-	    if {[regexp -- $pat $flag]} {
-		set http($flag) $value
-	    } else {
+	    if {![regexp -- $pat $flag]} {
 		return -code error "Unknown option $flag, must be: $usage"
 	    }
+	    set http($flag) $value
 	}
     }
 }
@@ -179,14 +177,14 @@ proc http::config {args} {
 #	token	    Connection token.
 #	errormsg    (optional) If set, forces status to error.
 #       skipCB      (optional) If set, don't call the -command callback. This
-#                   is useful when geturl wants to throw an exception instead
-#                   of calling the callback. That way, the same error isn't
-#                   reported to two places.
+#		    is useful when geturl wants to throw an exception instead
+#		    of calling the callback. That way, the same error isn't
+#		    reported to two places.
 #
 # Side Effects:
 #        Closes the socket
 
-proc http::Finish { token {errormsg ""} {skipCB 0}} {
+proc http::Finish {token {errormsg ""} {skipCB 0}} {
     variable $token
     upvar 0 $token state
     global errorInfo errorCode
@@ -194,12 +192,15 @@ proc http::Finish { token {errormsg ""} {skipCB 0}} {
 	set state(error) [list $errormsg $errorInfo $errorCode]
 	set state(status) "error"
     }
-    if {($state(status) eq "timeout") || ($state(status) eq "error")
-        || ([info exists state(connection)] && ($state(connection) eq "close"))
-    } {
+    if {
+	($state(status) eq "timeout") || ($state(status) eq "error") ||
+	([info exists state(connection)] && ($state(connection) eq "close"))
+    } then {
         CloseSocket $state(sock) $token
     }
-    if {[info exists state(after)]} { after cancel $state(after) }
+    if {[info exists state(after)]} {
+	after cancel $state(after)
+    }
     if {[info exists state(-command)] && !$skipCB} {
 	if {[catch {eval $state(-command) {$token}} err]} {
 	    if {$errormsg eq ""} {
@@ -214,10 +215,10 @@ proc http::Finish { token {errormsg ""} {skipCB 0}} {
 
 # http::CloseSocket -
 #
-#	Close a socket and remove it from the persistent sockets table.
-#	If possible an http token is included here but when we are called
-#	from a fileevent on remote closure we need to find the correct
-#	entry - hence the second section.
+#	Close a socket and remove it from the persistent sockets table.  If
+#	possible an http token is included here but when we are called from a
+#	fileevent on remote closure we need to find the correct entry - hence
+#	the second section.
 
 proc ::http::CloseSocket {s {token {}}} {
     variable socketmap
@@ -227,23 +228,27 @@ proc ::http::CloseSocket {s {token {}}} {
         variable $token
         upvar 0 $token state
         if {[info exists state(socketinfo)]} {
-            set conn_id $state(socketinfo)
+	    set conn_id $state(socketinfo)
         }
     } else {
         set map [array get socketmap]
         set ndx [lsearch -exact $map $s]
         if {$ndx != -1} {
-            incr ndx -1
-            set conn_id [lindex $map $ndx]
+	    incr ndx -1
+	    set conn_id [lindex $map $ndx]
         }
     }
     if {$conn_id eq {} || ![info exists socketmap($conn_id)]} {
         Log "Closing socket $s (no connection info)"
-        if {[catch {close $s} err]} { Log "Error: $err" }
+        if {[catch {close $s} err]} {
+	    Log "Error: $err"
+	}
     } else {
 	if {[info exists socketmap($conn_id)]} {
 	    Log "Closing connection $conn_id (sock $socketmap($conn_id))"
-	    if {[catch {close $socketmap($conn_id)} err]} { Log "Error: $err" }
+	    if {[catch {close $socketmap($conn_id)} err]} {
+		Log "Error: $err"
+	    }
 	    unset socketmap($conn_id)
 	} else {
 	    Log "Cannot close connection $conn_id - no socket in socket map"
@@ -262,7 +267,7 @@ proc ::http::CloseSocket {s {token {}}} {
 # Side Effects:
 #       See Finish
 
-proc http::reset { token {why reset} } {
+proc http::reset {token {why reset}} {
     variable $token
     upvar 0 $token state
     set state(status) $why
@@ -285,10 +290,10 @@ proc http::reset { token {why reset} } {
 #       args		Option value pairs. Valid options include:
 #				-blocksize, -validate, -headers, -timeout
 # Results:
-#	Returns a token for this connection. This token is the name of an array
-#	that the caller should unset to garbage collect the state.
+#	Returns a token for this connection. This token is the name of an
+#	array that the caller should unset to garbage collect the state.
 
-proc http::geturl { url args } {
+proc http::geturl {url args} {
     variable http
     variable urlTypes
     variable defaultCharset
@@ -351,14 +356,17 @@ proc http::geturl { url args } {
     }
     set usage [join [lsort $options] ", "]
     set options [string map {- ""} $options]
-    set pat ^-([join $options |])$
+    set pat ^-(?:[join $options |])$
     foreach {flag value} $args {
 	if {[regexp -- $pat $flag]} {
 	    # Validate numbers
-	    if {[info exists type($flag)] &&
-		![string is $type($flag) -strict $value]} {
+	    if {
+		[info exists type($flag)] &&
+		![string is $type($flag) -strict $value]
+	    } then {
 		unset $token
-		return -code error "Bad value for $flag ($value), must be $type($flag)"
+		return -code error \
+		    "Bad value for $flag ($value), must be $type($flag)"
 	    }
 	    set state($flag) $value
 	} else {
@@ -397,7 +405,9 @@ proc http::geturl { url args } {
     #	pass it in here, but it's cheap to strip).
     #
     # An example of a URL that has all the parts:
-    #   http://jschmoe:xyzzy@www.bogus.net:8000/foo/bar.tml?q=foo#changes
+    #
+    #     http://jschmoe:xyzzy@www.bogus.net:8000/foo/bar.tml?q=foo#changes
+    #
     # The "http" is the protocol, the user is "jschmoe", the password is
     # "xyzzy", the host is "www.bogus.net", the port is "8000", the path is
     # "/foo/bar.tml", the query is "q=foo", and the fragment is "changes".
@@ -408,9 +418,8 @@ proc http::geturl { url args } {
     # Also note that we do not currently support IPv6 addresses.
     #
     # From a validation perspective, we need to ensure that the parts of the
-    # URL that are going to the server are correctly encoded.
-    # This is only done if $state(-strict) is true (inherited from
-    # $::http::strict).
+    # URL that are going to the server are correctly encoded.  This is only
+    # done if $state(-strict) is true (inherited from $::http::strict).
 
     set URLmatcher {(?x)		# this is _expanded_ syntax
 	^
@@ -481,7 +490,7 @@ proc http::geturl { url args } {
 	    # Provide a better error message in this error case
 	    if {[regexp {(?i)%(?![0-9a-f][0-9a-f])..} $srvurl bad]} {
 		return -code error \
-			"Illegal encoding character usage \"$bad\" in URL path"
+		    "Illegal encoding character usage \"$bad\" in URL path"
 	    }
 	    return -code error "Illegal characters in URL path"
 	}
@@ -565,15 +574,15 @@ proc http::geturl { url args } {
 	    lappend sockopts -myaddr $state(-myaddr)
 	}
         if {[catch {eval $defcmd $sockopts $targetAddr} sock]} {
-            # something went wrong while trying to establish the
-            # connection. Clean up after events and such, but DON'T call the
-            # command callback (if available) because we're going to throw an
-            # exception from here instead.
+	    # something went wrong while trying to establish the connection.
+	    # Clean up after events and such, but DON'T call the command
+	    # callback (if available) because we're going to throw an
+	    # exception from here instead.
 
 	    set state(sock) $sock
-            Finish $token "" 1
-            cleanup $token
-            return -code error $sock
+	    Finish $token "" 1
+	    cleanup $token
+	    return -code error $sock
         }
     }
     set state(sock) $sock
@@ -591,8 +600,8 @@ proc http::geturl { url args } {
 
 	if {![info exists state]} {
 	    # If we timed out then Finish has been called and the users
-	    # command callback may have cleaned up the token. If so
-	    # we end up here with nothing left to do.
+	    # command callback may have cleaned up the token. If so we end up
+	    # here with nothing left to do.
 	    return $token
 	} elseif {$state(status) eq "error"} {
 	    # Something went wrong while trying to establish the connection.
@@ -646,11 +655,11 @@ proc http::geturl { url args } {
 	puts $sock "Accept: $http(-accept)"
 	array set hdrs $state(-headers)
 	if {[info exists hdrs(Host)]} {
-	    # Allow Host spoofing [Bug 928154]
+	    # Allow Host spoofing. [Bug 928154]
 	    puts $sock "Host: $hdrs(Host)"
 	} elseif {$port == $defport} {
-	    # Don't add port in this case, to handle broken servers.
-	    # [Bug #504508]
+	    # Don't add port in this case, to handle broken servers. [Bug
+	    # #504508]
 	    puts $sock "Host: $host"
 	} else {
 	    puts $sock "Host: $host:$port"
@@ -658,20 +667,22 @@ proc http::geturl { url args } {
 	unset hdrs
 	puts $sock "User-Agent: $http(-useragent)"
         if {$state(-protocol) == 1.0 && $state(-keepalive)} {
-            puts $sock "Connection: keep-alive"
+	    puts $sock "Connection: keep-alive"
         }
         if {$state(-protocol) > 1.0 && !$state(-keepalive)} {
-            puts $sock "Connection: close" ;# RFC2616 sec 8.1.2.1
+	    puts $sock "Connection: close" ;# RFC2616 sec 8.1.2.1
         }
         if {[info exists phost] && ($phost ne "") && $state(-keepalive)} {
-            puts $sock "Proxy-Connection: Keep-Alive"
+	    puts $sock "Proxy-Connection: Keep-Alive"
         }
         set accept_encoding_seen 0
 	foreach {key value} $state(-headers) {
-	    if {[string equal -nocase $key "host"]} { continue }
-            if {[string equal -nocase $key "accept-encoding"]} {
-                set accept_encoding_seen 1
-            }
+	    if {[string equal -nocase $key "host"]} {
+		continue
+	    }
+	    if {[string equal -nocase $key "accept-encoding"]} {
+		set accept_encoding_seen 1
+	    }
 	    set value [string map [list \n "" \r ""] $value]
 	    set key [string trim $key]
 	    if {[string equal -nocase $key "content-length"]} {
@@ -683,10 +694,13 @@ proc http::geturl { url args } {
 	    }
 	}
 	# Soft zlib dependency check - no package require
-        if {!$accept_encoding_seen && [llength [package provide zlib]]
-            && !([info exists state(-channel)] || [info exists state(-handler)])
-        } {
-            puts $sock "Accept-Encoding: gzip, identity, *;q=0.1"
+        if {
+	    !$accept_encoding_seen &&
+	    ([package vsatisfies [package provide Tcl] 8.6]
+		|| [llength [package provide zlib]]) &&
+	    !([info exists state(-channel)] || [info exists state(-handler)])
+        } then {
+	    puts $sock "Accept-Encoding: gzip, identity, *;q=0.1"
         }
 	if {$isQueryChannel && $state(querylength) == 0} {
 	    # Try to determine size of data in channel. If we cannot seek, the
@@ -707,13 +721,14 @@ proc http::geturl { url args } {
 	# It is possible to have both the read and write fileevents active at
 	# this point. The only scenario it seems to affect is a server that
 	# closes the connection without reading the POST data. (e.g., early
-	# versions TclHttpd in various error cases). Depending on the platform,
-	# the client may or may not be able to get the response from the server
-	# because of the error it will get trying to write the post data.
-	# Having both fileevents active changes the timing and the behavior,
-	# but no two platforms (among Solaris, Linux, and NT) behave the same,
-	# and none behave all that well in any case. Servers should always read
-	# their POST data if they expect the client to read their response.
+	# versions TclHttpd in various error cases). Depending on the
+	# platform, the client may or may not be able to get the response from
+	# the server because of the error it will get trying to write the post
+	# data.  Having both fileevents active changes the timing and the
+	# behavior, but no two platforms (among Solaris, Linux, and NT) behave
+	# the same, and none behave all that well in any case. Servers should
+	# always read their POST data if they expect the client to read their
+	# response.
 
 	if {$isQuery || $isQueryChannel} {
 	    puts $sock "Content-Type: $state(-type)"
@@ -729,7 +744,7 @@ proc http::geturl { url args } {
 	    fileevent $sock readable [list http::Event $sock $token]
 	}
 
-	if {! [info exists state(-command)]} {
+	if {![info exists state(-command)]} {
 	    # geturl does EVERYTHING asynchronously, so if the user calls it
 	    # synchronously, we just do a wait here.
 
@@ -740,7 +755,7 @@ proc http::geturl { url args } {
 		return -code error [lindex $state(error) 0]
 	    }
 	}
-    } err]} {
+    } err]} then {
 	# The socket probably was never connected, or the connection dropped
 	# later.
 
@@ -772,7 +787,9 @@ proc http::data {token} {
     return $state(body)
 }
 proc http::status {token} {
-    if {![info exists $token]} { return "error" }
+    if {![info exists $token]} {
+	return "error"
+    }
     variable $token
     upvar 0 $token state
     return $state(status)
@@ -843,9 +860,11 @@ proc http::Connect {token} {
     variable $token
     upvar 0 $token state
     global errorInfo errorCode
-    if {[eof $state(sock)] ||
-	[string length [fconfigure $state(sock) -error]]} {
-	    Finish $token "connect failed [fconfigure $state(sock) -error]" 1
+    if {
+	[eof $state(sock)] ||
+	[string length [fconfigure $state(sock) -error]]
+    } then {
+	Finish $token "connect failed [fconfigure $state(sock) -error]" 1
     } else {
 	set state(status) connect
 	fileevent $state(sock) writable {}
@@ -896,7 +915,7 @@ proc http::Write {token} {
 		set done 1
 	    }
 	}
-    } err]} {
+    } err]} then {
 	# Do not call Finish here, but instead let the read half of the socket
 	# process whatever server reply there is to get.
 
@@ -934,8 +953,8 @@ proc http::Event {sock token} {
 
     if {![info exists state]} {
 	Log "Event $sock with invalid token '$token' - remote close?"
-	if {! [eof $sock]} {
-	    if {[string length [set d [read $sock]]] != 0} {
+	if {![eof $sock]} {
+	    if {[set d [read $sock]] ne ""} {
 		Log "WARNING: additional data left on closed socket"
 	    }
 	}
@@ -953,7 +972,9 @@ proc http::Event {sock token} {
 	} elseif {$n == 0} {
 	    # We have now read all headers
 	    # We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3
-	    if {$state(http) == "" || [lindex $state(http) 1] == 100} { return }
+	    if {$state(http) == "" || [lindex $state(http) 1] == 100} {
+		return
+	    }
 
 	    set state(state) body
 
@@ -963,14 +984,15 @@ proc http::Event {sock token} {
 		return
 	    }
 
-	    # For non-chunked transfer we may have no body -- in this case we
-	    # may get no further file event if the connection doesn't close and
-	    # no more data is sent. We can tell and must finish up now - not
-	    # later.
-	    if {!(([info exists state(connection)]
-		   && ($state(connection) eq "close"))
-		  || [info exists state(transfer)])
-		&&  $state(totalsize) == 0
+	    # For non-chunked transfer we may have no body - in this case we
+	    # may get no further file event if the connection doesn't close
+	    # and no more data is sent. We can tell and must finish up now -
+	    # not later.
+	    if {
+		!(([info exists state(connection)]
+			&& ($state(connection) eq "close"))
+		    || [info exists state(transfer)])
+		&& ($state(totalsize) == 0)
 	    } then {
 		Log "body size is 0 and no events likely - complete."
 		Eof $token
@@ -980,18 +1002,24 @@ proc http::Event {sock token} {
 	    # We have to use binary translation to count bytes properly.
 	    fconfigure $sock -translation binary
 
-	    if {$state(-binary) || ![string match -nocase text* $state(type)]} {
+	    if {
+		$state(-binary) || ![string match -nocase text* $state(type)]
+	    } then {
 		# Turn off conversions for non-text data
 		set state(binary) 1
 	    }
-	    if {$state(binary) || [string match *gzip* $state(coding)]
-		|| [string match *compress* $state(coding)]} {
+	    if {
+		$state(binary) || [string match *gzip* $state(coding)] ||
+		[string match *compress* $state(coding)]
+	    } then {
 		if {[info exists state(-channel)]} {
 		    fconfigure $state(-channel) -translation binary
 		}
 	    }
-	    if {[info exists state(-channel)] && 
-		![info exists state(-handler)]} {
+	    if {
+		[info exists state(-channel)] &&
+		![info exists state(-handler)]
+	    } then {
 		# Initiate a sequence of background fcopies
 		fileevent $sock readable {}
 		CopyStart $sock $token
@@ -1041,8 +1069,10 @@ proc http::Event {sock token} {
 		    Log "final chunk part"
 		    Eof $token
 		}
-	    } elseif {[info exists state(transfer)]
-		      && $state(transfer) eq "chunked"} {
+	    } elseif {
+		[info exists state(transfer)]
+		&& $state(transfer) eq "chunked"
+	    } then {
 		set size 0
 		set chunk [getTextLine $sock]
 		set n [string length $chunk]
@@ -1079,12 +1109,14 @@ proc http::Event {sock token} {
 		    incr state(currentsize) $n
 		}
 		# If Content-Length - check for end of data.
-		if {($state(totalsize) > 0)
-		    && ($state(currentsize) >= $state(totalsize))} {
+		if {
+		    ($state(totalsize) > 0)
+		    && ($state(currentsize) >= $state(totalsize))
+		} then {
 		    Eof $token
 		}
 	    }
-	} err]} {
+	} err]} then {
 	    return [Finish $token $err]
 	} else {
 	    if {[info exists state(-progress)]} {
@@ -1143,7 +1175,7 @@ proc http::CopyStart {sock token} {
     if {[catch {
 	fcopy $sock $state(-channel) -size $state(-blocksize) -command \
 	    [list http::CopyDone $token]
-    } err]} {
+    } err]} then {
 	Finish $token $err
     }
 }
@@ -1200,22 +1232,26 @@ proc http::Eof {token {force 0}} {
 
     if {($state(coding) eq "gzip") && [string length $state(body)] > 0} {
         if {[catch {
-            set state(body) [Gunzip $state(body)]
-        } err]} {
-            return [Finish $token $err]
+	    if {[package vsatisfies [package present Tcl] 8.6]} {
+		# The zlib integration into 8.6 includes proper gzip support
+		set state(body) [zlib gunzip $state(body)]
+	    } else {
+		set state(body) [Gunzip $state(body)]
+	    }
+        } err]} then {
+	    return [Finish $token $err]
         }
     }
 
     if {!$state(binary)} {
-
-        # If we are getting text, set the incoming channel's
-        # encoding correctly.  iso8859-1 is the RFC default, but
-        # this could be any IANA charset.  However, we only know
-        # how to convert what we have encodings for.
+        # If we are getting text, set the incoming channel's encoding
+        # correctly.  iso8859-1 is the RFC default, but this could be any IANA
+        # charset.  However, we only know how to convert what we have
+        # encodings for.
 
         set enc [CharsetToEncoding $state(charset)]
         if {$enc ne "binary"} {
-            set state(body) [encoding convertfrom $enc $state(body)]
+	    set state(body) [encoding convertfrom $enc $state(body)]
         }
 
         # Translate text line endings.
@@ -1317,8 +1353,10 @@ proc http::mapReply {string} {
 proc http::ProxyRequired {host} {
     variable http
     if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {
-	if {![info exists http(-proxyport)] || \
-		![string length $http(-proxyport)]} {
+	if {
+	    ![info exists http(-proxyport)] ||
+	    ![string length $http(-proxyport)]
+	} then {
 	    set http(-proxyport) 8080
 	}
 	return [list $http(-proxyhost) $http(-proxyport)]
@@ -1327,33 +1365,33 @@ proc http::ProxyRequired {host} {
 
 # http::CharsetToEncoding --
 #
-# 	Tries to map a given IANA charset to a tcl encoding.
-#	If no encoding can be found, returns binary.
+#	Tries to map a given IANA charset to a tcl encoding.  If no encoding
+#	can be found, returns binary.
 #
 
 proc http::CharsetToEncoding {charset} {
     variable encodings
 
     set charset [string tolower $charset]
-    if {[regexp {iso-?8859-([0-9]+)} $charset - num]} {
+    if {[regexp {iso-?8859-([0-9]+)} $charset -> num]} {
 	set encoding "iso8859-$num"
-    } elseif {[regexp {iso-?2022-(jp|kr)} $charset - ext]} {
+    } elseif {[regexp {iso-?2022-(jp|kr)} $charset -> ext]} {
 	set encoding "iso2022-$ext"
-    } elseif {[regexp {shift[-_]?js} $charset -]} {
+    } elseif {[regexp {shift[-_]?js} $charset]} {
 	set encoding "shiftjis"
-    } elseif {[regexp {(windows|cp)-?([0-9]+)} $charset - - num]} {
+    } elseif {[regexp {(?:windows|cp)-?([0-9]+)} $charset -> num]} {
 	set encoding "cp$num"
     } elseif {$charset eq "us-ascii"} {
 	set encoding "ascii"
-    } elseif {[regexp {(iso-?)?lat(in)?-?([0-9]+)} $charset - - - num]} {
+    } elseif {[regexp {(?:iso-?)?lat(?:in)?-?([0-9]+)} $charset -> num]} {
 	switch -- $num {
 	    5 {set encoding "iso8859-9"}
-	    1 -
-	    2 -
-	    3 {set encoding "iso8859-$num"}
+	    1 - 2 - 3 {
+		set encoding "iso8859-$num"
+	    }
 	}
     } else {
-	# other charset, like euc-xx, utf-8,...  may directly maps to encoding
+	# other charset, like euc-xx, utf-8,...  may directly map to encoding
 	set encoding $charset
     }
     set idx [lsearch -exact $encodings $encoding]
@@ -1380,9 +1418,10 @@ proc http::Gunzip {data} {
         return -code error "invalid compression method"
     }
 
+    # lassign [split $flags ""] f_text f_crc f_extra f_name f_comment
     foreach {f_text f_crc f_extra f_name f_comment} [split $flags ""] break
     set extra ""
-    if { $f_extra } {
+    if {$f_extra} {
 	binary scan $data @${pos}S xlen
         incr pos 2
         set extra [string range $data $pos $xlen]
@@ -1390,21 +1429,21 @@ proc http::Gunzip {data} {
     }
 
     set name ""
-    if { $f_name } {
+    if {$f_name} {
         set ndx [string first \0 $data $pos]
         set name [string range $data $pos $ndx]
         set pos [incr ndx]
     }
 
     set comment ""
-    if { $f_comment } {
+    if {$f_comment} {
         set ndx [string first \0 $data $pos]
         set comment [string range $data $pos $ndx]
         set pos [incr ndx]
     }
 
     set fcrc ""
-    if { $f_crc } {
+    if {$f_crc} {
 	set fcrc [string range $data $pos [incr pos]]
         incr pos
     }
@@ -1412,7 +1451,7 @@ proc http::Gunzip {data} {
     binary scan [string range $data end-7 end] ii crc size
     set inflated [zlib inflate [string range $data $pos end-8]]
     set chk [zlib crc32 $inflated]
-    if { ($crc & 0xffffffff) != ($chk & 0xffffffff)} {
+    if {($crc & 0xffffffff) != ($chk & 0xffffffff)} {
 	return -code error "invalid data: checksum mismatch $crc != $chk"
     }
     return $inflated
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index 6badcea..07724d3 100644
--- a/library/http/pkgIndex.tcl
+++ b/library/http/pkgIndex.tcl
@@ -1,4 +1,4 @@
 # Tcl package index file, version 1.1
 
 if {![package vsatisfies [package provide Tcl] 8.4]} {return}
-package ifneeded http 2.7.2 [list tclPkgSetup $dir http 2.7.2 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.7.3 [list tclPkgSetup $dir http 2.7.3 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]