Check-in [2312006602]
Not logged in
Home Timeline Branches Tags Tickets Wiki Login

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

Overview
Comment:Fix [3eb2ec1449]: Allow upper case scheme names in url. http -> 2.7.13
Timelines: family | ancestors | descendants | both | core-8-5-branch
Files: files | file ages | folders
SHA1: 2312006602df88a45713fba7cb7a4b358686fed3
User & Date: jan.nijtmans 2013-10-25 12:57:19.162
Context
2013-10-28
10:55
Bump tcltest version to 2.3.6 (should have been done just before the 8.5.15 release, just as in Tcl ... check-in: a803608ed5 user: jan.nijtmans tags: core-8-5-branch
2013-10-25
13:08
Fix [3eb2ec1449]: Allow upper case scheme names in url. http -> 2.8.8 check-in: 9294544d51 user: jan.nijtmans tags: trunk
12:57
Fix [3eb2ec1449]: Allow upper case scheme names in url. http -> 2.7.13 check-in: 2312006602 user: jan.nijtmans tags: core-8-5-branch
2013-10-22
18:55
[3556215]: Made [scan] match [format] better in what it accepts as a format string, by allowing uppe... check-in: e077937cf0 user: dkf tags: core-8-5-branch
Changes
Unified Diff Ignore Whitespace Patch
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

# 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.

package require Tcl 8.4
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.7.12

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

# 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.

package require Tcl 8.4
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.7.13

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

    variable http
    if {![info exists http]} {
	array set http {
︙︙
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123

124
125
126
127
128
129
130
131
132
133
134
135

#     port	Default port for protocol
#     command	Command to use to create socket
# Results:
#     list of port and command that was registered.

proc http::register {proto port command} {
    variable urlTypes
    set urlTypes($proto) [list $port $command]
}

# http::unregister --
#
#     Unregisters URL protocol handler
#
# Arguments:
#     proto	URL protocol prefix, e.g. https
# Results:
#     list of port and command that was unregistered.

proc http::unregister {proto} {
    variable urlTypes

    if {![info exists urlTypes($proto)]} {
	return -code error "unsupported url type \"$proto\""
    }
    set old $urlTypes($proto)
    unset urlTypes($proto)
    return $old
}

# http::config --
#
#	See documentation for details.
#








|













>
|


|
|








103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136

#     port	Default port for protocol
#     command	Command to use to create socket
# Results:
#     list of port and command that was registered.

proc http::register {proto port command} {
    variable urlTypes
    set urlTypes([string tolower $proto]) [list $port $command]
}

# http::unregister --
#
#     Unregisters URL protocol handler
#
# Arguments:
#     proto	URL protocol prefix, e.g. https
# Results:
#     list of port and command that was unregistered.

proc http::unregister {proto} {
    variable urlTypes
    set lower [string tolower $proto]
    if {![info exists urlTypes($lower)]} {
	return -code error "unsupported url type \"$proto\""
    }
    set old $urlTypes($lower)
    unset urlTypes($lower)
    return $old
}

# http::config --
#
#	See documentation for details.
#
︙︙
501
502
503
504
505
506
507

508
509
510
511
512
513
514
515
516
517
518
519
520

	}
    } else {
	set srvurl /
    }
    if {$proto eq ""} {
	set proto http
    }

    if {![info exists urlTypes($proto)]} {
	unset $token
	return -code error "Unsupported URL type \"$proto\""
    }
    set defport [lindex $urlTypes($proto) 0]
    set defcmd [lindex $urlTypes($proto) 1]

    if {$port eq ""} {
	set port $defport
    }
    if {![catch {$http(-proxyfilter) $host} proxy]} {
	set phost [lindex $proxy 0]
	set pport [lindex $proxy 1]








>
|



|
|








502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522

	}
    } else {
	set srvurl /
    }
    if {$proto eq ""} {
	set proto http
    }
    set lower [string tolower $proto]
    if {![info exists urlTypes($lower)]} {
	unset $token
	return -code error "Unsupported URL type \"$proto\""
    }
    set defport [lindex $urlTypes($lower) 0]
    set defcmd [lindex $urlTypes($lower) 1]

    if {$port eq ""} {
	set port $defport
    }
    if {![catch {$http(-proxyfilter) $host} proxy]} {
	set phost [lindex $proxy 0]
	set pport [lindex $proxy 1]
︙︙
637
638
639
640
641
642
643

644
645
646
647
648
649
650
651

    # Set back the variables needed here
    set sock $state(sock)
    set isQueryChannel [info exists state(-querychannel)]
    set isQuery [info exists state(-query)]
    set host [lindex [split $state(socketinfo) :] 0]
    set port [lindex [split $state(socketinfo) :] 1]


    set defport [lindex $urlTypes($proto) 0]

    # Send data in cr-lf format, but accept any line terminators

    fconfigure $sock -translation {auto crlf} -buffersize $state(-blocksize)

    # The following is disallowed in safe interpreters, but the socket is
    # already in non-blocking mode in that case.








>
|








639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654

    # Set back the variables needed here
    set sock $state(sock)
    set isQueryChannel [info exists state(-querychannel)]
    set isQuery [info exists state(-query)]
    set host [lindex [split $state(socketinfo) :] 0]
    set port [lindex [split $state(socketinfo) :] 1]

    set lower [string tolower $proto]
    set defport [lindex $urlTypes($lower) 0]

    # Send data in cr-lf format, but accept any line terminators

    fconfigure $sock -translation {auto crlf} -buffersize $state(-blocksize)

    # The following is disallowed in safe interpreters, but the socket is
    # already in non-blocking mode in that case.
︙︙
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.12 [list tclPkgSetup $dir http 2.7.12 {{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.13 [list tclPkgSetup $dir http 2.7.13 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
Changes to tests/http.test.
︙︙
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140

    list [catch {http::geturl -bogus flag} msg] $msg
} {1 {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -keepalive, -method, -myaddr, -progress, -protocol, -query, -queryblocksize, -querychannel, -queryprogress, -strict, -timeout, -type, -validate}}
test http-3.2 {http::geturl} {
    catch {http::geturl http:junk} err
    set err
} {Unsupported URL: http:junk}
set url //[info hostname]:$port
set badurl //[info hostname]:6666
test http-3.3 {http::geturl} {
    set token [http::geturl $url]
    http::data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET /</h2>
</body></html>"
set tail /a/b/c
set url //[info hostname]:$port/a/b/c
set fullurl http://user:pass@[info hostname]:$port/a/b/c
set binurl //[info hostname]:$port/binary
set posturl //[info hostname]:$port/post
set badposturl //[info hostname]:$port/droppost
set authorityurl //[info hostname]:$port
test http-3.4 {http::geturl} {
    set token [http::geturl $url]
    http::data $token








|









|








116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140

    list [catch {http::geturl -bogus flag} msg] $msg
} {1 {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -keepalive, -method, -myaddr, -progress, -protocol, -query, -queryblocksize, -querychannel, -queryprogress, -strict, -timeout, -type, -validate}}
test http-3.2 {http::geturl} {
    catch {http::geturl http:junk} err
    set err
} {Unsupported URL: http:junk}
set url //[info hostname]:$port
set badurl //[info hostname]:[expr $port+1]
test http-3.3 {http::geturl} {
    set token [http::geturl $url]
    http::data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET /</h2>
</body></html>"
set tail /a/b/c
set url //[info hostname]:$port/a/b/c
set fullurl HTTP://user:pass@[info hostname]:$port/a/b/c
set binurl //[info hostname]:$port/binary
set posturl //[info hostname]:$port/post
set badposturl //[info hostname]:$port/droppost
set authorityurl //[info hostname]:$port
test http-3.4 {http::geturl} {
    set token [http::geturl $url]
    http::data $token
︙︙
Changes to unix/Makefile.in.
︙︙
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777

	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing package http1.0 files to $(SCRIPT_INSTALL_DIR)/http1.0/";
	@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.12 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.12.tm;
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.5.2 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.5.2.tm;








|
|








762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777

	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing package http1.0 files to $(SCRIPT_INSTALL_DIR)/http1.0/";
	@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.13 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.13.tm;
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.5.2 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.5.2.tm;
︙︙
Changes to win/Makefile.in.
︙︙
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653

	    $(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.12 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.12.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.5.2 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.2.tm;








|
|








638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653

	    $(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.13 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.13.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.5.2 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.2.tm;
︙︙
This page was created in about 0.026s by Fossil version [1205ec86cb] 2025-04-30 16:57:32