Removed newline appended to POST data.

Added tests to check that the data provided by a POST is as stated in the content-length [Bug 2715421]

2 files changed, 110 insertions, 9 deletions

diff --git a/tests/http11.test b/tests/http11.test
index 58bb091..967e5e6 100644
--- a/tests/http11.test
+++ b/tests/http11.test
@@ -231,7 +231,7 @@ test http-1.11 "normal,compress,chunked" -setup {
     halt_httpd
 } -result {ok {HTTP/1.1 200 OK} ok compress chunked}
 
-test http-1.11 "normal,identity,chunked" -setup {
+test http-1.12 "normal,identity,chunked" -setup {
     variable httpd [create_httpd]
 } -body {
     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
@@ -573,6 +573,78 @@ test http-3.3 "-handler,keepalive,chunked" -setup {
     halt_httpd
 } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
 
+test http-4.0 "normal post request" -setup {
+    variable httpd [create_httpd]
+} -body {
+    set query [http::formatQuery q 1 z 2]
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -query $query -timeout 10000]
+    http::wait $tok
+    list status [http::status $tok] code [http::code $tok]\
+        crc [check_crc $tok]\
+        connection [meta $tok connection]\
+        query-length [meta $tok x-query-length]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 7}
+
+test http-4.1 "normal post request, check query length" -setup {
+    variable httpd [create_httpd]
+} -body {
+    set query [http::formatQuery q 1 z 2]
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -headers [list x-check-query yes] \
+                 -query $query -timeout 10000]
+    http::wait $tok
+    list status [http::status $tok] code [http::code $tok]\
+        crc [check_crc $tok]\
+        connection [meta $tok connection]\
+        query-length [meta $tok x-query-length]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 7}
+
+test http-4.2 "normal post request, check long query length" -setup {
+    variable httpd [create_httpd]
+} -body {
+    set query [string repeat a 24576]
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html\
+                 -headers [list x-check-query yes]\
+                 -query $query -timeout 10000]
+    http::wait $tok
+    list status [http::status $tok] code [http::code $tok]\
+        crc [check_crc $tok]\
+        connection [meta $tok connection]\
+        query-length [meta $tok x-query-length]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 24576}
+
+test http-4.3 "normal post request, check channel query length" -setup {
+    variable httpd [create_httpd]
+    set chan [open [makeFile {} testfile.tmp] wb+]
+    puts -nonewline $chan [string repeat [encoding convertto utf-8 "This is a test\n"] 8192]
+    flush $chan
+    seek $chan 0
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html\
+                 -headers [list x-check-query yes]\
+                 -querychannel $chan -timeout 10000]
+    http::wait $tok
+    list status [http::status $tok] code [http::code $tok]\
+        crc [check_crc $tok]\
+        connection [meta $tok connection]\
+        query-length [meta $tok x-query-length]
+} -cleanup {
+    http::cleanup $tok
+    close $chan
+    removeFile testfile.tmp
+    halt_httpd
+} -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 122880}
+
 # -------------------------------------------------------------------------
 
 unset -nocomplain httpd_port
diff --git a/tests/httpd11.tcl b/tests/httpd11.tcl
index afa5f5d..9c543dc 100644
--- a/tests/httpd11.tcl
+++ b/tests/httpd11.tcl
@@ -89,6 +89,7 @@ proc Service {chan addr port} {
     while {1} {
         set meta {}
         chan configure $chan -buffering line -encoding iso8859-1 -translation crlf
+        chan configure $chan -blocking 0
         yield
         while {[gets $chan line] < 0} {
             if {[eof $chan]} {chan event $chan readable {}; close $chan; return}
@@ -101,16 +102,12 @@ proc Service {chan addr port} {
         puts $line
         while {[gets $chan line] > 0} {
             if {[regexp {^([^:]+):(.*)$} $line -> key val]} {
-                #puts "$key $val"
+                puts [list $key [string trim $val]]
                 lappend meta [string tolower $key] [string trim $val]
             }
             yield
         }
 
-        if {[scan $url {%[^?]?%s} path query] < 2} {
-            set query ""
-        }
-            
         set encoding identity
         set transfer ""
         set close 1
@@ -119,6 +116,35 @@ proc Service {chan addr port} {
         set data "<html><head><title>Error 404</title></head>"
         append data "<body><h1>Not Found</h1><p>Try again.</p></body></html>"
 
+        if {[scan $url {%[^?]?%s} path query] < 2} {
+            set query ""
+        }
+
+        switch -exact -- $req {
+            GET - HEAD {
+            }
+            POST {
+                # Read the query.
+                set qlen [dict get? $meta content-length]
+                if {[string is integer -strict $qlen]} {
+                    chan configure $chan -buffering none -translation binary
+                    while {[string length $query] < $qlen} {
+                        append query [read $chan $qlen]
+                        if {[string length $query] < $qlen} {yield}
+                    }
+                    # Check for excess query bytes [Bug 2715421]
+                    if {[dict get? $meta x-check-query] eq "yes"} {
+                        chan configure $chan -blocking 0
+                        append query [read $chan]
+                    }
+                }
+            }
+            default {
+                # invalid request error 5??
+            }
+        }
+        if {$query ne ""} {puts $query}
+
         set path [string trimleft $path /]
         set path [file join [pwd] $path]
         if {[file exists $path] && [file isfile $path]} {
@@ -153,10 +179,13 @@ proc Service {chan addr port} {
             }
         }
 
-        chan configure $chan -translation crlf
+        chan configure $chan -buffering line -encoding iso8859-1 -translation crlf
         Puts $chan "$protocol $code"
         Puts $chan "content-type: $type"
-        Puts $chan [format "x-crc32: %x" [zlib crc32 $data]]
+        Puts $chan [format "x-crc32: %08x" [zlib crc32 $data]]
+        if {$req eq "POST"} {
+            Puts $chan [format "x-query-length: %d" [string length $query]]
+        }
         if {$close} {
             Puts $chan "connection: close"
         }
@@ -171,7 +200,7 @@ proc Service {chan addr port} {
         puts $chan ""
         flush $chan
 
-        chan configure $chan -translation binary
+        chan configure $chan -buffering full -translation binary
         if {$transfer eq "chunked"} {
             blow-chunks $data $chan $encoding
         } elseif {$encoding ne "identity"} {