diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | library/http/http.tcl | 8 | ||||
| -rw-r--r-- | tests/http.test | 24 | ||||
| -rw-r--r-- | tests/httpd | 8 |
4 files changed, 46 insertions, 1 deletions
@@ -1,3 +1,10 @@ +2011-09-16 Donal K. Fellows <dkf@users.sf.net> + + * library/http/http.tcl (http::geturl): [Bug 3391977]: Ensure that the + -headers option overrides the -type option (important because -type + has a default that is not always appropriate, and the header must not + be duplicated). + 2011-09-13 Don Porter <dgp@users.sourceforge.net> * generic/tclUtil.c: [Bug 3390638] Workaround broken solaris diff --git a/library/http/http.tcl b/library/http/http.tcl index aaef2b8..1c2b182 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -674,6 +674,7 @@ proc http::geturl {url args} { puts $sock "Proxy-Connection: Keep-Alive" } set accept_encoding_seen 0 + set content_type_seen 0 foreach {key value} $state(-headers) { if {[string equal -nocase $key "host"]} { continue @@ -681,6 +682,9 @@ proc http::geturl {url args} { if {[string equal -nocase $key "accept-encoding"]} { set accept_encoding_seen 1 } + if {[string equal -nocase $key "content-type"]} { + set content_type_seen 1 + } set value [string map [list \n "" \r ""] $value] set key [string trim $key] if {[string equal -nocase $key "content-length"]} { @@ -729,7 +733,9 @@ proc http::geturl {url args} { # response. if {$isQuery || $isQueryChannel} { - puts $sock "Content-Type: $state(-type)" + if {!$content_type_seen} { + puts $sock "Content-Type: $state(-type)" + } if {!$contDone} { puts $sock "Content-Length: $state(querylength)" } diff --git a/tests/http.test b/tests/http.test index 602047f..6dcb612 100644 --- a/tests/http.test +++ b/tests/http.test @@ -327,6 +327,30 @@ test http-3.23 {http::geturl parse failures} -body { test http-3.24 {http::geturl parse failures} -body { http::geturl http://somewhere/path?%query } -returnCodes error -result {Illegal encoding character usage "%qu" in URL path} +test http-3.25 {http::geturl: -headers override -type} -body { + set token [http::geturl $url/headers -type "text/plain" -query dummy \ + -headers [list "Content-Type" "text/plain;charset=utf-8"]] + http::data $token +} -cleanup { + http::cleanup $token +} -match regexp -result {(?n)Accept \*/\* +Host .* +User-Agent .* +Connection close +Content-Type {text/plain;charset=utf-8} +Content-Length 5} +test http-3.26 {http::geturl: -headers override -type default} -body { + set token [http::geturl $url/headers -query dummy \ + -headers [list "Content-Type" "text/plain;charset=utf-8"]] + http::data $token +} -cleanup { + http::cleanup $token +} -match regexp -result {(?n)Accept \*/\* +Host .* +User-Agent .* +Connection close +Content-Type {text/plain;charset=utf-8} +Content-Length 5} test http-4.1 {http::Event} { set token [http::geturl $url -keepalive 0] diff --git a/tests/httpd b/tests/httpd index 5272385..f810797 100644 --- a/tests/httpd +++ b/tests/httpd @@ -175,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 |