Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch tip-493
Excluding Merge-Ins
This is equivalent to a diff from
a9598976f4
to 313ece0560
2018-02-06
| | |
19:55 |
|
check-in: a1a80c75c0 user: dgp tags: core-8-branch
|
2018-01-04
| | |
12:58 |
|
check-in: be96f22ee4 user: jan.nijtmans tags: core-8-5-branch
|
02:32 |
|
check-in: e2d0c521d8 user: dgp tags: core-8-branch
|
2018-01-03
| | |
15:11 |
|
check-in: b2b20de662 user: dgp tags: pyk-TclOO
|
2018-01-02
| | |
22:03 |
|
check-in: 95150a1466 user: pspjuth tags: tip-351
|
2017-12-29
| | |
17:47 |
|
Closed-Leaf
check-in: 313ece0560 user: dgp tags: tip-493
|
17:38 |
|
check-in: 235847a1a8 user: dgp tags: tip-493
|
16:49 |
|
check-in: c9233c5f0d user: dgp tags: tip-493
|
16:16 |
|
check-in: 20d3928f5c user: dgp tags: tip-445
|
15:13 |
|
check-in: cf43d89150 user: hypnotoad tags: core_zip_vfs
|
2017-12-28
| | |
23:54 |
|
check-in: 30abcdf459 user: pspjuth tags: pspjuth-lrangeopt
|
21:17 |
|
check-in: 92e15a4e78 user: jan.nijtmans tags: tip-389
|
21:15 |
|
check-in: a9598976f4 user: jan.nijtmans tags: core-8-branch
|
21:14 |
|
check-in: b4b65e69b8 user: jan.nijtmans tags: core-8-6-branch
|
18:51 |
|
check-in: e7cb6182f1 user: jan.nijtmans tags: core-8-branch
|
| | |
Deleted library/http1.0/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
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
|
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
# 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 http.n man page for documentation
package provide http 1.0
array set http {
-accept */*
-proxyhost {}
-proxyport {}
-useragent {Tcl http client package 1.0}
-proxyfilter httpProxyRequired
}
proc http_config {args} {
global http
set options [lsort [array names http -*]]
set usage [join $options ", "]
if {[llength $args] == 0} {
set result {}
foreach name $options {
lappend result $name $http($name)
}
return $result
}
regsub -all -- - $options {} options
set pat ^-([join $options |])$
if {[llength $args] == 1} {
set flag [lindex $args 0]
if {[regexp -- $pat $flag]} {
return $http($flag)
} else {
return -code error "Unknown option $flag, must be: $usage"
}
} else {
foreach {flag value} $args {
if {[regexp -- $pat $flag]} {
set http($flag) $value
} else {
return -code error "Unknown option $flag, must be: $usage"
}
}
}
}
proc httpFinish { token {errormsg ""} } {
upvar #0 $token state
global errorInfo errorCode
if {[string length $errormsg] != 0} {
set state(error) [list $errormsg $errorInfo $errorCode]
set state(status) error
}
catch {close $state(sock)}
catch {after cancel $state(after)}
if {[info exists state(-command)]} {
if {[catch {eval $state(-command) {$token}} err]} {
if {[string length $errormsg] == 0} {
set state(error) [list $err $errorInfo $errorCode]
set state(status) error
}
}
unset state(-command)
}
}
proc http_reset { token {why reset} } {
upvar #0 $token state
set state(status) $why
catch {fileevent $state(sock) readable {}}
httpFinish $token
if {[info exists state(error)]} {
set errorlist $state(error)
unset state(error)
eval error $errorlist
}
}
proc http_get { url args } {
global http
if {![info exists http(uid)]} {
set http(uid) 0
}
set token http#[incr http(uid)]
upvar #0 $token state
http_reset $token
array set state {
-blocksize 8192
-validate 0
-headers {}
-timeout 0
state header
meta {}
currentsize 0
totalsize 0
type text/html
body {}
status ""
}
set options {-blocksize -channel -command -handler -headers \
-progress -query -validate -timeout}
set usage [join $options ", "]
regsub -all -- - $options {} options
set pat ^-([join $options |])$
foreach {flag value} $args {
if {[regexp $pat $flag]} {
# Validate numbers
if {[info exists state($flag)] && \
[regexp {^[0-9]+$} $state($flag)] && \
![regexp {^[0-9]+$} $value]} {
return -code error "Bad value for $flag ($value), must be integer"
}
set state($flag) $value
} else {
return -code error "Unknown option $flag, can be: $usage"
}
}
if {! [regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \
x proto host y port srvurl]} {
error "Unsupported URL: $url"
}
if {[string length $port] == 0} {
set port 80
}
if {[string length $srvurl] == 0} {
set srvurl /
}
if {[string length $proto] == 0} {
set url http://$url
}
set state(url) $url
if {![catch {$http(-proxyfilter) $host} proxy]} {
set phost [lindex $proxy 0]
set pport [lindex $proxy 1]
}
if {$state(-timeout) > 0} {
set state(after) [after $state(-timeout) [list http_reset $token timeout]]
}
if {[info exists phost] && [string length $phost]} {
set srvurl $url
set s [socket $phost $pport]
} else {
set s [socket $host $port]
}
set state(sock) $s
# Send data in cr-lf format, but accept any line terminators
fconfigure $s -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.
catch {fconfigure $s -blocking off}
set len 0
set how GET
if {[info exists state(-query)]} {
set len [string length $state(-query)]
if {$len > 0} {
set how POST
}
} elseif {$state(-validate)} {
set how HEAD
}
puts $s "$how $srvurl HTTP/1.0"
puts $s "Accept: $http(-accept)"
puts $s "Host: $host"
puts $s "User-Agent: $http(-useragent)"
foreach {key value} $state(-headers) {
regsub -all \[\n\r\] $value {} value
set key [string trim $key]
if {[string length $key]} {
puts $s "$key: $value"
}
}
if {$len > 0} {
puts $s "Content-Length: $len"
puts $s "Content-Type: application/x-www-form-urlencoded"
puts $s ""
fconfigure $s -translation {auto binary}
puts -nonewline $s $state(-query)
} else {
puts $s ""
}
flush $s
fileevent $s readable [list httpEvent $token]
if {! [info exists state(-command)]} {
http_wait $token
}
return $token
}
proc http_data {token} {
upvar #0 $token state
return $state(body)
}
proc http_status {token} {
upvar #0 $token state
return $state(status)
}
proc http_code {token} {
upvar #0 $token state
return $state(http)
}
proc http_size {token} {
upvar #0 $token state
return $state(currentsize)
}
proc httpEvent {token} {
upvar #0 $token state
set s $state(sock)
if {[eof $s]} {
httpEof $token
return
}
if {$state(state) == "header"} {
set n [gets $s line]
if {$n == 0} {
set state(state) body
if {![regexp -nocase ^text $state(type)]} {
# Turn off conversions for non-text data
fconfigure $s -translation binary
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 $s readable {}
httpCopyStart $s $token
}
} elseif {$n > 0} {
if {[regexp -nocase {^content-type:(.+)$} $line x type]} {
set state(type) [string trim $type]
}
if {[regexp -nocase {^content-length:(.+)$} $line x length]} {
set state(totalsize) [string trim $length]
}
if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
lappend state(meta) $key $value
} elseif {[regexp ^HTTP $line]} {
set state(http) $line
}
}
} else {
if {[catch {
if {[info exists state(-handler)]} {
set n [eval $state(-handler) {$s $token}]
} else {
set block [read $s $state(-blocksize)]
set n [string length $block]
if {$n >= 0} {
append state(body) $block
}
}
if {$n >= 0} {
incr state(currentsize) $n
}
} err]} {
httpFinish $token $err
} else {
if {[info exists state(-progress)]} {
eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
}
}
}
}
proc httpCopyStart {s token} {
upvar #0 $token state
if {[catch {
fcopy $s $state(-channel) -size $state(-blocksize) -command \
[list httpCopyDone $token]
} err]} {
httpFinish $token $err
}
}
proc httpCopyDone {token count {error {}}} {
upvar #0 $token state
set s $state(sock)
incr state(currentsize) $count
if {[info exists state(-progress)]} {
eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
}
if {([string length $error] != 0)} {
httpFinish $token $error
} elseif {[eof $s]} {
httpEof $token
} else {
httpCopyStart $s $token
}
}
proc httpEof {token} {
upvar #0 $token state
if {$state(state) == "header"} {
# Premature eof
set state(status) eof
} else {
set state(status) ok
}
set state(state) eof
httpFinish $token
}
proc http_wait {token} {
upvar #0 $token state
if {![info exists state(status)] || [string length $state(status)] == 0} {
vwait $token\(status)
}
if {[info exists state(error)]} {
set errorlist $state(error)
unset state(error)
eval error $errorlist
}
return $state(status)
}
# Call http_formatQuery with an even number of arguments, where the first is
# a name, the second is a value, the third is another name, and so on.
proc http_formatQuery {args} {
set result ""
set sep ""
foreach i $args {
append result $sep [httpMapReply $i]
if {$sep != "="} {
set sep =
} else {
set sep &
}
}
return $result
}
# do x-www-urlencoded character mapping
# The spec says: "non-alphanumeric characters are replaced by '%HH'"
# 1 leave alphanumerics characters alone
# 2 Convert every other character to an array lookup
# 3 Escape constructs that are "special" to the tcl parser
# 4 "subst" the result, doing all the array substitutions
proc httpMapReply {string} {
global httpFormMap
set alphanumeric a-zA-Z0-9
if {![info exists httpFormMap]} {
for {set i 1} {$i <= 256} {incr i} {
set c [format %c $i]
if {![string match \[$alphanumeric\] $c]} {
set httpFormMap($c) %[format %.2x $i]
}
}
# These are handled specially
array set httpFormMap {
" " + \n %0d%0a
}
}
regsub -all \[^$alphanumeric\] $string {$httpFormMap(&)} string
regsub -all \n $string {\\n} string
regsub -all \t $string {\\t} string
regsub -all {[][{})\\]\)} $string {\\&} string
return [subst $string]
}
# Default proxy filter.
proc httpProxyRequired {host} {
global http
if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {
if {![info exists http(-proxyport)] || ![string length $http(-proxyport)]} {
set http(-proxyport) 8080
}
return [list $http(-proxyhost) $http(-proxyport)]
} else {
return {}
}
}
|
Deleted library/http1.0/pkgIndex.tcl.
1
2
3
4
5
6
7
8
9
10
11
|
|
-
-
-
-
-
-
-
-
-
-
-
|
# Tcl package index file, version 1.0
# 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 http 1.0 [list tclPkgSetup $dir http 1.0 {{http.tcl source {httpCopyDone httpCopyStart httpEof httpEvent httpFinish httpMapReply httpProxyRequired http_code http_config http_data http_formatQuery http_get http_reset http_size http_status http_wait}}}]
|
Deleted tests/httpold.test.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
|
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
# -*- tcl -*-
# Commands covered: http_config, http_get, http_wait, http_reset
#
# This file contains a collection of tests for the http script library.
# Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
if {[catch {package require http 1.0}]} {
if {[info exists httpold]} {
catch {puts "Cannot load http 1.0 package"}
::tcltest::cleanupTests
return
} else {
catch {puts "Running http 1.0 tests in slave interp"}
set interp [interp create httpold]
$interp eval [list set httpold "running"]
$interp eval [list set argv $argv]
$interp eval [list source [info script]]
interp delete $interp
::tcltest::cleanupTests
return
}
}
if {$::tcl_platform(os) eq "Darwin"} {
# Name resolution often a problem on OSX; not focus of HTTP package anyway
set HOST localhost
} else {
set HOST [info hostname]
}
set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
catch {unset data}
##
## The httpd script implement a stub http server
##
source [file join [file dirname [info script]] httpd]
if [catch {httpd_init 0} listen] {
puts "Cannot start http server, http test skipped"
catch {unset port}
::tcltest::cleanupTests
return
}
test httpold-1.1 {http_config} {
http_config
} {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}}
test httpold-1.2 {http_config} {
http_config -proxyfilter
} httpProxyRequired
test httpold-1.3 {http_config} {
catch {http_config -junk}
} 1
test httpold-1.4 {http_config} {
http_config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite"
set x [http_config]
http_config -proxyhost {} -proxyport {} -proxyfilter httpProxyRequired \
-useragent "Tcl http client package 1.0"
set x
} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}}
test httpold-1.5 {http_config} {
catch {http_config -proxyhost {} -junk 8080}
} 1
test httpold-2.1 {http_reset} {
catch {http_reset http#1}
} 0
test httpold-3.1 {http_get} {
catch {http_get -bogus flag}
} 1
test httpold-3.2 {http_get} {
catch {http_get http:junk} err
set err
} {Unsupported URL: http:junk}
set url ${::HOST}:$port
test httpold-3.3 {http_get} {
set token [http_get $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 ${::HOST}:$port/a/b/c
set binurl ${::HOST}:$port/binary
test httpold-3.4 {http_get} {
set token [http_get $url]
http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"
proc selfproxy {host} {
global port
return [list ${::HOST} $port]
}
test httpold-3.5 {http_get} {
http_config -proxyfilter selfproxy
set token [http_get $url]
http_config -proxyfilter httpProxyRequired
http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET http://$url</h2>
</body></html>"
test httpold-3.6 {http_get} {
http_config -proxyfilter bogus
set token [http_get $url]
http_config -proxyfilter httpProxyRequired
http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"
test httpold-3.7 {http_get} {
set token [http_get $url -headers {Pragma no-cache}]
http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"
test httpold-3.8 {http_get} {
set token [http_get $url -query Name=Value&Foo=Bar]
http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>POST $tail</h2>
<h2>Query</h2>
<dl>
<dt>Name<dd>Value
<dt>Foo<dd>Bar
</dl>
</body></html>"
test httpold-3.9 {http_get} {
set token [http_get $url -validate 1]
http_code $token
} "HTTP/1.0 200 OK"
test httpold-4.1 {httpEvent} {
set token [http_get $url]
upvar #0 $token data
array set meta $data(meta)
expr ($data(totalsize) == $meta(Content-Length))
} 1
test httpold-4.2 {httpEvent} {
set token [http_get $url]
upvar #0 $token data
array set meta $data(meta)
string compare $data(type) [string trim $meta(Content-Type)]
} 0
test httpold-4.3 {httpEvent} {
set token [http_get $url]
http_code $token
} {HTTP/1.0 200 Data follows}
test httpold-4.4 {httpEvent} {
set testfile [makeFile "" testfile]
set out [open $testfile w]
set token [http_get $url -channel $out]
close $out
set in [open $testfile]
set x [read $in]
close $in
removeFile $testfile
set x
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"
test httpold-4.5 {httpEvent} {
set testfile [makeFile "" testfile]
set out [open $testfile w]
set token [http_get $url -channel $out]
close $out
upvar #0 $token data
removeFile $testfile
expr $data(currentsize) == $data(totalsize)
} 1
test httpold-4.6 {httpEvent} {
set testfile [makeFile "" testfile]
set out [open $testfile w]
set token [http_get $binurl -channel $out]
close $out
set in [open $testfile]
fconfigure $in -translation binary
set x [read $in]
close $in
removeFile $testfile
set x
} "$bindata$binurl"
proc myProgress {token total current} {
global progress httpLog
if {[info exists httpLog] && $httpLog} {
puts "progress $total $current"
}
set progress [list $total $current]
}
if 0 {
# This test hangs on Windows95 because the client never gets EOF
set httpLog 1
test httpold-4.6 {httpEvent} {
set token [http_get $url -blocksize 50 -progress myProgress]
set progress
} {111 111}
}
test httpold-4.7 {httpEvent} {
set token [http_get $url -progress myProgress]
set progress
} {111 111}
test httpold-4.8 {httpEvent} {
set token [http_get $url]
http_status $token
} {ok}
test httpold-4.9 {httpEvent} {
set token [http_get $url -progress myProgress]
http_code $token
} {HTTP/1.0 200 Data follows}
test httpold-4.10 {httpEvent} {
set token [http_get $url -progress myProgress]
http_size $token
} {111}
test httpold-4.11 {httpEvent} {
set token [http_get $url -timeout 1 -command {#}]
http_reset $token
http_status $token
} {reset}
test httpold-4.12 {httpEvent} {
update
set x {}
after 500 {lappend x ok}
set token [http_get $url -timeout 1 -command {lappend x fail}]
vwait x
list [http_status $token] $x
} {timeout ok}
test httpold-5.1 {http_formatQuery} {
http_formatQuery name1 value1 name2 "value two"
} {name1=value1&name2=value+two}
test httpold-5.2 {http_formatQuery} {
http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
} {name1=%7ebwelch&name2=%a1%a2%a2}
test httpold-5.3 {http_formatQuery} {
http_formatQuery lines "line1\nline2\nline3"
} {lines=line1%0d%0aline2%0d%0aline3}
test httpold-6.1 {httpProxyRequired} {
update
http_config -proxyhost ${::HOST} -proxyport $port
set token [http_get $url]
http_wait $token
http_config -proxyhost {} -proxyport {}
upvar #0 $token data
set data(body)
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET http://$url</h2>
</body></html>"
# cleanup
catch {unset url}
catch {unset port}
catch {unset data}
close $listen
::tcltest::cleanupTests
return
|
Changes to tests/safe.test.
︙ | | |
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
|
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
|
-
+
-
+
-
+
-
+
|
lsort $r
} {byteOrder engine pathSeparator platform pointerSize wordSize}
# More test should be added to check that hostname, nameofexecutable, aren't
# leaking infos, but they still do...
# high level general test
test safe-7.1 {tests that everything works at high level} {
test safe-7.1 {tests that everything works at high level} -body {
set i [safe::interpCreate]
# no error shall occur:
# (because the default access_path shall include 1st level sub dirs so
# package require in a slave works like in the master)
set v [interp eval $i {package require http 1}]
set v [interp eval $i {package require http 2}]
# no error shall occur:
interp eval $i {http_config}
interp eval $i {http::config}
safe::interpDelete $i
set v
} 1.0
} -match glob -result 2.*
test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -body {
set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
# should not add anything (p0)
set token1 [safe::interpAddToAccessPath $i [info library]]
# should add as p1
set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"]
# an error shall occur (http is not anymore in the secure 0-level
|
︙ | | |
Changes to unix/Makefile.in.
︙ | | |
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
|
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
|
-
+
-
-
-
-
-
|
do \
if [ ! -d "$$i" ] ; then \
echo "Making directory $$i"; \
$(INSTALL_DATA_DIR) "$$i"; \
else true; \
fi; \
done;
@for i in opt0.4 http1.0 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
@for i in opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
do \
if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \
echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \
else true; \
fi; \
done;
@echo "Installing library files to $(SCRIPT_INSTALL_DIR)/";
@for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex \
$(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@; \
do \
$(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.8.12 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.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;
|
︙ | | |
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
|
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
|
-
+
|
cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README \
$(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \
$(DISTDIR)
@mkdir $(DISTDIR)/library
cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
for i in http1.0 http opt msgcat reg dde tcltest platform; \
for i in http opt msgcat reg dde tcltest platform; \
do \
mkdir $(DISTDIR)/library/$$i ;\
cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
done;
@mkdir $(DISTDIR)/library/encoding
cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding
@mkdir $(DISTDIR)/library/msgs
|
︙ | | |
Changes to win/Makefile.in.
︙ | | |
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
|
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
|
-
+
|
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
$(MKDIR) $$i; \
else true; \
fi; \
done;
@for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
@for i in opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
do \
if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
$(MKDIR) $(SCRIPT_INSTALL_DIR)/$$i; \
else true; \
fi; \
done;
|
︙ | | |
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
|
648
649
650
651
652
653
654
655
656
657
658
659
660
661
|
-
-
-
-
-
|
$(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \
done;
@echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
@for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \
do \
$(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.8.12 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.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;
|
︙ | | |
Changes to win/makefile.vc.
︙ | | |
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
|
856
857
858
859
860
861
862
863
864
865
866
867
868
869
|
-
-
-
|
@$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\"
@$(CPY) "$(OUT_DIR)\tclConfig.sh" "$(LIB_INSTALL_DIR)\"
@$(CPY) "$(WINDIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)\"
@$(CPY) "$(WINDIR)\rules.vc" "$(LIB_INSTALL_DIR)\nmake\"
@$(CPY) "$(WINDIR)\targets.vc" "$(LIB_INSTALL_DIR)\nmake\"
@$(CPY) "$(WINDIR)\nmakehlp.c" "$(LIB_INSTALL_DIR)\nmake\"
@$(CPY) "$(OUT_DIR)\tcl.nmake" "$(LIB_INSTALL_DIR)\nmake\"
@echo Installing library http1.0 directory
@$(CPY) "$(ROOT)\library\http1.0\*.tcl" \
"$(SCRIPT_INSTALL_DIR)\http1.0\"
@echo Installing library opt0.4 directory
@$(CPY) "$(ROOT)\library\opt\*.tcl" \
"$(SCRIPT_INSTALL_DIR)\opt0.4\"
@echo Installing package http $(PKG_HTTP_VER) as a Tcl Module
@$(COPY) "$(ROOT)\library\http\http.tcl" \
"$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6\http-$(PKG_HTTP_VER).tm"
@echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module
|
︙ | | |