[Bug 3391977]: Ensure that the -headers option to http::geturl overrides the

-type option (important because -type has a default that is not always
appropriate, and the header must not be duplicated).

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