summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog7
-rw-r--r--library/http/http.tcl8
-rw-r--r--tests/http.test26
-rw-r--r--tests/httpd8
4 files changed, 48 insertions, 1 deletions
diff --git a/ChangeLog b/ChangeLog
index 26f0093..efd3449 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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-15 Don Porter <dgp@users.sourceforge.net>
* generic/tclCompExpr.c: [Bug 3408408] Partial improvement by
diff --git a/library/http/http.tcl b/library/http/http.tcl
index c636458..69817b8 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -684,6 +684,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
@@ -691,6 +692,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"]} {
@@ -733,7 +737,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 e6e7649..d9c1efb 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -364,6 +364,32 @@ test http-3.26 {http::meta} -setup {
http::cleanup $token
unset -nocomplain m token
} -result {Content-Length Content-Type Date X-Check}
+test http-3.27 {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}
+Accept-Encoding .*
+Content-Length 5}
+test http-3.28 {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}
+Accept-Encoding .*
+Content-Length 5}
test http-4.1 {http::Event} -body {
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