summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--tests/http.test25
-rw-r--r--tests/httpd64
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"} {