diff options
Diffstat (limited to 'tests/http.test')
| -rw-r--r-- | tests/http.test | 107 |
1 files changed, 45 insertions, 62 deletions
diff --git a/tests/http.test b/tests/http.test index 2a12aff..fda00b9 100644 --- a/tests/http.test +++ b/tests/http.test @@ -12,7 +12,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # -# RCS: @(#) $Id: http.test,v 1.39 2005/10/05 05:03:38 hobbs Exp $ +# RCS: @(#) $Id: http.test,v 1.40 2005/11/18 13:57:53 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -82,19 +82,15 @@ if {[info commands testthread] == "testthread" && [file exists $httpdFile]} { } } - test http-1.1 {http::config} { http::config } [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "Tcl http client package $version"] - 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 \ @@ -104,11 +100,9 @@ test http-1.4 {http::config} { http::config {expand}$savedconf set x } {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}} - test http-1.5 {http::config} { list [catch {http::config -proxyhost {} -junk 8080} msg] $msg } {1 {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent}} - test http-1.6 {http::config} { set enc [list [http::config -urlencoding]] http::config -urlencoding iso8859-1 @@ -117,7 +111,6 @@ test http-1.6 {http::config} { set enc } {utf-8 iso8859-1} - test http-2.1 {http::reset} { catch {http::reset http#1} } 0 @@ -125,12 +118,10 @@ test http-2.1 {http::reset} { test http-3.1 {http::geturl} { list [catch {http::geturl -bogus flag} msg] $msg } {1 {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -progress, -query, -queryblocksize, -querychannel, -queryprogress, -validate, -timeout, -type}} - 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} { @@ -140,14 +131,12 @@ test http-3.3 {http::geturl} { <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 - test http-3.4 {http::geturl} { set token [http::geturl $url] http::data $token @@ -155,7 +144,6 @@ test http-3.4 {http::geturl} { <h1>Hello, World!</h1> <h2>GET $tail</h2> </body></html>" - proc selfproxy {host} { global port return [list [info hostname] $port] @@ -169,7 +157,6 @@ test http-3.5 {http::geturl} { <h1>Hello, World!</h1> <h2>GET http://$url</h2> </body></html>" - test http-3.6 {http::geturl} { http::config -proxyfilter bogus set token [http::geturl $url] @@ -179,7 +166,6 @@ test http-3.6 {http::geturl} { <h1>Hello, World!</h1> <h2>GET $tail</h2> </body></html>" - test http-3.7 {http::geturl} { set token [http::geturl $url -headers {Pragma no-cache}] http::data $token @@ -187,7 +173,6 @@ test http-3.7 {http::geturl} { <h1>Hello, World!</h1> <h2>GET $tail</h2> </body></html>" - test http-3.8 {http::geturl} { set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 2000] http::data $token @@ -200,12 +185,10 @@ test http-3.8 {http::geturl} { <dt>Foo<dd>Bar </dl> </body></html>" - test http-3.9 {http::geturl} { set token [http::geturl $url -validate 1] http::code $token } "HTTP/1.0 200 OK" - test http-3.10 {http::geturl queryprogress} { set query foo=bar set sep "" @@ -227,7 +210,6 @@ test http-3.10 {http::geturl queryprogress} { http::wait $t list [http::status $t] [string length $query] $postProgress [http::data $t] } {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}} - test http-3.11 {http::geturl querychannel with -command} { set query foo=bar set sep "" @@ -263,14 +245,11 @@ test http-3.11 {http::geturl querychannel with -command} { removeFile outdata set testRes } {ok 122879 {Got 122880 bytes} ok {PostStart {Got 122880 bytes}}} - -# On Linux platforms when the client and server are on the same -# host, the client is unable to read the server's response one -# it hits the write error. The status is "eof" - -# On Windows, the http::wait procedure gets a -# "connection reset by peer" error while reading the reply - +# On Linux platforms when the client and server are on the same host, the +# client is unable to read the server's response one it hits the write error. +# The status is "eof". +# On Windows, the http::wait procedure gets a "connection reset by peer" error +# while reading the reply. test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} { set query foo=bar set sep "" @@ -308,21 +287,49 @@ test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} { removeFile outdata list [http::status $t] [http::code $t] } {ok {HTTP/1.0 200 Data follows}} - test http-3.13 {http::geturl socket leak test} { set chanCount [llength [file channels]] for {set i 0} {$i < 3} {incr i} { - catch {http::geturl $badurl -timeout 5000} + catch {http::geturl $badurl -timeout 5000} } # No extra channels should be taken expr {[llength [file channels]] == $chanCount} } 1 - test http-3.14 "http::geturl $fullurl" { set token [http::geturl $fullurl -validate 1] http::code $token } "HTTP/1.0 200 OK" +test http-3.15 {http::geturl parse failures} -body { + http::geturl "{invalid}:url" +} -returnCodes error -result {Unsupported URL: {invalid}:url} +test http-3.16 {http::geturl parse failures} -body { + http::geturl http:relative/url +} -returnCodes error -result {Unsupported URL: http:relative/url} +test http-3.17 {http::geturl parse failures} -body { + http::geturl /absolute/url +} -returnCodes error -result {Missing host part: /absolute/url} +test http-3.18 {http::geturl parse failures} -body { + http::geturl http://somewhere:123456789/ +} -returnCodes error -result {Invalid port number: 123456789} +test http-3.19 {http::geturl parse failures} -body { + http::geturl http://{user}@somewhere +} -returnCodes error -result {Illegal characters in URL user} +test http-3.20 {http::geturl parse failures} -body { + http::geturl http://%user@somewhere +} -returnCodes error -result {Illegal encoding character usage "%us" in URL user} +test http-3.21 {http::geturl parse failures} -body { + http::geturl http://somewhere/{path} +} -returnCodes error -result {Illegal characters in URL path} +test http-3.22 {http::geturl parse failures} -body { + http::geturl http://somewhere/%path +} -returnCodes error -result {Illegal encoding character usage "%pa" in URL path} +test http-3.23 {http::geturl parse failures} -body { + http::geturl http://somewhere/path?{query} +} -returnCodes error -result {Illegal characters in URL path} +test http-3.24 {http::geturl parse failures} -body { + http::geturl http://somewhere/path?%query +} -returnCodes error -result {Illegal encoding character usage "%qu" in URL path} test http-4.1 {http::Event} { set token [http::geturl $url] @@ -330,19 +337,16 @@ test http-4.1 {http::Event} { 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 testfile [makeFile "" testfile] set out [open $testfile w] @@ -357,7 +361,6 @@ test http-4.4 {http::Event} { <h1>Hello, World!</h1> <h2>GET $tail</h2> </body></html>" - test http-4.5 {http::Event} { set testfile [makeFile "" testfile] set out [open $testfile w] @@ -367,7 +370,6 @@ test http-4.5 {http::Event} { removeFile $testfile expr $data(currentsize) == $data(totalsize) } 1 - test http-4.6 {http::Event} { set testfile [makeFile "" testfile] set out [open $testfile w] @@ -380,7 +382,6 @@ test http-4.6 {http::Event} { removeFile $testfile set x } "$bindata$binurl" - proc myProgress {token total current} { global progress httpLog if {[info exists httpLog] && $httpLog} { @@ -391,7 +392,7 @@ proc myProgress {token total current} { if 0 { # This test hangs on Windows95 because the client never gets EOF set httpLog 1 - test http-4.6 {http::Event} { + test http-4.6.1 {http::Event} knownBug { set token [http::geturl $url -blocksize 50 -progress myProgress] set progress } {111 111} @@ -412,38 +413,29 @@ test http-4.10 {http::Event} { set token [http::geturl $url -progress myProgress] http::size $token } {111} - # Timeout cases - -# Short timeout to working server (the test server) -# This lets us try a reset during the connection - +# Short timeout to working server (the test server). This lets us try a +# reset during the connection. test http-4.11 {http::Event} { set token [http::geturl $url -timeout 1 -command {#}] http::reset $token http::status $token } {reset} - -# Longer timeout with reset - +# Longer timeout with reset. test http-4.12 {http::Event} { set token [http::geturl $url/?timeout=10 -command {#}] http::reset $token http::status $token } {reset} - -# Medium timeout to working server that waits even longer -# The timeout hits while waiting for a reply - +# Medium timeout to working server that waits even longer. The timeout +# hits while waiting for a reply. test http-4.13 {http::Event} { set token [http::geturl $url?timeout=30 -timeout 10 -command {#}] http::wait $token http::status $token } {timeout} - -# Longer timeout to good host, bad port, gets an error -# after the connection "completes" but the socket is bad - +# Longer timeout to good host, bad port, gets an error after the +# connection "completes" but the socket is bad. test http-4.14 {http::Event} { set code [catch { set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command {#}] @@ -456,9 +448,7 @@ test http-4.14 {http::Event} { # error code varies among platforms. list $code [regexp {(connect failed|couldn't open socket)} $err] } {1 1} - # Bogus host - test http-4.15 {http::Event} { # This test may fail if you use a proxy server. That is to be # expected and is not a problem with Tcl. @@ -474,17 +464,13 @@ test http-4.15 {http::Event} { test http-5.1 {http::formatQuery} { http::formatQuery name1 value1 name2 "value two" } {name1=value1&name2=value+two} - # test http-5.2 obsoleted by 5.4 and 5.5 with http 2.5 - test http-5.3 {http::formatQuery} { http::formatQuery lines "line1\nline2\nline3" } {lines=line1%0d%0aline2%0d%0aline3} - test http-5.4 {http::formatQuery} { http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2 } {name1=~bwelch&name2=%c2%a1%c2%a2%c2%a2} - test http-5.5 {http::formatQuery} { set enc [http::config -urlencoding] http::config -urlencoding iso8859-1 @@ -508,13 +494,11 @@ test http-6.1 {http::ProxyRequired} { test http-7.1 {http::mapReply} { http::mapReply "abc\$\[\]\"\\()\}\{" } {abc%24%5b%5d%22%5c%28%29%7d%7b} - test http-7.2 {http::mapReply} { # RFC 2718 specifies that we pass urlencoding on utf-8 chars by default, # so make sure this gets converted to utf-8 then urlencoded. http::mapReply "\u2208" } {%e2%88%88} - test http-7.3 {http::formatQuery} { set enc [http::config -urlencoding] # this would be reverting to http <=2.4 behavior @@ -523,7 +507,6 @@ test http-7.3 {http::formatQuery} { http::config -urlencoding $enc set res } [list 1 "can't read \"formMap(\u2208)\": no such element in array"] - test http-7.4 {http::formatQuery} { set enc [http::config -urlencoding] # this would be reverting to http <=2.4 behavior w/o errors |