URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [http.test] - Blame information for rev 1765

Details | Compare with Previous | View Log


# Commands covered:  http::config, http::geturl, 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.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#
# RCS: @(#) $Id: http.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $
 
if {[string compare test [info procs test]] == 1} then {source defs}
 
if {[catch {package require http 2.0}]} {
    if {[info exist http2]} {
        catch {puts stderr "Cannot load http 2.0 package"}
        return
    } else {
        catch {puts stderr "Running http 2.0 tests in slave interp"}
        set interp [interp create http2]
        $interp eval [list set http2 "running"]
        $interp eval [list source [info script]]
        interp delete $interp
        return
    }
}
 
############### The httpd_ procedures implement a stub http server. ########
proc httpd_init {{port 8015}} {
    socket -server httpdAccept $port
}
proc httpd_log {args} {
    global httpLog
    if {[info exists httpLog] && $httpLog} {
        puts stderr "httpd: [join $args { }]"
    }
}
array set httpdErrors {
    204 {No Content}
    400 {Bad Request}
    404 {Not Found}
    503 {Service Unavailable}
    504 {Service Temporarily Unavailable}
    }
 
proc httpdError {sock code args} {
    global httpdErrors
    puts $sock "$code $httpdErrors($code)"
    httpd_log "error: [join $args { }]"
}
proc httpdAccept {newsock ipaddr port} {
    global httpd
    upvar #0 httpd$newsock data
 
    fconfigure $newsock -blocking 0 -translation {auto crlf}
    httpd_log $newsock Connect $ipaddr $port
    set data(ipaddr) $ipaddr
    fileevent $newsock readable [list httpdRead $newsock]
}
 
# read data from a client request
 
proc httpdRead { sock } {
    upvar #0 httpd$sock data
 
    set readCount [gets $sock line]
    if {![info exists data(state)]} {
        if [regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/1.0} \
                $line x data(proto) data(url) data(query)] {
            set data(state) mime
            httpd_log $sock Query $line
        } else {
            httpdError $sock 400
            httpd_log $sock Error "bad first line:$line"
            httpdSockDone $sock
        }
        return
    }
 
    # string compare $readCount 0 maps -1 to -1, 0 to 0, and > 0 to 1
 
    set state [string compare $readCount 0],$data(state),$data(proto)
    httpd_log $sock $state
    switch -- $state {
        -1,mime,HEAD    -
        -1,mime,GET     -
        -1,mime,POST    {
            # gets would block
            return
        }
        0,mime,HEAD     -
        0,mime,GET      -
        0,query,POST    { httpdRespond $sock }
        0,mime,POST     { set data(state) query }
        1,mime,HEAD     -
        1,mime,POST     -
        1,mime,GET      {
            if [regexp {([^:]+):[       ]*(.*)}  $line dummy key value] {
                set data(mime,[string tolower $key]) $value
            }
        }
        1,query,POST    {
            append data(query) $line
            httpdRespond $sock
        }
        default {
            if [eof $sock] {
                httpd_log $sock Error "unexpected eof on <$data(url)> request"
            } else {
                httpd_log $sock Error "unhandled state <$state> fetching <$data(url)>"
            }
            httpdError $sock 404
            httpdSockDone $sock
        }
    }
}
proc httpdSockDone { sock } {
upvar #0 httpd$sock data
    unset data
    close $sock
}
 
# Respond to the query.
 
set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
proc httpdRespond { sock } {
    global httpd bindata port
    upvar #0 httpd$sock data
 
    if {[string match *binary* $data(url)]} {
        set html "$bindata[info hostname]:$port$data(url)"
        set type application/octet-stream
    } else {
        set type text/html
 
        set html "HTTP/1.0 TEST
Hello, World!
$data(proto) $data(url)
"
        if {[info exists data(query)] && [string length $data(query)]} {
            append html "Query\n\n"
            foreach {key value} [split $data(query) &=] {
                append html "$key$value\n"
                if {[string compare $key timeout] == 0} {
                    # Simulate a timeout by not responding,
                    # but clean up our socket later.
 
                    after 50 [list httpdSockDone $sock]
                    httpd_log $sock Noresponse ""
                    return
                }
            }
            append html \n
        }
        append html 
    }
 
    if {$data(proto) == "HEAD"} {
        puts $sock "HTTP/1.0 200 OK"
    } else {
        puts $sock "HTTP/1.0 200 Data follows"
    }
    puts $sock "Date: [clock format [clock clicks]]"
    puts $sock "Content-Type: $type"
    puts $sock "Content-Length: [string length $html]"
    puts $sock ""
    if {$data(proto) != "HEAD"} {
        fconfigure $sock -translation binary
        puts -nonewline $sock $html
    }
    httpd_log $sock Done ""
    httpdSockDone $sock
}
##################### end server ###########################
 
set port 8010
if [catch {httpd_init $port} listen] {
    puts stderr "Cannot start http server, http test skipped"
    unset port
    return
}
 
test http-1.1 {http::config} {
    http::config
} {-accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 2.0}}
 
test http-1.2 {http::config} {
    http::config -proxyfilter
} http::ProxyRequired
 
test http-1.3 {http::config} {
    catch {http::config -junk}
} 1
 
test http-1.4 {http::config} {
    set savedconf [http::config]
    http::config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite"
    set x [http::config]
    eval http::config $savedconf
    set x
} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}}
 
test http-1.5 {http::config} {
    catch {http::config -proxyhost {} -junk 8080}
} 1
 
test http-2.1 {http::reset} {
    catch {http::reset http#1}
} 0
 
test http-3.1 {http::geturl} {
    catch {http::geturl -bogus flag}
} 1
test http-3.2 {http::geturl} {
    catch {http::geturl http:junk} err
    set err
} {Unsupported URL: http:junk}
 
set url [info hostname]:$port
test http-3.3 {http::geturl} {
    set token [http::geturl $url]
    http::data $token
} "HTTP/1.0 TEST
Hello, World!
GET /
"
 
set tail /a/b/c
set url [info hostname]:$port/a/b/c
set binurl [info hostname]:$port/binary
 
test http-3.4 {http::geturl} {
    set token [http::geturl $url]
    http::data $token
} "HTTP/1.0 TEST
Hello, World!
GET $tail
"
 
proc selfproxy {host} {
    global port
    return [list [info hostname] $port]
}
test http-3.5 {http::geturl} {
    http::config -proxyfilter selfproxy
    set token [http::geturl $url]
    http::config -proxyfilter http::ProxyRequired
    http::data $token
} "HTTP/1.0 TEST
Hello, World!
GET http://$url
"
 
test http-3.6 {http::geturl} {
    http::config -proxyfilter bogus
    set token [http::geturl $url]
    http::config -proxyfilter http::ProxyRequired
    http::data $token
} "HTTP/1.0 TEST
Hello, World!
GET $tail
"
 
test http-3.7 {http::geturl} {
    set token [http::geturl $url -headers {Pragma no-cache}]
    http::data $token
} "HTTP/1.0 TEST
Hello, World!
GET $tail
"
 
test http-3.8 {http::geturl} {
    set token [http::geturl $url -query Name=Value&Foo=Bar]
    http::data $token
} "HTTP/1.0 TEST
Hello, World!
POST $tail
Query

NameValue
FooBar

"
 
test http-3.9 {http::geturl} {
    set token [http::geturl $url -validate 1]
    http::code $token
} "HTTP/1.0 200 OK"
 
 
test http-4.1 {http::Event} {
    set token [http::geturl $url]
    upvar #0 $token data
    array set meta $data(meta)
    expr ($data(totalsize) == $meta(Content-Length))
} 1
 
test http-4.2 {http::Event} {
    set token [http::geturl $url]
    upvar #0 $token data
    array set meta $data(meta)
    string compare $data(type) [string trim $meta(Content-Type)]
} 0
 
test http-4.3 {http::Event} {
    set token [http::geturl $url]
    http::code $token
} {HTTP/1.0 200 Data follows}
 
test http-4.4 {http::Event} {
    set out [open testfile w]
    set token [http::geturl $url -channel $out]
    close $out
    set in [open testfile]
    set x [read $in]
    close $in
    file delete testfile
    set x
} "HTTP/1.0 TEST
Hello, World!
GET $tail
"
 
test http-4.5 {http::Event} {
    set out [open testfile w]
    set token [http::geturl $url -channel $out]
    close $out
    upvar #0 $token data
    file delete testfile
    expr $data(currentsize) == $data(totalsize)
} 1
 
test http-4.6 {http::Event} {
    set out [open testfile w]
    set token [http::geturl $binurl -channel $out]
    close $out
    set in [open testfile]
    fconfigure $in -translation binary
    set x [read $in]
    close $in
    file delete 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 http-4.6 {http::Event} {
        set token [http::geturl $url -blocksize 50 -progress myProgress]
        set progress
    } {111 111}
}
test http-4.7 {http::Event} {
    set token [http::geturl $url -progress myProgress]
    set progress
} {111 111}
test http-4.8 {http::Event} {
    set token [http::geturl $url]
    http::status $token
} {ok}
test http-4.9 {http::Event} {
    set token [http::geturl $url -progress myProgress]
    http::code $token
} {HTTP/1.0 200 Data follows}
test http-4.10 {http::Event} {
    set token [http::geturl $url -progress myProgress]
    http::size $token
} {111}
test http-4.11 {http::Event} {
    set token [http::geturl $url -timeout 1 -command {#}]
    http::reset $token
    http::status $token
} {reset}
test http-4.12 {http::Event} {
    set token [http::geturl $url?timeout=10 -timeout 1 -command {#}]
    http::wait $token
    http::status $token
} {timeout}
 
test http-5.1 {http::formatQuery} {
    http::formatQuery name1 value1 name2 "value two"
} {name1=value1&name2=value+two}
 
test http-5.2 {http::formatQuery} {
    http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
} {name1=%7ebwelch&name2=%a1%a2%a2}
 
test http-5.3 {http::formatQuery} {
    http::formatQuery lines "line1\nline2\nline3"
} {lines=line1%0d%0aline2%0d%0aline3}
 
test http-6.1 {http::ProxyRequired} {
    http::config -proxyhost [info hostname] -proxyport $port
    set token [http::geturl $url]
    http::wait $token
    http::config -proxyhost {} -proxyport {}
    upvar #0 $token data
    set data(body)
} "HTTP/1.0 TEST
Hello, World!
GET http://$url
"
 
unset url
unset port
close $listen

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [http.test] - Blame information for rev 1765

Hello, World!

$data(proto) $data(url)

Query

Hello, World!

GET /

Hello, World!

GET $tail

Hello, World!

GET http://$url

Hello, World!

GET $tail

Hello, World!

GET $tail

Hello, World!

POST $tail

Query

Hello, World!

GET $tail

Hello, World!

GET http://$url

Line No.	Rev	Author	Line
1	578	markom	`# Commands covered: http::config, http::geturl, http::wait, http::reset`
2			`#`
3			`# This file contains a collection of tests for the http script library.`
4			`# Sourcing this file into Tcl runs the tests and`
5			`# generates output for errors. No output means no errors were found.`
6			`#`
7			`# Copyright (c) 1991-1993 The Regents of the University of California.`
8			`# Copyright (c) 1994-1996 Sun Microsystems, Inc.`
9			`#`
10			`# See the file "license.terms" for information on usage and redistribution`
11			`# of this file, and for a DISCLAIMER OF ALL WARRANTIES.`
12			`#`
13			`#`
14			`# RCS: @(#) $Id: http.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $`
15
16			`if {[string compare test [info procs test]] == 1} then {source defs}`
17
18			`if {[catch {package require http 2.0}]} {`
19			`if {[info exist http2]} {`
20			`catch {puts stderr "Cannot load http 2.0 package"}`
21			`return`
22			`} else {`
23			`catch {puts stderr "Running http 2.0 tests in slave interp"}`
24			`set interp [interp create http2]`
25			`$interp eval [list set http2 "running"]`
26			`$interp eval [list source [info script]]`
27			`interp delete $interp`
28			`return`
29			`}`
30			`}`
31
32			`############### The httpd_ procedures implement a stub http server. ########`
33			`proc httpd_init {{port 8015}} {`
34			`socket -server httpdAccept $port`
35			`}`
36			`proc httpd_log {args} {`
37			`global httpLog`
38			`if {[info exists httpLog] && $httpLog} {`
39			`puts stderr "httpd: [join $args { }]"`
40			`}`
41			`}`
42			`array set httpdErrors {`
43			`204 {No Content}`
44			`400 {Bad Request}`
45			`404 {Not Found}`
46			`503 {Service Unavailable}`
47			`504 {Service Temporarily Unavailable}`
48			`}`
49
50			`proc httpdError {sock code args} {`
51			`global httpdErrors`
52			`puts $sock "$code $httpdErrors($code)"`
53			`httpd_log "error: [join $args { }]"`
54			`}`
55			`proc httpdAccept {newsock ipaddr port} {`
56			`global httpd`
57			`upvar #0 httpd$newsock data`
58
59			`fconfigure $newsock -blocking 0 -translation {auto crlf}`
60			`httpd_log $newsock Connect $ipaddr $port`
61			`set data(ipaddr) $ipaddr`
62			`fileevent $newsock readable [list httpdRead $newsock]`
63			`}`
64
65			`# read data from a client request`
66
67			`proc httpdRead { sock } {`
68			`upvar #0 httpd$sock data`
69
70			`set readCount [gets $sock line]`
71			`if {![info exists data(state)]} {`
72			`if [regexp {(POST\|GET\|HEAD) ([^?]+)\??([^ ]*) HTTP/1.0} \`
73			`$line x data(proto) data(url) data(query)] {`
74			`set data(state) mime`
75			`httpd_log $sock Query $line`
76			`} else {`
77			`httpdError $sock 400`
78			`httpd_log $sock Error "bad first line:$line"`
79			`httpdSockDone $sock`
80			`}`
81			`return`
82			`}`
83
84			`# string compare $readCount 0 maps -1 to -1, 0 to 0, and > 0 to 1`
85
86			`set state [string compare $readCount 0],$data(state),$data(proto)`
87			`httpd_log $sock $state`
88			`switch -- $state {`
89			`-1,mime,HEAD -`
90			`-1,mime,GET -`
91			`-1,mime,POST {`
92			`# gets would block`
93			`return`
94			`}`
95			`0,mime,HEAD -`
96			`0,mime,GET -`
97			`0,query,POST { httpdRespond $sock }`
98			`0,mime,POST { set data(state) query }`
99			`1,mime,HEAD -`
100			`1,mime,POST -`
101			`1,mime,GET {`
102			`if [regexp {([^:]+):[ ](.)} $line dummy key value] {`
103			`set data(mime,[string tolower $key]) $value`
104			`}`
105			`}`
106			`1,query,POST {`
107			`append data(query) $line`
108			`httpdRespond $sock`
109			`}`
110			`default {`
111			`if [eof $sock] {`
112			`httpd_log $sock Error "unexpected eof on <$data(url)> request"`
113			`} else {`
114			`httpd_log $sock Error "unhandled state <$state> fetching <$data(url)>"`
115			`}`
116			`httpdError $sock 404`
117			`httpdSockDone $sock`
118			`}`
119			`}`
120			`}`
121			`proc httpdSockDone { sock } {`
122			`upvar #0 httpd$sock data`
123			`unset data`
124			`close $sock`
125			`}`
126
127			`# Respond to the query.`
128
129			`set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"`
130			`proc httpdRespond { sock } {`
131			`global httpd bindata port`
132			`upvar #0 httpd$sock data`
133
134			`if {[string match binary $data(url)]} {`
135			`set html "$bindata[info hostname]:$port$data(url)"`
136			`set type application/octet-stream`
137			`} else {`
138			`set type text/html`
139
140			`set html "HTTP/1.0 TEST`
141			`Hello, World!`
142			`$data(proto) $data(url)`
143			`"`
144			`if {[info exists data(query)] && [string length $data(query)]} {`
145			`append html "Query \n` `\n"`
146			`foreach {key value} [split $data(query) &=] {`
147			`append html "$key` `$value\n"`
148			`if {[string compare $key timeout] == 0} {`
149			`# Simulate a timeout by not responding,`
150			`# but clean up our socket later.`
151
152			`after 50 [list httpdSockDone $sock]`
153			`httpd_log $sock Noresponse ""`
154			`return`
155			`}`
156			`}`
157			`append html \n`
158			`}`
159			`append html`
160			`}`
161
162			`if {$data(proto) == "HEAD"} {`
163			`puts $sock "HTTP/1.0 200 OK"`
164			`} else {`
165			`puts $sock "HTTP/1.0 200 Data follows"`
166			`}`
167			`puts $sock "Date: [clock format [clock clicks]]"`
168			`puts $sock "Content-Type: $type"`
169			`puts $sock "Content-Length: [string length $html]"`
170			`puts $sock ""`
171			`if {$data(proto) != "HEAD"} {`
172			`fconfigure $sock -translation binary`
173			`puts -nonewline $sock $html`
174			`}`
175			`httpd_log $sock Done ""`
176			`httpdSockDone $sock`
177			`}`
178			`##################### end server ###########################`
179
180			`set port 8010`
181			`if [catch {httpd_init $port} listen] {`
182			`puts stderr "Cannot start http server, http test skipped"`
183			`unset port`
184			`return`
185			`}`
186
187			`test http-1.1 {http::config} {`
188			`http::config`
189			`} {-accept / -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 2.0}}`
190
191			`test http-1.2 {http::config} {`
192			`http::config -proxyfilter`
193			`} http::ProxyRequired`
194
195			`test http-1.3 {http::config} {`
196			`catch {http::config -junk}`
197			`} 1`
198
199			`test http-1.4 {http::config} {`
200			`set savedconf [http::config]`
201			`http::config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite"`
202			`set x [http::config]`
203			`eval http::config $savedconf`
204			`set x`
205			`} {-accept / -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}}`
206
207			`test http-1.5 {http::config} {`
208			`catch {http::config -proxyhost {} -junk 8080}`
209			`} 1`
210
211			`test http-2.1 {http::reset} {`
212			`catch {http::reset http#1}`
213			`} 0`
214
215			`test http-3.1 {http::geturl} {`
216			`catch {http::geturl -bogus flag}`
217			`} 1`
218			`test http-3.2 {http::geturl} {`
219			`catch {http::geturl http:junk} err`
220			`set err`
221			`} {Unsupported URL: http:junk}`
222
223			`set url [info hostname]:$port`
224			`test http-3.3 {http::geturl} {`
225			`set token [http::geturl $url]`
226			`http::data $token`
227			`} "HTTP/1.0 TEST`
228			`Hello, World!`
229			`GET /`
230			`"`
231
232			`set tail /a/b/c`
233			`set url [info hostname]:$port/a/b/c`
234			`set binurl [info hostname]:$port/binary`
235
236			`test http-3.4 {http::geturl} {`
237			`set token [http::geturl $url]`
238			`http::data $token`
239			`} "HTTP/1.0 TEST`
240			`Hello, World!`
241			`GET $tail`
242			`"`
243
244			`proc selfproxy {host} {`
245			`global port`
246			`return [list [info hostname] $port]`
247			`}`
248			`test http-3.5 {http::geturl} {`
249			`http::config -proxyfilter selfproxy`
250			`set token [http::geturl $url]`
251			`http::config -proxyfilter http::ProxyRequired`
252			`http::data $token`
253			`} "HTTP/1.0 TEST`
254			`Hello, World!`
255			`GET http://$url`
256			`"`
257
258			`test http-3.6 {http::geturl} {`
259			`http::config -proxyfilter bogus`
260			`set token [http::geturl $url]`
261			`http::config -proxyfilter http::ProxyRequired`
262			`http::data $token`
263			`} "HTTP/1.0 TEST`
264			`Hello, World!`
265			`GET $tail`
266			`"`
267
268			`test http-3.7 {http::geturl} {`
269			`set token [http::geturl $url -headers {Pragma no-cache}]`
270			`http::data $token`
271			`} "HTTP/1.0 TEST`
272			`Hello, World!`
273			`GET $tail`
274			`"`
275
276			`test http-3.8 {http::geturl} {`
277			`set token [http::geturl $url -query Name=Value&Foo=Bar]`
278			`http::data $token`
279			`} "HTTP/1.0 TEST`
280			`Hello, World!`
281			`POST $tail`
282			`Query`
283
284			`Name` `Value`
285			`Foo` `Bar`
286
287			`"`
288
289			`test http-3.9 {http::geturl} {`
290			`set token [http::geturl $url -validate 1]`
291			`http::code $token`
292			`} "HTTP/1.0 200 OK"`
293
294
295			`test http-4.1 {http::Event} {`
296			`set token [http::geturl $url]`
297			`upvar #0 $token data`
298			`array set meta $data(meta)`
299			`expr ($data(totalsize) == $meta(Content-Length))`
300			`} 1`
301
302			`test http-4.2 {http::Event} {`
303			`set token [http::geturl $url]`
304			`upvar #0 $token data`
305			`array set meta $data(meta)`
306			`string compare $data(type) [string trim $meta(Content-Type)]`
307			`} 0`
308
309			`test http-4.3 {http::Event} {`
310			`set token [http::geturl $url]`
311			`http::code $token`
312			`} {HTTP/1.0 200 Data follows}`
313
314			`test http-4.4 {http::Event} {`
315			`set out [open testfile w]`
316			`set token [http::geturl $url -channel $out]`
317			`close $out`
318			`set in [open testfile]`
319			`set x [read $in]`
320			`close $in`
321			`file delete testfile`
322			`set x`
323			`} "HTTP/1.0 TEST`
324			`Hello, World!`
325			`GET $tail`
326			`"`
327
328			`test http-4.5 {http::Event} {`
329			`set out [open testfile w]`
330			`set token [http::geturl $url -channel $out]`
331			`close $out`
332			`upvar #0 $token data`
333			`file delete testfile`
334			`expr $data(currentsize) == $data(totalsize)`
335			`} 1`
336
337			`test http-4.6 {http::Event} {`
338			`set out [open testfile w]`
339			`set token [http::geturl $binurl -channel $out]`
340			`close $out`
341			`set in [open testfile]`
342			`fconfigure $in -translation binary`
343			`set x [read $in]`
344			`close $in`
345			`file delete testfile`
346			`set x`
347			`} "$bindata$binurl"`
348
349			`proc myProgress {token total current} {`
350			`global progress httpLog`
351			`if {[info exists httpLog] && $httpLog} {`
352			`puts "progress $total $current"`
353			`}`
354			`set progress [list $total $current]`
355			`}`
356			`if 0 {`
357			`# This test hangs on Windows95 because the client never gets EOF`
358			`set httpLog 1`
359			`test http-4.6 {http::Event} {`
360			`set token [http::geturl $url -blocksize 50 -progress myProgress]`
361			`set progress`
362			`} {111 111}`
363			`}`
364			`test http-4.7 {http::Event} {`
365			`set token [http::geturl $url -progress myProgress]`
366			`set progress`
367			`} {111 111}`
368			`test http-4.8 {http::Event} {`
369			`set token [http::geturl $url]`
370			`http::status $token`
371			`} {ok}`
372			`test http-4.9 {http::Event} {`
373			`set token [http::geturl $url -progress myProgress]`
374			`http::code $token`
375			`} {HTTP/1.0 200 Data follows}`
376			`test http-4.10 {http::Event} {`
377			`set token [http::geturl $url -progress myProgress]`
378			`http::size $token`
379			`} {111}`
380			`test http-4.11 {http::Event} {`
381			`set token [http::geturl $url -timeout 1 -command {#}]`
382			`http::reset $token`
383			`http::status $token`
384			`} {reset}`
385			`test http-4.12 {http::Event} {`
386			`set token [http::geturl $url?timeout=10 -timeout 1 -command {#}]`
387			`http::wait $token`
388			`http::status $token`
389			`} {timeout}`
390
391			`test http-5.1 {http::formatQuery} {`
392			`http::formatQuery name1 value1 name2 "value two"`
393			`} {name1=value1&name2=value+two}`
394
395			`test http-5.2 {http::formatQuery} {`
396			`http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2`
397			`} {name1=%7ebwelch&name2=%a1%a2%a2}`
398
399			`test http-5.3 {http::formatQuery} {`
400			`http::formatQuery lines "line1\nline2\nline3"`
401			`} {lines=line1%0d%0aline2%0d%0aline3}`
402
403			`test http-6.1 {http::ProxyRequired} {`
404			`http::config -proxyhost [info hostname] -proxyport $port`
405			`set token [http::geturl $url]`
406			`http::wait $token`
407			`http::config -proxyhost {} -proxyport {}`
408			`upvar #0 $token data`
409			`set data(body)`
410			`} "HTTP/1.0 TEST`
411			`Hello, World!`
412			`GET http://$url`
413			`"`
414
415			`unset url`
416			`unset port`
417			`close $listen`