diff options
| -rw-r--r-- | tests/http.test | 25 | ||||
| -rw-r--r-- | tests/httpd | 64 |
2 files changed, 63 insertions, 26 deletions
diff --git a/tests/http.test b/tests/http.test index 62749be..af231d7 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.14 1999/11/22 20:15:04 welch Exp $ +# RCS: @(#) $Id: http.test,v 1.15 2000/03/17 02:15:18 welch Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -121,6 +121,7 @@ test http-3.3 {http::geturl} { set tail /a/b/c set url [info hostname]:$port/a/b/c set binurl [info hostname]:$port/binary +set posturl [info hostname]:$port/post test http-3.4 {http::geturl} { set token [http::geturl $url] @@ -180,6 +181,28 @@ test http-3.9 {http::geturl} { http::code $token } "HTTP/1.0 200 OK" +test http-3.10 {http::geturl queryprogress} { + set query foo=bar + set sep "" + set i 0 + # Create about 120K of query data + while {$i < 14} { + incr i + append query $sep$query + set sep & + } + + proc postProgress {token x y} { + global postProgress + lappend postProgress $x + } + set postProgress {} + set t [http::geturl $posturl -query $query \ + -queryprogress postProgress] + http::wait $t + list [http::status $t] [string length $query] $postProgress [http::data $t] +} {ok 122879 {16384 32768 49152 65536 81920 98304 114688 131072} {Got 122879 bytes}} + test http-4.1 {http::Event} { set token [http::geturl $url] diff --git a/tests/httpd b/tests/httpd index ddfa6bf..94cfb43 100644 --- a/tests/httpd +++ b/tests/httpd @@ -8,6 +8,8 @@ # # SCCS: @(#) httpd 1.2 98/02/20 14:51:59 +#set httpLog 1 + proc httpd_init {{port 8015}} { socket -server httpdAccept $port } @@ -45,8 +47,8 @@ proc httpdAccept {newsock ipaddr port} { proc httpdRead { sock } { upvar #0 httpd$sock data - set readCount [gets $sock line] if {![info exists data(state)]} { + set readCount [gets $sock line] if [regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/1.0} \ $line x data(proto) data(url) data(query)] { set data(state) mime @@ -57,12 +59,18 @@ proc httpdRead { sock } { httpdSockDone $sock } return - } - # Extra check to handle -1,query,POST case, where we may see eof, - # although the data is there, just without a final newline. A proper - # server would handle this better. - if {[regexp {Content-Length: (\d+)} $line match length]} { - set data(length) $length + } elseif {$data(state) == "mime"} { + set readCount [gets $sock line] + if {[regexp {Content-Length: (\d+)} $line match length]} { + set data(length) $length + } + } elseif {$data(state) == "query"} { + if {![info exist data(length_orig)]} { + set data(length_orig) $data(length) + } + set line [read $sock $data(length)] + set readCount [string length $line] + incr data(length) -$readCount } # string compare $readCount 0 maps -1 to -1, 0 to 0, and > 0 to 1 @@ -88,18 +96,17 @@ proc httpdRead { sock } { } } -1,query,POST { - if {[info exists data(length)]} { - append data(query) [read $sock $data(length)] - httpdRespond $sock - return - } httpd_log $sock Error "unexpected eof on <$data(url)> request" httpdError $sock 404 httpdSockDone $sock } 1,query,POST { append data(query) $line - httpdRespond $sock + if {$data(length) <= 0} { + set data(length) $data(length_orig) + httpdRespond $sock + } +puts stderr "Post Dispatch" } default { if [eof $sock] { @@ -124,24 +131,31 @@ 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 + switch -glob -- $data(url) { + *binary* { + set html "$bindata[info hostname]:$port$data(url)" + set type application/octet-stream + } + *post* { + set html "Got [string length $data(query)] bytes" + set type text/plain + } + default { + set type text/html - set html "<html><head><title>HTTP/1.0 TEST</title></head><body> + set html "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> <h2>$data(proto) $data(url)</h2> " - if {[info exists data(query)] && [string length $data(query)]} { - append html "<h2>Query</h2>\n<dl>\n" - foreach {key value} [split $data(query) &=] { - append html "<dt>$key<dd>$value\n" + if {[info exists data(query)] && [string length $data(query)]} { + append html "<h2>Query</h2>\n<dl>\n" + foreach {key value} [split $data(query) &=] { + append html "<dt>$key<dd>$value\n" + } + append html </dl>\n } - append html </dl>\n + append html </body></html> } - append html </body></html> } if {$data(proto) == "HEAD"} { |