|
sl@0
|
1 |
# Commands covered: http_config, http_get, http_wait, http_reset
|
|
sl@0
|
2 |
#
|
|
sl@0
|
3 |
# This file contains a collection of tests for the http script library.
|
|
sl@0
|
4 |
# Sourcing this file into Tcl runs the tests and
|
|
sl@0
|
5 |
# generates output for errors. No output means no errors were found.
|
|
sl@0
|
6 |
#
|
|
sl@0
|
7 |
# Copyright (c) 1991-1993 The Regents of the University of California.
|
|
sl@0
|
8 |
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
|
|
sl@0
|
9 |
# Copyright (c) 1998-1999 by Scriptics Corporation.
|
|
sl@0
|
10 |
#
|
|
sl@0
|
11 |
# See the file "license.terms" for information on usage and redistribution
|
|
sl@0
|
12 |
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
sl@0
|
13 |
#
|
|
sl@0
|
14 |
# RCS: @(#) $Id: httpold.test,v 1.11 2002/10/03 13:34:32 dkf Exp $
|
|
sl@0
|
15 |
|
|
sl@0
|
16 |
if {[lsearch [namespace children] ::tcltest] == -1} {
|
|
sl@0
|
17 |
package require tcltest
|
|
sl@0
|
18 |
namespace import -force ::tcltest::*
|
|
sl@0
|
19 |
}
|
|
sl@0
|
20 |
|
|
sl@0
|
21 |
if {[catch {package require http 1.0}]} {
|
|
sl@0
|
22 |
if {[info exists httpold]} {
|
|
sl@0
|
23 |
catch {puts "Cannot load http 1.0 package"}
|
|
sl@0
|
24 |
::tcltest::cleanupTests
|
|
sl@0
|
25 |
return
|
|
sl@0
|
26 |
} else {
|
|
sl@0
|
27 |
catch {puts "Running http 1.0 tests in slave interp"}
|
|
sl@0
|
28 |
set interp [interp create httpold]
|
|
sl@0
|
29 |
$interp eval [list set httpold "running"]
|
|
sl@0
|
30 |
$interp eval [list set argv $argv]
|
|
sl@0
|
31 |
$interp eval [list source [info script]]
|
|
sl@0
|
32 |
interp delete $interp
|
|
sl@0
|
33 |
::tcltest::cleanupTests
|
|
sl@0
|
34 |
return
|
|
sl@0
|
35 |
}
|
|
sl@0
|
36 |
}
|
|
sl@0
|
37 |
|
|
sl@0
|
38 |
set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
|
|
sl@0
|
39 |
catch {unset data}
|
|
sl@0
|
40 |
|
|
sl@0
|
41 |
##
|
|
sl@0
|
42 |
## The httpd script implement a stub http server
|
|
sl@0
|
43 |
##
|
|
sl@0
|
44 |
source [file join [file dirname [info script]] httpd]
|
|
sl@0
|
45 |
|
|
sl@0
|
46 |
set port 8010
|
|
sl@0
|
47 |
if [catch {httpd_init $port} listen] {
|
|
sl@0
|
48 |
puts "Cannot start http server, http test skipped"
|
|
sl@0
|
49 |
unset port
|
|
sl@0
|
50 |
::tcltest::cleanupTests
|
|
sl@0
|
51 |
return
|
|
sl@0
|
52 |
}
|
|
sl@0
|
53 |
|
|
sl@0
|
54 |
test httpold-1.1 {http_config} {
|
|
sl@0
|
55 |
http_config
|
|
sl@0
|
56 |
} {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}}
|
|
sl@0
|
57 |
|
|
sl@0
|
58 |
test httpold-1.2 {http_config} {
|
|
sl@0
|
59 |
http_config -proxyfilter
|
|
sl@0
|
60 |
} httpProxyRequired
|
|
sl@0
|
61 |
|
|
sl@0
|
62 |
test httpold-1.3 {http_config} {
|
|
sl@0
|
63 |
catch {http_config -junk}
|
|
sl@0
|
64 |
} 1
|
|
sl@0
|
65 |
|
|
sl@0
|
66 |
test httpold-1.4 {http_config} {
|
|
sl@0
|
67 |
http_config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite"
|
|
sl@0
|
68 |
set x [http_config]
|
|
sl@0
|
69 |
http_config -proxyhost {} -proxyport {} -proxyfilter httpProxyRequired \
|
|
sl@0
|
70 |
-useragent "Tcl http client package 1.0"
|
|
sl@0
|
71 |
set x
|
|
sl@0
|
72 |
} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}}
|
|
sl@0
|
73 |
|
|
sl@0
|
74 |
test httpold-1.5 {http_config} {
|
|
sl@0
|
75 |
catch {http_config -proxyhost {} -junk 8080}
|
|
sl@0
|
76 |
} 1
|
|
sl@0
|
77 |
|
|
sl@0
|
78 |
test httpold-2.1 {http_reset} {
|
|
sl@0
|
79 |
catch {http_reset http#1}
|
|
sl@0
|
80 |
} 0
|
|
sl@0
|
81 |
|
|
sl@0
|
82 |
test httpold-3.1 {http_get} {
|
|
sl@0
|
83 |
catch {http_get -bogus flag}
|
|
sl@0
|
84 |
} 1
|
|
sl@0
|
85 |
test httpold-3.2 {http_get} {
|
|
sl@0
|
86 |
catch {http_get http:junk} err
|
|
sl@0
|
87 |
set err
|
|
sl@0
|
88 |
} {Unsupported URL: http:junk}
|
|
sl@0
|
89 |
|
|
sl@0
|
90 |
set url [info hostname]:$port
|
|
sl@0
|
91 |
test httpold-3.3 {http_get} {
|
|
sl@0
|
92 |
set token [http_get $url]
|
|
sl@0
|
93 |
http_data $token
|
|
sl@0
|
94 |
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
|
|
sl@0
|
95 |
<h1>Hello, World!</h1>
|
|
sl@0
|
96 |
<h2>GET /</h2>
|
|
sl@0
|
97 |
</body></html>"
|
|
sl@0
|
98 |
|
|
sl@0
|
99 |
set tail /a/b/c
|
|
sl@0
|
100 |
set url [info hostname]:$port/a/b/c
|
|
sl@0
|
101 |
set binurl [info hostname]:$port/binary
|
|
sl@0
|
102 |
|
|
sl@0
|
103 |
test httpold-3.4 {http_get} {
|
|
sl@0
|
104 |
set token [http_get $url]
|
|
sl@0
|
105 |
http_data $token
|
|
sl@0
|
106 |
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
|
|
sl@0
|
107 |
<h1>Hello, World!</h1>
|
|
sl@0
|
108 |
<h2>GET $tail</h2>
|
|
sl@0
|
109 |
</body></html>"
|
|
sl@0
|
110 |
|
|
sl@0
|
111 |
proc selfproxy {host} {
|
|
sl@0
|
112 |
global port
|
|
sl@0
|
113 |
return [list [info hostname] $port]
|
|
sl@0
|
114 |
}
|
|
sl@0
|
115 |
test httpold-3.5 {http_get} {
|
|
sl@0
|
116 |
http_config -proxyfilter selfproxy
|
|
sl@0
|
117 |
set token [http_get $url]
|
|
sl@0
|
118 |
http_config -proxyfilter httpProxyRequired
|
|
sl@0
|
119 |
http_data $token
|
|
sl@0
|
120 |
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
|
|
sl@0
|
121 |
<h1>Hello, World!</h1>
|
|
sl@0
|
122 |
<h2>GET http://$url</h2>
|
|
sl@0
|
123 |
</body></html>"
|
|
sl@0
|
124 |
|
|
sl@0
|
125 |
test httpold-3.6 {http_get} {
|
|
sl@0
|
126 |
http_config -proxyfilter bogus
|
|
sl@0
|
127 |
set token [http_get $url]
|
|
sl@0
|
128 |
http_config -proxyfilter httpProxyRequired
|
|
sl@0
|
129 |
http_data $token
|
|
sl@0
|
130 |
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
|
|
sl@0
|
131 |
<h1>Hello, World!</h1>
|
|
sl@0
|
132 |
<h2>GET $tail</h2>
|
|
sl@0
|
133 |
</body></html>"
|
|
sl@0
|
134 |
|
|
sl@0
|
135 |
test httpold-3.7 {http_get} {
|
|
sl@0
|
136 |
set token [http_get $url -headers {Pragma no-cache}]
|
|
sl@0
|
137 |
http_data $token
|
|
sl@0
|
138 |
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
|
|
sl@0
|
139 |
<h1>Hello, World!</h1>
|
|
sl@0
|
140 |
<h2>GET $tail</h2>
|
|
sl@0
|
141 |
</body></html>"
|
|
sl@0
|
142 |
|
|
sl@0
|
143 |
test httpold-3.8 {http_get} {
|
|
sl@0
|
144 |
set token [http_get $url -query Name=Value&Foo=Bar]
|
|
sl@0
|
145 |
http_data $token
|
|
sl@0
|
146 |
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
|
|
sl@0
|
147 |
<h1>Hello, World!</h1>
|
|
sl@0
|
148 |
<h2>POST $tail</h2>
|
|
sl@0
|
149 |
<h2>Query</h2>
|
|
sl@0
|
150 |
<dl>
|
|
sl@0
|
151 |
<dt>Name<dd>Value
|
|
sl@0
|
152 |
<dt>Foo<dd>Bar
|
|
sl@0
|
153 |
</dl>
|
|
sl@0
|
154 |
</body></html>"
|
|
sl@0
|
155 |
|
|
sl@0
|
156 |
test httpold-3.9 {http_get} {
|
|
sl@0
|
157 |
set token [http_get $url -validate 1]
|
|
sl@0
|
158 |
http_code $token
|
|
sl@0
|
159 |
} "HTTP/1.0 200 OK"
|
|
sl@0
|
160 |
|
|
sl@0
|
161 |
|
|
sl@0
|
162 |
test httpold-4.1 {httpEvent} {
|
|
sl@0
|
163 |
set token [http_get $url]
|
|
sl@0
|
164 |
upvar #0 $token data
|
|
sl@0
|
165 |
array set meta $data(meta)
|
|
sl@0
|
166 |
expr ($data(totalsize) == $meta(Content-Length))
|
|
sl@0
|
167 |
} 1
|
|
sl@0
|
168 |
|
|
sl@0
|
169 |
test httpold-4.2 {httpEvent} {
|
|
sl@0
|
170 |
set token [http_get $url]
|
|
sl@0
|
171 |
upvar #0 $token data
|
|
sl@0
|
172 |
array set meta $data(meta)
|
|
sl@0
|
173 |
string compare $data(type) [string trim $meta(Content-Type)]
|
|
sl@0
|
174 |
} 0
|
|
sl@0
|
175 |
|
|
sl@0
|
176 |
test httpold-4.3 {httpEvent} {
|
|
sl@0
|
177 |
set token [http_get $url]
|
|
sl@0
|
178 |
http_code $token
|
|
sl@0
|
179 |
} {HTTP/1.0 200 Data follows}
|
|
sl@0
|
180 |
|
|
sl@0
|
181 |
test httpold-4.4 {httpEvent} {
|
|
sl@0
|
182 |
set testfile [makeFile "" testfile]
|
|
sl@0
|
183 |
set out [open $testfile w]
|
|
sl@0
|
184 |
set token [http_get $url -channel $out]
|
|
sl@0
|
185 |
close $out
|
|
sl@0
|
186 |
set in [open $testfile]
|
|
sl@0
|
187 |
set x [read $in]
|
|
sl@0
|
188 |
close $in
|
|
sl@0
|
189 |
removeFile $testfile
|
|
sl@0
|
190 |
set x
|
|
sl@0
|
191 |
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
|
|
sl@0
|
192 |
<h1>Hello, World!</h1>
|
|
sl@0
|
193 |
<h2>GET $tail</h2>
|
|
sl@0
|
194 |
</body></html>"
|
|
sl@0
|
195 |
|
|
sl@0
|
196 |
test httpold-4.5 {httpEvent} {
|
|
sl@0
|
197 |
set testfile [makeFile "" testfile]
|
|
sl@0
|
198 |
set out [open $testfile w]
|
|
sl@0
|
199 |
set token [http_get $url -channel $out]
|
|
sl@0
|
200 |
close $out
|
|
sl@0
|
201 |
upvar #0 $token data
|
|
sl@0
|
202 |
removeFile $testfile
|
|
sl@0
|
203 |
expr $data(currentsize) == $data(totalsize)
|
|
sl@0
|
204 |
} 1
|
|
sl@0
|
205 |
|
|
sl@0
|
206 |
test httpold-4.6 {httpEvent} {
|
|
sl@0
|
207 |
set testfile [makeFile "" testfile]
|
|
sl@0
|
208 |
set out [open $testfile w]
|
|
sl@0
|
209 |
set token [http_get $binurl -channel $out]
|
|
sl@0
|
210 |
close $out
|
|
sl@0
|
211 |
set in [open $testfile]
|
|
sl@0
|
212 |
fconfigure $in -translation binary
|
|
sl@0
|
213 |
set x [read $in]
|
|
sl@0
|
214 |
close $in
|
|
sl@0
|
215 |
removeFile $testfile
|
|
sl@0
|
216 |
set x
|
|
sl@0
|
217 |
} "$bindata$binurl"
|
|
sl@0
|
218 |
|
|
sl@0
|
219 |
proc myProgress {token total current} {
|
|
sl@0
|
220 |
global progress httpLog
|
|
sl@0
|
221 |
if {[info exists httpLog] && $httpLog} {
|
|
sl@0
|
222 |
puts "progress $total $current"
|
|
sl@0
|
223 |
}
|
|
sl@0
|
224 |
set progress [list $total $current]
|
|
sl@0
|
225 |
}
|
|
sl@0
|
226 |
if 0 {
|
|
sl@0
|
227 |
# This test hangs on Windows95 because the client never gets EOF
|
|
sl@0
|
228 |
set httpLog 1
|
|
sl@0
|
229 |
test httpold-4.6 {httpEvent} {
|
|
sl@0
|
230 |
set token [http_get $url -blocksize 50 -progress myProgress]
|
|
sl@0
|
231 |
set progress
|
|
sl@0
|
232 |
} {111 111}
|
|
sl@0
|
233 |
}
|
|
sl@0
|
234 |
test httpold-4.7 {httpEvent} {
|
|
sl@0
|
235 |
set token [http_get $url -progress myProgress]
|
|
sl@0
|
236 |
set progress
|
|
sl@0
|
237 |
} {111 111}
|
|
sl@0
|
238 |
test httpold-4.8 {httpEvent} {
|
|
sl@0
|
239 |
set token [http_get $url]
|
|
sl@0
|
240 |
http_status $token
|
|
sl@0
|
241 |
} {ok}
|
|
sl@0
|
242 |
test httpold-4.9 {httpEvent} {
|
|
sl@0
|
243 |
set token [http_get $url -progress myProgress]
|
|
sl@0
|
244 |
http_code $token
|
|
sl@0
|
245 |
} {HTTP/1.0 200 Data follows}
|
|
sl@0
|
246 |
test httpold-4.10 {httpEvent} {
|
|
sl@0
|
247 |
set token [http_get $url -progress myProgress]
|
|
sl@0
|
248 |
http_size $token
|
|
sl@0
|
249 |
} {111}
|
|
sl@0
|
250 |
test httpold-4.11 {httpEvent} {
|
|
sl@0
|
251 |
set token [http_get $url -timeout 1 -command {#}]
|
|
sl@0
|
252 |
http_reset $token
|
|
sl@0
|
253 |
http_status $token
|
|
sl@0
|
254 |
} {reset}
|
|
sl@0
|
255 |
test httpold-4.12 {httpEvent} {
|
|
sl@0
|
256 |
update
|
|
sl@0
|
257 |
set x {}
|
|
sl@0
|
258 |
after 500 {lappend x ok}
|
|
sl@0
|
259 |
set token [http_get $url -timeout 1 -command {lappend x fail}]
|
|
sl@0
|
260 |
vwait x
|
|
sl@0
|
261 |
list [http_status $token] $x
|
|
sl@0
|
262 |
} {timeout ok}
|
|
sl@0
|
263 |
|
|
sl@0
|
264 |
test httpold-5.1 {http_formatQuery} {
|
|
sl@0
|
265 |
http_formatQuery name1 value1 name2 "value two"
|
|
sl@0
|
266 |
} {name1=value1&name2=value+two}
|
|
sl@0
|
267 |
|
|
sl@0
|
268 |
test httpold-5.2 {http_formatQuery} {
|
|
sl@0
|
269 |
http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
|
|
sl@0
|
270 |
} {name1=%7ebwelch&name2=%a1%a2%a2}
|
|
sl@0
|
271 |
|
|
sl@0
|
272 |
test httpold-5.3 {http_formatQuery} {
|
|
sl@0
|
273 |
http_formatQuery lines "line1\nline2\nline3"
|
|
sl@0
|
274 |
} {lines=line1%0d%0aline2%0d%0aline3}
|
|
sl@0
|
275 |
|
|
sl@0
|
276 |
test httpold-6.1 {httpProxyRequired} {
|
|
sl@0
|
277 |
update
|
|
sl@0
|
278 |
http_config -proxyhost [info hostname] -proxyport $port
|
|
sl@0
|
279 |
set token [http_get $url]
|
|
sl@0
|
280 |
http_wait $token
|
|
sl@0
|
281 |
http_config -proxyhost {} -proxyport {}
|
|
sl@0
|
282 |
upvar #0 $token data
|
|
sl@0
|
283 |
set data(body)
|
|
sl@0
|
284 |
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
|
|
sl@0
|
285 |
<h1>Hello, World!</h1>
|
|
sl@0
|
286 |
<h2>GET http://$url</h2>
|
|
sl@0
|
287 |
</body></html>"
|
|
sl@0
|
288 |
|
|
sl@0
|
289 |
# cleanup
|
|
sl@0
|
290 |
catch {unset url}
|
|
sl@0
|
291 |
catch {unset port}
|
|
sl@0
|
292 |
catch {unset data}
|
|
sl@0
|
293 |
close $listen
|
|
sl@0
|
294 |
::tcltest::cleanupTests
|
|
sl@0
|
295 |
return
|
|
sl@0
|
296 |
|
|
sl@0
|
297 |
|
|
sl@0
|
298 |
|
|
sl@0
|
299 |
|
|
sl@0
|
300 |
|
|
sl@0
|
301 |
|
|
sl@0
|
302 |
|
|
sl@0
|
303 |
|
|
sl@0
|
304 |
|
|
sl@0
|
305 |
|
|
sl@0
|
306 |
|
|
sl@0
|
307 |
|