summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2011-09-16 08:28:02 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2011-09-16 08:28:02 (GMT)
commitb70ab023a4e2ec3bfb8ebccf59b92519d5a5dbba (patch)
treee9d9531b410872bc585652d409b21187b47b6198
parentc6e44af1862f2818ef3586bf70986d7f75c5ae77 (diff)
downloadtcl-b70ab023a4e2ec3bfb8ebccf59b92519d5a5dbba.zip
tcl-b70ab023a4e2ec3bfb8ebccf59b92519d5a5dbba.tar.gz
tcl-b70ab023a4e2ec3bfb8ebccf59b92519d5a5dbba.tar.bz2
[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).
-rw-r--r--ChangeLog7
-rw-r--r--library/http/http.tcl8
-rw-r--r--tests/http.test24
-rw-r--r--tests/httpd8
4 files changed, 46 insertions, 1 deletions
diff --git a/ChangeLog b/ChangeLog
index 257545c..40814b2 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-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