diff options
Diffstat (limited to 'tests/http.test')
| -rw-r--r-- | tests/http.test | 342 |
1 files changed, 150 insertions, 192 deletions
diff --git a/tests/http.test b/tests/http.test index 1f4d8b4..2fc0a51 100644 --- a/tests/http.test +++ b/tests/http.test @@ -1,18 +1,20 @@ # 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. +# 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-2000 by Ajuba Solutions. # -# See the file "license.terms" for information on usage and redistribution of -# this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require tcltest 2 -namespace import -force ::tcltest::* +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest 2 + namespace import -force ::tcltest::* +} if {[catch {package require http 2} version]} { if {[info exists http2]} { @@ -52,7 +54,7 @@ if {![file exists $httpdFile]} { } if {[info commands testthread] == "testthread" && [file exists $httpdFile]} { - set httpthread [testthread create " + set httpthread [testthread create -joinable " source [list $httpdFile] testthread wait "] @@ -76,11 +78,10 @@ if {[info commands testthread] == "testthread" && [file exists $httpdFile]} { set port [lindex [fconfigure $listen -sockname] 2] } } - + test http-1.1 {http::config} { - http::config -useragent UserAgent http::config -} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "UserAgent"] +} [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 @@ -96,52 +97,48 @@ test http-1.4 {http::config} { http::config {*}$savedconf set x } {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}} -test http-1.5 {http::config} -returnCodes error -body { - http::config -proxyhost {} -junk 8080 -} -result {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent} -test http-1.6 {http::config} -setup { - set oldenc [http::config -urlencoding] -} -body { +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 lappend enc [http::config -urlencoding] -} -cleanup { - http::config -urlencoding $oldenc -} -result {utf-8 iso8859-1} + http::config -urlencoding [lindex $enc 0] + set enc +} {utf-8 iso8859-1} test http-2.1 {http::reset} { catch {http::reset http#1} } 0 -test http-3.1 {http::geturl} -returnCodes error -body { - http::geturl -bogus flag -} -result {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} -returnCodes error -body { - http::geturl http:junk -} -result {Unsupported URL: http:junk} +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, -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} -body { +set badurl //[info hostname]:[expr $port+1] +test http-3.3 {http::geturl} { set token [http::geturl $url] http::data $token -} -cleanup { - http::cleanup $token -} -result "<html><head><title>HTTP/1.0 TEST</title></head><body> +} "<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 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} -body { +set authorityurl //[info hostname]:$port +test http-3.4 {http::geturl} { set token [http::geturl $url] http::data $token -} -cleanup { - http::cleanup $token -} -result "<html><head><title>HTTP/1.0 TEST</title></head><body> +} "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> <h2>GET $tail</h2> </body></html>" @@ -149,43 +146,35 @@ proc selfproxy {host} { global port return [list [info hostname] $port] } -test http-3.5 {http::geturl} -body { +test http-3.5 {http::geturl} { http::config -proxyfilter selfproxy set token [http::geturl $url] - http::data $token -} -cleanup { http::config -proxyfilter http::ProxyRequired - http::cleanup $token -} -result "<html><head><title>HTTP/1.0 TEST</title></head><body> + 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 http-3.6 {http::geturl} -body { +test http-3.6 {http::geturl} { http::config -proxyfilter bogus set token [http::geturl $url] - http::data $token -} -cleanup { http::config -proxyfilter http::ProxyRequired - http::cleanup $token -} -result "<html><head><title>HTTP/1.0 TEST</title></head><body> + http::data $token +} "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> <h2>GET $tail</h2> </body></html>" -test http-3.7 {http::geturl} -body { +test http-3.7 {http::geturl} { set token [http::geturl $url -headers {Pragma no-cache}] http::data $token -} -cleanup { - http::cleanup $token -} -result "<html><head><title>HTTP/1.0 TEST</title></head><body> +} "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> <h2>GET $tail</h2> </body></html>" -test http-3.8 {http::geturl} -body { +test http-3.8 {http::geturl} { set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 2000] http::data $token -} -cleanup { - http::cleanup $token -} -result "<html><head><title>HTTP/1.0 TEST</title></head><body> +} "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> <h2>POST $tail</h2> <h2>Query</h2> @@ -194,13 +183,11 @@ test http-3.8 {http::geturl} -body { <dt>Foo<dd>Bar </dl> </body></html>" -test http-3.9 {http::geturl} -body { +test http-3.9 {http::geturl} { set token [http::geturl $url -validate 1] http::code $token -} -cleanup { - http::cleanup $token -} -result "HTTP/1.0 200 OK" -test http-3.10 {http::geturl queryprogress} -setup { +} "HTTP/1.0 200 OK" +test http-3.10 {http::geturl queryprogress} { set query foo=bar set sep "" set i 0 @@ -210,7 +197,7 @@ test http-3.10 {http::geturl queryprogress} -setup { append query $sep$query set sep & } -} -body { + proc postProgress {token x y} { global postProgress lappend postProgress $y @@ -220,10 +207,8 @@ test http-3.10 {http::geturl queryprogress} -setup { -queryprogress postProgress -queryblocksize 16384] http::wait $t list [http::status $t] [string length $query] $postProgress [http::data $t] -} -cleanup { - http::cleanup $t -} -result {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}} -test http-3.11 {http::geturl querychannel with -command} -setup { +} {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 "" set i 0 @@ -234,8 +219,8 @@ test http-3.11 {http::geturl querychannel with -command} -setup { set sep & } set file [makeFile $query outdata] -} -body { set fp [open $file] + proc asyncCB {token} { global postResult lappend postResult [http::data $token] @@ -244,6 +229,7 @@ test http-3.11 {http::geturl querychannel with -command} -setup { set t [http::geturl $posturl -querychannel $fp] http::wait $t set testRes [list [http::status $t] [string length $query] [http::data $t]] + # Now do async http::cleanup $t close $fp @@ -252,17 +238,17 @@ test http-3.11 {http::geturl querychannel with -command} -setup { set postResult [list PostStart] http::wait $t close $fp + lappend testRes [http::status $t] $postResult -} -cleanup { removeFile outdata - http::cleanup $t -} -result {ok 122879 {Got 122880 bytes} ok {PostStart {Got 122880 bytes}}} + 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. -test http-3.12 {http::geturl querychannel with aborted request} -setup { +test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} { set query foo=bar set sep "" set i 0 @@ -273,8 +259,8 @@ test http-3.12 {http::geturl querychannel with aborted request} -setup { set sep & } set file [makeFile $query outdata] -} -constraints {nonPortable} -body { set fp [open $file] + proc asyncCB {token} { global postResult lappend postResult [http::data $token] @@ -295,11 +281,10 @@ test http-3.12 {http::geturl querychannel with aborted request} -setup { puts $::errorInfo error $err } - list [http::status $t] [http::code $t] -} -cleanup { + removeFile outdata - http::cleanup $t -} -result {ok {HTTP/1.0 200 Data follows}} + 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} { @@ -309,12 +294,10 @@ test http-3.13 {http::geturl socket leak test} { # No extra channels should be taken expr {[llength [file channels]] == $chanCount} } 1 -test http-3.14 "http::geturl $fullurl" -body { +test http-3.14 "http::geturl $fullurl" { set token [http::geturl $fullurl -validate 1] http::code $token -} -cleanup { - http::cleanup $token -} -result "HTTP/1.0 200 OK" +} "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} @@ -340,99 +323,100 @@ 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}? + 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-3.25 {http::meta} -setup { - unset -nocomplain m token -} -body { - set token [http::geturl $url -timeout 2000] - array set m [http::meta $token] - lsort [array names m] +test http-3.25 {http::geturl: -headers override -type} -body { + set token [http::geturl $url/headers -type "text/plain" -query dummy \ + -headers [list "Content-Type" "text/plain;charset=utf-8"]] + http::data $token } -cleanup { http::cleanup $token - unset -nocomplain m token -} -result {Content-Length Content-Type Date} -test http-3.26 {http::meta} -setup { - unset -nocomplain m token -} -body { - set token [http::geturl $url -headers {X-Check 1} -timeout 2000] - array set m [http::meta $token] - lsort [array names m] +} -match regexp -result {(?n)Accept \*/\* +Host .* +User-Agent .* +Connection close +Content-Type {text/plain;charset=utf-8} +Content-Length 5} +test http-3.26 {http::geturl: -headers override -type default} -body { + set token [http::geturl $url/headers -query dummy \ + -headers [list "Content-Type" "text/plain;charset=utf-8"]] + http::data $token } -cleanup { http::cleanup $token - unset -nocomplain m token -} -result {Content-Length Content-Type Date X-Check} +} -match regexp -result {(?n)Accept \*/\* +Host .* +User-Agent .* +Connection close +Content-Type {text/plain;charset=utf-8} +Content-Length 5} +test http-3.30 {http::geturl query without path} -body { + set token [http::geturl $authorityurl?var=val] + http::ncode $token +} -cleanup { + catch { http::cleanup $token } +} -result 200 +test http-3.31 {http::geturl fragment without path} -body { + set token [http::geturl "$authorityurl#fragment42"] + http::ncode $token +} -cleanup { + catch { http::cleanup $token } +} -result 200 -test http-4.1 {http::Event} -body { +test http-4.1 {http::Event} { set token [http::geturl $url -keepalive 0] upvar #0 $token data array set meta $data(meta) expr {($data(totalsize) == $meta(Content-Length))} -} -cleanup { - http::cleanup $token -} -result 1 -test http-4.2 {http::Event} -body { +} 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)] -} -cleanup { - http::cleanup $token -} -result 0 -test http-4.3 {http::Event} -body { +} 0 +test http-4.3 {http::Event} { set token [http::geturl $url] http::code $token -} -cleanup { - http::cleanup $token -} -result {HTTP/1.0 200 Data follows} -test http-4.4 {http::Event} -setup { +} {HTTP/1.0 200 Data follows} +test http-4.4 {http::Event} { set testfile [makeFile "" testfile] -} -body { set out [open $testfile w] set token [http::geturl $url -channel $out] close $out set in [open $testfile] set x [read $in] -} -cleanup { - catch {close $in} - catch {close $out} + close $in removeFile $testfile - http::cleanup $token -} -result "<html><head><title>HTTP/1.0 TEST</title></head><body> + set x +} "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> <h2>GET $tail</h2> </body></html>" -test http-4.5 {http::Event} -setup { +test http-4.5 {http::Event} { set testfile [makeFile "" testfile] -} -body { set out [open $testfile w] fconfigure $out -translation lf set token [http::geturl $url -channel $out] close $out upvar #0 $token data - expr {$data(currentsize) == $data(totalsize)} -} -cleanup { removeFile $testfile - http::cleanup $token -} -result 1 -test http-4.6 {http::Event} -setup { + expr {$data(currentsize) == $data(totalsize)} +} 1 +test http-4.6 {http::Event} { set testfile [makeFile "" testfile] -} -body { set out [open $testfile w] set token [http::geturl $binurl -channel $out] close $out set in [open $testfile] fconfigure $in -translation binary - read $in -} -cleanup { - catch {close $in} - catch {close $out} + set x [read $in] + close $in removeFile $testfile - http::cleanup $token -} -result "$bindata[string trimleft $binurl /]" + set x +} "$bindata[string trimleft $binurl /]" proc myProgress {token total current} { global progress httpLog if {[info exists httpLog] && $httpLog} { @@ -445,60 +429,46 @@ if 0 { set httpLog 1 test http-4.6.1 {http::Event} knownBug { set token [http::geturl $url -blocksize 50 -progress myProgress] - return $progress + set progress } {111 111} } -test http-4.7 {http::Event} -body { +test http-4.7 {http::Event} { set token [http::geturl $url -keepalive 0 -progress myProgress] - return $progress -} -cleanup { - http::cleanup $token -} -result {111 111} -test http-4.8 {http::Event} -body { + set progress +} {111 111} +test http-4.8 {http::Event} { set token [http::geturl $url] http::status $token -} -cleanup { - http::cleanup $token -} -result {ok} -test http-4.9 {http::Event} -body { +} {ok} +test http-4.9 {http::Event} { set token [http::geturl $url -progress myProgress] http::code $token -} -cleanup { - http::cleanup $token -} -result {HTTP/1.0 200 Data follows} -test http-4.10 {http::Event} -body { +} {HTTP/1.0 200 Data follows} +test http-4.10 {http::Event} { set token [http::geturl $url -progress myProgress] http::size $token -} -cleanup { - http::cleanup $token -} -result {111} +} {111} # Timeout cases # Short timeout to working server (the test server). This lets us try a # reset during the connection. -test http-4.11 {http::Event} -body { - set token [http::geturl $url -timeout 1 -keepalive 0 -command \#] +test http-4.11 {http::Event} { + set token [http::geturl $url -timeout 1 -keepalive 0 -command {#}] http::reset $token http::status $token -} -cleanup { - http::cleanup $token -} -result {reset} +} {reset} # Longer timeout with reset. -test http-4.12 {http::Event} -body { - set token [http::geturl $url/?timeout=10 -keepalive 0 -command \#] +test http-4.12 {http::Event} { + set token [http::geturl $url/?timeout=10 -keepalive 0 -command {#}] http::reset $token http::status $token -} -cleanup { - http::cleanup $token -} -result {reset} +} {reset} # Medium timeout to working server that waits even longer. The timeout # hits while waiting for a reply. -test http-4.13 {http::Event} -body { - set token [http::geturl $url?timeout=30 -keepalive 0 -timeout 10 -command \#] +test http-4.13 {http::Event} { + set token [http::geturl $url?timeout=30 -keepalive 0 -timeout 10 -command {#}] http::wait $token http::status $token -} -cleanup { - http::cleanup $token -} -result {timeout} +} {timeout} # 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} -body { @@ -507,11 +477,8 @@ test http-4.14 {http::Event} -body { error "bogus return from http::geturl" } http::wait $token - http::status $token - # error code varies among platforms. -} -returnCodes 1 -match regexp -cleanup { - catch {http::cleanup $token} -} -result {(connect failed|couldn't open socket)} + lindex [http::error $token] 0 +} -result {connect failed connection refused} # Bogus host test http-4.15 {http::Event} -body { # This test may fail if you use a proxy server. That is to be @@ -520,8 +487,6 @@ test http-4.15 {http::Event} -body { http::wait $token http::status $token # error codes vary among platforms. -} -cleanup { - catch {http::cleanup $token} } -returnCodes 1 -match glob -result "couldn't open socket*" test http-5.1 {http::formatQuery} { @@ -530,60 +495,56 @@ test http-5.1 {http::formatQuery} { # 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} +} {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} +} {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 set res [http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2] http::config -urlencoding $enc set res -} {name1=~bwelch&name2=%a1%a2%a2} +} {name1=~bwelch&name2=%A1%A2%A2} -test http-6.1 {http::ProxyRequired} -body { +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) -} -cleanup { - http::config -proxyhost {} -proxyport {} - http::cleanup $token -} -result "<html><head><title>HTTP/1.0 TEST</title></head><body> +} "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> <h2>GET http:$url</h2> </body></html>" test http-7.1 {http::mapReply} { http::mapReply "abc\$\[\]\"\\()\}\{" -} {abc%24%5b%5d%22%5c%28%29%7d%7b} +} {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} -setup { +} {%E2%88%88} +test http-7.3 {http::formatQuery} { set enc [http::config -urlencoding] -} -returnCodes error -body { # this would be reverting to http <=2.4 behavior http::config -urlencoding "" - http::mapReply "\u2208" -} -cleanup { + set res [list [catch {http::mapReply "\u2208"} msg] $msg] http::config -urlencoding $enc -} -result "can't read \"formMap(\u2208)\": no such element in array" -test http-7.4 {http::formatQuery} -setup { + 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] -} -body { # this would be reverting to http <=2.4 behavior w/o errors # (unknown chars become '?') http::config -urlencoding "iso8859-1" - http::mapReply "\u2208" -} -cleanup { + set res [http::mapReply "\u2208"] http::config -urlencoding $enc -} -result {%3f} - + set res +} {%3F} + # cleanup catch {unset url} catch {unset badurl} @@ -593,6 +554,7 @@ if {[info exists httpthread]} { testthread send -async $httpthread { testthread exit } + testthread join $httpthread } else { close $listen } @@ -603,7 +565,3 @@ if {[info exists removeHttpd]} { rename bgerror {} ::tcltest::cleanupTests - -# Local variables: -# mode: tcl -# End: |