summaryrefslogtreecommitdiffstats
path: root/tests/httpd
diff options
context:
space:
mode:
Diffstat (limited to 'tests/httpd')
-rw-r--r--tests/httpd40
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
}
-
-