Check-in [317d88eb76]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Backported a fix for reading HTTP-like protocols that used to work and were broken with http 2.7. Now http 2.7.2
Timelines: family | ancestors | descendants | both | core-8-5-branch
Files: files | file ages | folders
SHA1: 317d88eb7673a63710fa91ca286a5c09a08438e3
User & Date: patthoyts 2008-10-23 23:34:32.000
Context
2008-10-24
00:46
Removed a rogue ^M from the end of a line check-in: f442984efd user: patthoyts tags: core-8-5-branch
2008-10-23
23:34
Backported a fix for reading HTTP-like protocols that used to work and were broken with http 2.7. No... check-in: 317d88eb76 user: patthoyts tags: core-8-5-branch
16:27
* generic/tcl.h: Bump version number to 8.5.6b1 to distinguish * library/init... check-in: ec374ebf84 user: dgp tags: core-8-5-branch
Changes
Unified Diff Ignore Whitespace Patch
Changes to ChangeLog.





1
2
3
4
5
6
7





2008-10-23  Don Porter	<dgp@users.sourceforge.net>

	* generic/tcl.h:	Bump version number to 8.5.6b1 to distinguish
	* library/init.tcl:	CVS development snapshots from the 8.5.5 and
	* unix/configure.in:	8.5.6 releases.
	* unix/tcl.spec:
	* win/configure.in:
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
2008-10-24  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* library/http/http.tcl: Backported a fix for reading HTTP-like protocols
	that used to work and were broken with http 2.7. Now http 2.7.2

2008-10-23  Don Porter	<dgp@users.sourceforge.net>

	* generic/tcl.h:	Bump version number to 8.5.6b1 to distinguish
	* library/init.tcl:	CVS development snapshots from the 8.5.5 and
	* unix/configure.in:	8.5.6 releases.
	* unix/tcl.spec:
	* win/configure.in:
Changes to library/http/http.tcl.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
# 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.
#
# 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.67.2.4 2008/08/11 21:57:14 dgp 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.1

namespace eval http {
    # Allow resourcing to not clobber existing data

    variable http
    if {![info exists http]} {
	array set http {










|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
# 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.
#
# 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.67.2.5 2008/10/23 23:34:32 patthoyts 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

namespace eval http {
    # Allow resourcing to not clobber existing data

    variable http
    if {![info exists http]} {
	array set http {
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
	-validate	0
	-headers	{}
	-timeout	0
	-type		application/x-www-form-urlencoded
	-queryprogress	{}
	-protocol	1.1
	binary		0
	state		header
	meta		{}
	coding		{}
	currentsize	0
	totalsize	0
	querylength	0
	queryoffset	0
	type		text/html







|







315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
	-validate	0
	-headers	{}
	-timeout	0
	-type		application/x-www-form-urlencoded
	-queryprogress	{}
	-protocol	1.1
	binary		0
	state		connecting
	meta		{}
	coding		{}
	currentsize	0
	totalsize	0
	querylength	0
	queryoffset	0
	type		text/html
938
939
940
941
942
943
944
945





946
947
948
949
950
951
952
	    if {[string length [set d [read $sock]]] != 0} {
		Log "WARNING: additional data left on closed socket"
	    }
	}
	CloseSocket $sock
	return
    }
    if {$state(state) eq "header"} {





	if {[catch {gets $sock line} n]} {
	    return [Finish $token $n]
	} 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 }








|
>
>
>
>
>







938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
	    if {[string length [set d [read $sock]]] != 0} {
		Log "WARNING: additional data left on closed socket"
	    }
	}
	CloseSocket $sock
	return
    }
    if {$state(state) eq "connecting"} {
	set state(state) "header"
	if {[catch {gets $sock state(http)} n]} {
	    return [Finish $token $n]
	}
    } elseif {$state(state) eq "header"} {
	if {[catch {gets $sock line} n]} {
	    return [Finish $token $n]
	} 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 }

981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
	    }
	    if {$state(binary) || [string match *gzip* $state(coding)]
		|| [string match *compress* $state(coding)]} {
		if {[info exists state(-channel)]} {
		    fconfigure $state(-channel) -translation binary
		}
	    }
	    if {[info exists state(-channel)] &&
		![info exists state(-handler)]} {
		# Initiate a sequence of background fcopies
		fileevent $sock readable {}
		CopyStart $sock $token
		return
	    }
	} elseif {$n > 0} {







|







986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
	    }
	    if {$state(binary) || [string match *gzip* $state(coding)]
		|| [string match *compress* $state(coding)]} {
		if {[info exists state(-channel)]} {
		    fconfigure $state(-channel) -translation binary
		}
	    }
	    if {[info exists state(-channel)] && 
		![info exists state(-handler)]} {
		# Initiate a sequence of background fcopies
		fileevent $sock readable {}
		CopyStart $sock $token
		return
	    }
	} elseif {$n > 0} {
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
		    proxy-connection -
		    connection {
			set state(connection) \
			    [string trim [string tolower $value]]
		    }
		}
		lappend state(meta) $key [string trim $value]
	    } elseif {[string match HTTP* $line]} {
		set state(http) $line
	    }
	}
    } else {
	# Now reading body
	if {[catch {
	    if {[info exists state(-handler)]} {
		set n [eval $state(-handler) [list $sock $token]]







<
<







1020
1021
1022
1023
1024
1025
1026


1027
1028
1029
1030
1031
1032
1033
		    proxy-connection -
		    connection {
			set state(connection) \
			    [string trim [string tolower $value]]
		    }
		}
		lappend state(meta) $key [string trim $value]


	    }
	}
    } else {
	# Now reading body
	if {[catch {
	    if {[info exists state(-handler)]} {
		set n [eval $state(-handler) [list $sock $token]]
Changes to library/http/pkgIndex.tcl.
1
2
3
4
# Tcl package index file, version 1.1

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded http 2.7.1 [list tclPkgSetup $dir http 2.7.1 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]



|
1
2
3
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}}}]
Changes to unix/Makefile.in.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
#
# This file is a Makefile for Tcl. If it has the name "Makefile.in" then it is
# a template for a Makefile; to generate the actual Makefile, run
# "./configure", which is a configuration script generated by the "autoconf"
# program (constructs like "@foo@" will get replaced in the actual Makefile.
#
# RCS: @(#) $Id: Makefile.in,v 1.229.2.8 2008/08/13 23:07:16 das Exp $

VERSION 		= @TCL_VERSION@
MAJOR_VERSION		= @TCL_MAJOR_VERSION@
MINOR_VERSION		= @TCL_MINOR_VERSION@
PATCH_LEVEL		= @TCL_PATCH_LEVEL@

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






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
#
# This file is a Makefile for Tcl. If it has the name "Makefile.in" then it is
# a template for a Makefile; to generate the actual Makefile, run
# "./configure", which is a configuration script generated by the "autoconf"
# program (constructs like "@foo@" will get replaced in the actual Makefile.
#
# RCS: @(#) $Id: Makefile.in,v 1.229.2.9 2008/10/23 23:34:32 patthoyts Exp $

VERSION 		= @TCL_VERSION@
MAJOR_VERSION		= @TCL_MAJOR_VERSION@
MINOR_VERSION		= @TCL_MINOR_VERSION@
PATCH_LEVEL		= @TCL_PATCH_LEVEL@

#--------------------------------------------------------------------------
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing library http1.0 directory";
	@for i in $(TOP_DIR)/library/http1.0/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
	    done;
	@echo "Installing package http 2.7.1 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.1.tm;
	@echo "Installing library opt0.4 directory";
	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.4.2 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.2.tm;







|
|







778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing library http1.0 directory";
	@for i in $(TOP_DIR)/library/http1.0/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
	    done;
	@echo "Installing package http 2.7.2 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.2.tm;
	@echo "Installing library opt0.4 directory";
	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.4.2 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.2.tm;
Changes to win/Makefile.in.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
#
# This file is a Makefile for Tcl.  If it has the name "Makefile.in" then it
# is a template for a Makefile; to generate the actual Makefile, run
# "./configure", which is a configuration script generated by the "autoconf"
# program (constructs like "@foo@" will get replaced in the actual Makefile.
#
# RCS: @(#) $Id: Makefile.in,v 1.124.2.4 2008/08/11 21:57:17 dgp Exp $

VERSION = @TCL_VERSION@

#--------------------------------------------------------------------------
# Things you can change to personalize the Makefile for your own site (you can
# make these changes in either Makefile.in or Makefile, but changes to
# Makefile will get lost if you re-run the configuration script).






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
#
# This file is a Makefile for Tcl.  If it has the name "Makefile.in" then it
# is a template for a Makefile; to generate the actual Makefile, run
# "./configure", which is a configuration script generated by the "autoconf"
# program (constructs like "@foo@" will get replaced in the actual Makefile.
#
# RCS: @(#) $Id: Makefile.in,v 1.124.2.5 2008/10/23 23:34:32 patthoyts Exp $

VERSION = @TCL_VERSION@

#--------------------------------------------------------------------------
# Things you can change to personalize the Makefile for your own site (you can
# make these changes in either Makefile.in or Makefile, but changes to
# Makefile will get lost if you re-run the configuration script).
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
	    $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing library http1.0 directory";
	@for j in $(ROOT_DIR)/library/http1.0/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
	    done;
	@echo "Installing package http 2.7.1 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.1.tm;
	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.4.2 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.2.tm;







|
|







631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
	    $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing library http1.0 directory";
	@for j in $(ROOT_DIR)/library/http1.0/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
	    done;
	@echo "Installing package http 2.7.2 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.2.tm;
	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.4.2 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.2.tm;