summaryrefslogtreecommitdiffstats
path: root/tests/httpd
diff options
context:
space:
mode:
Diffstat (limited to 'tests/httpd')
-rw-r--r--tests/httpd86
1 files changed, 62 insertions, 24 deletions
diff --git a/tests/httpd b/tests/httpd
index aa2e51d..e5fa282 100644
--- a/tests/httpd
+++ b/tests/httpd
@@ -2,6 +2,7 @@
# The httpd_ procedures implement a stub http server.
#
# Copyright (c) 1997-1998 Sun Microsystems, Inc.
+# Copyright (c) 1999-2000 Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -22,6 +23,7 @@ proc httpd_log {args} {
array set httpdErrors {
204 {No Content}
400 {Bad Request}
+ 401 {Authorization Required}
404 {Not Found}
503 {Service Unavailable}
504 {Service Temporarily Unavailable}
@@ -47,10 +49,15 @@ proc httpdAccept {newsock ipaddr port} {
proc httpdRead { sock } {
upvar #0 httpd$sock data
- if {![info exists data(state)]} {
+ if {[eof $sock]} {
+ set readCount -1
+ } elseif {![info exists data(state)]} {
+
+ # Read the protocol line and parse out the URL and query
+
set readCount [gets $sock line]
- if [regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/1.0} \
- $line x data(proto) data(url) data(query)] {
+ if [regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/(1.[01])} \
+ $line x data(proto) data(url) data(query) data(httpversion)] {
set data(state) mime
httpd_log $sock Query $line
} else {
@@ -60,11 +67,14 @@ proc httpdRead { sock } {
}
return
} elseif {$data(state) == "mime"} {
+
+ # Read the HTTP headers
+
set readCount [gets $sock line]
- if {[regexp {Content-Length: (\d+)} $line match length]} {
- set data(length) $length
- }
} elseif {$data(state) == "query"} {
+
+ # Read the query data
+
if {![info exist data(length_orig)]} {
set data(length_orig) $data(length)
}
@@ -86,18 +96,41 @@ proc httpdRead { sock } {
}
0,mime,HEAD -
0,mime,GET -
- 0,query,POST { httpdRespond $sock }
- 0,mime,POST { set data(state) query }
+ 0,query,POST {
+ # Empty line at end of headers,
+ # or eof after query data
+ httpdRespond $sock
+ }
+ 0,mime,POST {
+ # Empty line between headers and query data
+ if {![info exist data(mime,content-length)]} {
+ httpd_log $sock Error "No Content-Length for POST"
+ httpdError $sock 400
+ httpdSockDone $sock
+ } else {
+ set data(state) query
+ set data(length) $data(mime,content-length)
+
+ # Special case to simulate servers that respond
+ # without reading the post data.
+
+ if {[string match *droppost* $data(url)]} {
+ fileevent $sock readable {}
+ httpdRespond $sock
+ }
+ }
+ }
1,mime,HEAD -
1,mime,POST -
1,mime,GET {
+ # A line of HTTP headers
if {[regexp {([^:]+):[ ]*(.*)} $line dummy key value]} {
set data(mime,[string tolower $key]) $value
}
}
-1,query,POST {
httpd_log $sock Error "unexpected eof on <$data(url)> request"
- httpdError $sock 404
+ httpdError $sock 400
httpdSockDone $sock
}
1,query,POST {
@@ -108,7 +141,7 @@ proc httpdRead { sock } {
}
}
default {
- if [eof $sock] {
+ if {[eof $sock]} {
httpd_log $sock Error "unexpected eof on <$data(url)> request"
} else {
httpd_log $sock Error "unhandled state <$state> fetching <$data(url)>"
@@ -119,9 +152,9 @@ proc httpdRead { sock } {
}
}
proc httpdSockDone { sock } {
-upvar #0 httpd$sock data
+ upvar #0 httpd$sock data
unset data
- close $sock
+ catch {close $sock}
}
# Respond to the query.
@@ -156,19 +189,24 @@ proc httpdRespond { sock } {
append html </body></html>
}
}
+
+ # Catch errors from premature client closes
- if {$data(proto) == "HEAD"} {
- puts $sock "HTTP/1.0 200 OK"
- } else {
- puts $sock "HTTP/1.0 200 Data follows"
- }
- puts $sock "Date: [clock format [clock clicks]]"
- puts $sock "Content-Type: $type"
- puts $sock "Content-Length: [string length $html]"
- puts $sock ""
- if {$data(proto) != "HEAD"} {
- fconfigure $sock -translation binary
- puts -nonewline $sock $html
+ catch {
+ if {$data(proto) == "HEAD"} {
+ puts $sock "HTTP/1.0 200 OK"
+ } else {
+ puts $sock "HTTP/1.0 200 Data follows"
+ }
+ puts $sock "Date: [clock format [clock clicks]]"
+ puts $sock "Content-Type: $type"
+ puts $sock "Content-Length: [string length $html]"
+ puts $sock ""
+ flush $sock
+ if {$data(proto) != "HEAD"} {
+ fconfigure $sock -translation binary
+ puts -nonewline $sock $html
+ }
}
httpd_log $sock Done ""
httpdSockDone $sock