diff options
Diffstat (limited to 'tests/httpd')
| -rw-r--r-- | tests/httpd | 170 |
1 files changed, 129 insertions, 41 deletions
diff --git a/tests/httpd b/tests/httpd index 1531964..232e80a 100644 --- a/tests/httpd +++ b/tests/httpd @@ -1,12 +1,14 @@ +# -*- tcl -*- # # 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. -# -# SCCS: @(#) httpd 1.2 98/02/20 14:51:59 + +#set httpLog 1 proc httpd_init {{port 8015}} { socket -server httpdAccept $port @@ -20,10 +22,11 @@ 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} - } +} proc httpdError {sock code args} { global httpdErrors @@ -37,7 +40,7 @@ proc httpdAccept {newsock ipaddr port} { fconfigure $newsock -blocking 0 -translation {auto crlf} httpd_log $newsock Connect $ipaddr $port set data(ipaddr) $ipaddr - fileevent $newsock readable [list httpdRead $newsock] + after 50 [list fileevent $newsock readable [list httpdRead $newsock]] } # read data from a client request @@ -45,10 +48,15 @@ proc httpdAccept {newsock ipaddr port} { proc httpdRead { sock } { upvar #0 httpd$sock data - set readCount [gets $sock line] - if {![info exists data(state)]} { - if [regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/1.0} \ - $line x data(proto) data(url) data(query)] { + 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.[01])} $line \ + -> data(proto) data(url) data(query) data(httpversion)]} { set data(state) mime httpd_log $sock Query $line } else { @@ -57,6 +65,25 @@ proc httpdRead { sock } { httpdSockDone $sock } return + } elseif {$data(state) == "mime"} { + + # 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 + + if {![info exists 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 @@ -72,21 +99,52 @@ 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 exists 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 { - if [regexp {([^:]+):[ ]*(.*)} $line dummy key value] { + # 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 400 + httpdSockDone $sock + } 1,query,POST { append data(query) $line - httpdRespond $sock + if {$data(length) <= 0} { + set data(length) $data(length_orig) + httpdRespond $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)>" @@ -97,9 +155,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. @@ -108,41 +166,71 @@ 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 + } + *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 - 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" + if {$key == "timeout"} { + after $value ;# pause + } + } + append html </dl>\n } - append html </dl>\n + append html </body></html> } - append html </body></html> } - 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 errors from premature client closes + + catch { + if {$data(proto) == "HEAD"} { + puts $sock "HTTP/1.0 200 OK" + } else { + # 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 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"} { + fconfigure $sock -translation binary + puts -nonewline $sock $html + } } httpd_log $sock Done "" httpdSockDone $sock } - - |