[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).

1 files changed, 7 insertions, 1 deletions

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)"
 	    }