diff options
Diffstat (limited to 'tests/httpd')
| -rw-r--r-- | tests/httpd | 40 |
1 files changed, 30 insertions, 10 deletions
diff --git a/tests/httpd b/tests/httpd index 3ea8024..f810797 100644 --- a/tests/httpd +++ b/tests/httpd @@ -1,3 +1,4 @@ +# -*- tcl -*- # # The httpd_ procedures implement a stub http server. # @@ -25,7 +26,7 @@ array set httpdErrors { 404 {Not Found} 503 {Service Unavailable} 504 {Service Temporarily Unavailable} - } +} proc httpdError {sock code args} { global httpdErrors @@ -54,8 +55,8 @@ proc httpdRead { sock } { # Read the protocol line and parse out the URL and query set readCount [gets $sock line] - if [regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/(1.[01])} \ - $line x data(proto) data(url) data(query) data(httpversion)] { + if {[regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/(1.[01])} $line \ + -> data(proto) data(url) data(query) data(httpversion)]} { set data(state) mime httpd_log $sock Query $line } else { @@ -69,6 +70,10 @@ proc httpdRead { sock } { # Read the HTTP headers set readCount [gets $sock line] + if {[regexp {^([^:]+):(.*)$} $line -> key val]} { + lappend data(meta) $key [string trim $val] + } + } elseif {$data(state) == "query"} { # Read the query data @@ -94,7 +99,7 @@ proc httpdRead { sock } { } 0,mime,HEAD - 0,mime,GET - - 0,query,POST { + 0,query,POST { # Empty line at end of headers, # or eof after query data httpdRespond $sock @@ -170,6 +175,14 @@ proc httpdRespond { sock } { set html "Got [string length $data(query)] bytes" set type text/plain } + *headers* { + set html "" + set type text/plain + foreach {key value} $data(meta) { + append html [list $key $value] "\n" + } + set html [string trim $html] + } default { set type text/html @@ -190,18 +203,27 @@ proc httpdRespond { sock } { append html </body></html> } } - - # Catch errors from premature client closes + # Catch errors from premature client closes + catch { if {$data(proto) == "HEAD"} { puts $sock "HTTP/1.0 200 OK" } else { - puts $sock "HTTP/1.0 200 Data follows" + # Split the response to test for [Bug 26245326] + puts -nonewline $sock "HT" + flush $sock + puts $sock "TP/1.0 200 Data follows" } - puts $sock "Date: [clock format [clock clicks]]" + puts $sock "Date: [clock format [clock seconds] \ + -format {%a, %d %b %Y %H:%M:%S %Z}]" puts $sock "Content-Type: $type" puts $sock "Content-Length: [string length $html]" + foreach {key val} $data(meta) { + if {[string match "X-*" $key]} { + puts $sock "$key: $val" + } + } puts $sock "" flush $sock if {$data(proto) != "HEAD"} { @@ -212,5 +234,3 @@ proc httpdRespond { sock } { httpd_log $sock Done "" httpdSockDone $sock } - - |