924 lines
34 KiB
Plaintext
924 lines
34 KiB
Plaintext
|
# http11.test -- -*- tcl-*-
|
|||
|
|
#
|
|||
|
|
# Test HTTP/1.1 features.
|
|||
|
|
#
|
|||
|
|
# Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
|
|||
|
|
#
|
|||
|
|
# See the file "license.terms" for information on usage and redistribution
|
|||
|
|
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|||
|
|
|
|||
|
|
if {"::tcltest" ni [namespace children]} {
|
|||
|
|
package require tcltest 2.5
|
|||
|
|
namespace import -force ::tcltest::*
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
package require http 2.9
|
|||
|
|
|
|||
|
|
# start the server
|
|||
|
|
variable httpd_output
|
|||
|
|
proc create_httpd {} {
|
|||
|
|
proc httpd_read {chan} {
|
|||
|
|
variable httpd_output
|
|||
|
|
if {[gets $chan line] >= 0} {
|
|||
|
|
#puts stderr "read '$line'"
|
|||
|
|
set httpd_output $line
|
|||
|
|
}
|
|||
|
|
if {[eof $chan]} {
|
|||
|
|
puts stderr "eof from httpd"
|
|||
|
|
fileevent $chan readable {}
|
|||
|
|
close $chan
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
variable httpd_output
|
|||
|
|
set httpd_script [file join [pwd] [file dirname [info script]] httpd11.tcl]
|
|||
|
|
set httpd [open "|[list [interpreter] -encoding utf-8 $httpd_script]" r+]
|
|||
|
|
fconfigure $httpd -buffering line -blocking 0
|
|||
|
|
fileevent $httpd readable [list httpd_read $httpd]
|
|||
|
|
vwait httpd_output
|
|||
|
|
variable httpd_port [lindex $httpd_output 2]
|
|||
|
|
return $httpd
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
proc halt_httpd {} {
|
|||
|
|
variable httpd_output
|
|||
|
|
variable httpd
|
|||
|
|
if {[info exists httpd]} {
|
|||
|
|
puts $httpd "quit"
|
|||
|
|
vwait httpd_output
|
|||
|
|
close $httpd
|
|||
|
|
}
|
|||
|
|
unset -nocomplain httpd_output httpd
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
proc meta {tok {key ""}} {
|
|||
|
|
set meta [http::meta $tok]
|
|||
|
|
if {$key ne ""} {
|
|||
|
|
if {[dict exists $meta $key]} {
|
|||
|
|
return [dict get $meta $key]
|
|||
|
|
} else {
|
|||
|
|
return ""
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
return $meta
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
proc state {tok {key ""}} {
|
|||
|
|
upvar 1 $tok state
|
|||
|
|
if {$key ne ""} {
|
|||
|
|
if {[array names state -exact $key] ne {}} {
|
|||
|
|
return $state($key)
|
|||
|
|
} else {
|
|||
|
|
return ""
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
set res [array get state]
|
|||
|
|
dict set res body <elided>
|
|||
|
|
return $res
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
proc check_crc {tok args} {
|
|||
|
|
set crc [meta $tok x-crc32]
|
|||
|
|
set data [expr {[llength $args] ? [lindex $args 0] : [http::data $tok]}]
|
|||
|
|
set chk [format %x [zlib crc32 $data]]
|
|||
|
|
if {$crc ne $chk} {
|
|||
|
|
return "crc32 mismatch: $crc ne $chk"
|
|||
|
|
}
|
|||
|
|
return "ok"
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
makeFile "<html><head><title>test</title></head><body><p>this is a test</p>\n[string repeat {<p>This is a tcl test file.</p>} 4192]\n</body></html>" testdoc.html
|
|||
|
|
|
|||
|
|
# -------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
test http11-1.0 "normal request for document " -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html -timeout 10000]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok] [meta $tok connection]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok close}
|
|||
|
|
|
|||
|
|
test http11-1.1 "normal,gzip,non-chunked" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
|
|||
|
|
-timeout 10000 -headers {accept-encoding gzip}]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok] \
|
|||
|
|
[meta $tok content-encoding] [meta $tok transfer-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok gzip {}}
|
|||
|
|
|
|||
|
|
test http11-1.2 "normal,deflated,non-chunked" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
|
|||
|
|
-timeout 10000 -headers {accept-encoding deflate}]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok] \
|
|||
|
|
[meta $tok content-encoding] [meta $tok transfer-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok deflate {}}
|
|||
|
|
|
|||
|
|
test http11-1.3 "normal,compressed,non-chunked" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
|
|||
|
|
-timeout 10000 -headers {accept-encoding compress}]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok] \
|
|||
|
|
[meta $tok content-encoding] [meta $tok transfer-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok compress {}}
|
|||
|
|
|
|||
|
|
test http11-1.4 "normal,identity,non-chunked" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
|
|||
|
|
-timeout 10000 -headers {accept-encoding identity}]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok] \
|
|||
|
|
[meta $tok content-encoding] [meta $tok transfer-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok {} {}}
|
|||
|
|
|
|||
|
|
test http11-1.5 "normal request for document, unsupported coding" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-timeout 10000 -headers {accept-encoding unsupported}]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok] \
|
|||
|
|
[meta $tok content-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok {}}
|
|||
|
|
|
|||
|
|
test http11-1.6 "normal, specify 1.1 " -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-protocol 1.1 -timeout 10000]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok] \
|
|||
|
|
[meta $tok connection] [meta $tok transfer-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok close chunked}
|
|||
|
|
|
|||
|
|
test http11-1.7 "normal, 1.1 and keepalive " -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-protocol 1.1 -keepalive 1 -timeout 10000]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok] \
|
|||
|
|
[meta $tok connection] [meta $tok transfer-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok {} chunked}
|
|||
|
|
|
|||
|
|
test http11-1.8 "normal, 1.1 and keepalive, server close" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
|
|||
|
|
-protocol 1.1 -keepalive 1 -timeout 10000]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok] \
|
|||
|
|
[meta $tok connection] [meta $tok transfer-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok close {}}
|
|||
|
|
|
|||
|
|
test http11-1.9 "normal,gzip,chunked" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-timeout 10000 -headers {accept-encoding gzip}]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok] \
|
|||
|
|
[meta $tok content-encoding] [meta $tok transfer-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok gzip chunked}
|
|||
|
|
|
|||
|
|
test http11-1.10 "normal,deflate,chunked" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-timeout 10000 -headers {accept-encoding deflate}]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok] \
|
|||
|
|
[meta $tok content-encoding] [meta $tok transfer-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok deflate chunked}
|
|||
|
|
|
|||
|
|
test http11-1.11 "normal,compress,chunked" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-timeout 10000 -headers {accept-encoding compress}]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok] \
|
|||
|
|
[meta $tok content-encoding] [meta $tok transfer-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok compress chunked}
|
|||
|
|
|
|||
|
|
test http11-1.12 "normal,identity,chunked" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-timeout 10000 -headers {accept-encoding identity}]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok] \
|
|||
|
|
[meta $tok content-encoding] [meta $tok transfer-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok {} chunked}
|
|||
|
|
|
|||
|
|
test http11-1.13 "normal, 1.1 and keepalive as server default, no zip" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set zipTmp [http::config -zip]
|
|||
|
|
http::config -zip 0
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html?transfer= \
|
|||
|
|
-protocol 1.1 -keepalive 1 -timeout 10000]
|
|||
|
|
http::wait $tok
|
|||
|
|
set res1 [list [http::status $tok] [http::code $tok] [check_crc $tok] \
|
|||
|
|
[meta $tok connection] [meta $tok transfer-encoding] [state $tok reusing] [state $tok connection]]
|
|||
|
|
set toj [http::geturl http://localhost:$httpd_port/testdoc.html?transfer= \
|
|||
|
|
-protocol 1.1 -keepalive 1 -timeout 10000]
|
|||
|
|
http::wait $toj
|
|||
|
|
set res2 [list [http::status $toj] [http::code $toj] [check_crc $toj] \
|
|||
|
|
[meta $toj connection] [meta $toj transfer-encoding] [state $toj reusing] [state $toj connection]]
|
|||
|
|
concat $res1 -- $res2
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
http::cleanup $toj
|
|||
|
|
halt_httpd
|
|||
|
|
http::config -zip $zipTmp
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok {} {} 0 keep-alive -- ok {HTTP/1.1 200 OK} ok {} {} 1 keep-alive}
|
|||
|
|
|
|||
|
|
# -------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
proc progress {var token total current} {
|
|||
|
|
upvar #0 $var log
|
|||
|
|
set log [list $current $total]
|
|||
|
|
return
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
proc progressPause {var token total current} {
|
|||
|
|
upvar #0 $var log
|
|||
|
|
set log [list $current $total]
|
|||
|
|
after 100 set ::WaitHere 0
|
|||
|
|
vwait ::WaitHere
|
|||
|
|
return
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
test http11-2.0 "-channel" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set chan [open [makeFile {} testfile.tmp] wb+]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-timeout 5000 -channel $chan]
|
|||
|
|
http::wait $tok
|
|||
|
|
seek $chan 0
|
|||
|
|
set data [read $chan]
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
|
|||
|
|
[meta $tok connection] [meta $tok transfer-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
close $chan
|
|||
|
|
removeFile testfile.tmp
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok close chunked}
|
|||
|
|
|
|||
|
|
test http11-2.1 "-channel, encoding gzip" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set chan [open [makeFile {} testfile.tmp] wb+]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-timeout 5000 -channel $chan -headers {accept-encoding gzip}]
|
|||
|
|
http::wait $tok
|
|||
|
|
seek $chan 0
|
|||
|
|
set data [read $chan]
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding]\
|
|||
|
|
[meta $tok transfer-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
close $chan
|
|||
|
|
removeFile testfile.tmp
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok close gzip chunked}
|
|||
|
|
|
|||
|
|
test http11-2.2 "-channel, encoding deflate" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set chan [open [makeFile {} testfile.tmp] wb+]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-timeout 5000 -channel $chan -headers {accept-encoding deflate}]
|
|||
|
|
http::wait $tok
|
|||
|
|
seek $chan 0
|
|||
|
|
set data [read $chan]
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding]\
|
|||
|
|
[meta $tok transfer-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
close $chan
|
|||
|
|
removeFile testfile.tmp
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok close deflate chunked}
|
|||
|
|
|
|||
|
|
test http11-2.3 "-channel,encoding compress" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set chan [open [makeFile {} testfile.tmp] wb+]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-timeout 5000 -channel $chan \
|
|||
|
|
-headers {accept-encoding compress}]
|
|||
|
|
http::wait $tok
|
|||
|
|
seek $chan 0
|
|||
|
|
set data [read $chan]
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding]\
|
|||
|
|
[meta $tok transfer-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
close $chan
|
|||
|
|
removeFile testfile.tmp
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok close compress chunked}
|
|||
|
|
|
|||
|
|
test http11-2.4 "-channel,encoding identity" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set chan [open [makeFile {} testfile.tmp] wb+]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-timeout 5000 -channel $chan \
|
|||
|
|
-headers {accept-encoding identity}]
|
|||
|
|
http::wait $tok
|
|||
|
|
seek $chan 0
|
|||
|
|
set data [read $chan]
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding]\
|
|||
|
|
[meta $tok transfer-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
close $chan
|
|||
|
|
removeFile testfile.tmp
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok close {} chunked}
|
|||
|
|
|
|||
|
|
test http11-2.4.1 "-channel,encoding identity with -progress" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set chan [open [makeFile {} testfile.tmp] wb+]
|
|||
|
|
set logdata ""
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-timeout 5000 -channel $chan \
|
|||
|
|
-headers {accept-encoding identity} \
|
|||
|
|
-progress [namespace code [list progress logdata]]]
|
|||
|
|
|
|||
|
|
http::wait $tok
|
|||
|
|
seek $chan 0
|
|||
|
|
set data [read $chan]
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding]\
|
|||
|
|
[meta $tok transfer-encoding] \
|
|||
|
|
[expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
|
|||
|
|
[expr {[lindex $logdata 0] - [string length $data]}]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
close $chan
|
|||
|
|
removeFile testfile.tmp
|
|||
|
|
halt_httpd
|
|||
|
|
unset -nocomplain logdata data
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok close {} chunked 0 0}
|
|||
|
|
|
|||
|
|
test http11-2.4.2 "-channel,encoding identity with -progress progressPause enters event loop" -constraints knownBug -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set chan [open [makeFile {} testfile.tmp] wb+]
|
|||
|
|
set logdata ""
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-timeout 5000 -channel $chan \
|
|||
|
|
-headers {accept-encoding identity} \
|
|||
|
|
-progress [namespace code [list progressPause logdata]]]
|
|||
|
|
|
|||
|
|
http::wait $tok
|
|||
|
|
seek $chan 0
|
|||
|
|
set data [read $chan]
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding]\
|
|||
|
|
[meta $tok transfer-encoding] \
|
|||
|
|
[expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
|
|||
|
|
[expr {[lindex $logdata 0] - [string length $data]}]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
close $chan
|
|||
|
|
removeFile testfile.tmp
|
|||
|
|
halt_httpd
|
|||
|
|
unset -nocomplain logdata data ::WaitHere
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok close {} chunked 0 0}
|
|||
|
|
|
|||
|
|
test http11-2.5 "-channel,encoding unsupported" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set chan [open [makeFile {} testfile.tmp] wb+]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-timeout 5000 -channel $chan \
|
|||
|
|
-headers {accept-encoding unsupported}]
|
|||
|
|
http::wait $tok
|
|||
|
|
seek $chan 0
|
|||
|
|
set data [read $chan]
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding]\
|
|||
|
|
[meta $tok transfer-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
close $chan
|
|||
|
|
removeFile testfile.tmp
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok close {} chunked}
|
|||
|
|
|
|||
|
|
test http11-2.6 "-channel,encoding gzip,non-chunked" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set chan [open [makeFile {} testfile.tmp] wb+]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
|
|||
|
|
-timeout 5000 -channel $chan -headers {accept-encoding gzip}]
|
|||
|
|
http::wait $tok
|
|||
|
|
seek $chan 0
|
|||
|
|
set data [read $chan]
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding]\
|
|||
|
|
[meta $tok transfer-encoding]\
|
|||
|
|
[expr {[file size testdoc.html]-[file size testfile.tmp]}]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
close $chan
|
|||
|
|
removeFile testfile.tmp
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok close gzip {} 0}
|
|||
|
|
|
|||
|
|
test http11-2.7 "-channel,encoding deflate,non-chunked" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set chan [open [makeFile {} testfile.tmp] wb+]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
|
|||
|
|
-timeout 5000 -channel $chan -headers {accept-encoding deflate}]
|
|||
|
|
http::wait $tok
|
|||
|
|
seek $chan 0
|
|||
|
|
set data [read $chan]
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding]\
|
|||
|
|
[meta $tok transfer-encoding]\
|
|||
|
|
[expr {[file size testdoc.html]-[file size testfile.tmp]}]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
close $chan
|
|||
|
|
removeFile testfile.tmp
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok close deflate {} 0}
|
|||
|
|
|
|||
|
|
test http11-2.8 "-channel,encoding compress,non-chunked" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set chan [open [makeFile {} testfile.tmp] wb+]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
|
|||
|
|
-timeout 5000 -channel $chan -headers {accept-encoding compress}]
|
|||
|
|
http::wait $tok
|
|||
|
|
seek $chan 0
|
|||
|
|
set data [read $chan]
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding]\
|
|||
|
|
[meta $tok transfer-encoding]\
|
|||
|
|
[expr {[file size testdoc.html]-[file size testfile.tmp]}]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
close $chan
|
|||
|
|
removeFile testfile.tmp
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok close compress {} 0}
|
|||
|
|
|
|||
|
|
test http11-2.9 "-channel,encoding identity,non-chunked" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set chan [open [makeFile {} testfile.tmp] wb+]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
|
|||
|
|
-timeout 5000 -channel $chan -headers {accept-encoding identity}]
|
|||
|
|
http::wait $tok
|
|||
|
|
seek $chan 0
|
|||
|
|
set data [read $chan]
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding]\
|
|||
|
|
[meta $tok transfer-encoding]\
|
|||
|
|
[expr {[file size testdoc.html]-[file size testfile.tmp]}]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
close $chan
|
|||
|
|
removeFile testfile.tmp
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok close {} {} 0}
|
|||
|
|
|
|||
|
|
test http11-2.10 "-channel,deflate,keepalive" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set chan [open [makeFile {} testfile.tmp] wb+]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-timeout 5000 -channel $chan -keepalive 1 \
|
|||
|
|
-headers {accept-encoding deflate}]
|
|||
|
|
http::wait $tok
|
|||
|
|
seek $chan 0
|
|||
|
|
set data [read $chan]
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding]\
|
|||
|
|
[meta $tok transfer-encoding]\
|
|||
|
|
[expr {[file size testdoc.html]-[file size testfile.tmp]}]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
close $chan
|
|||
|
|
removeFile testfile.tmp
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok {} deflate chunked 0}
|
|||
|
|
|
|||
|
|
test http11-2.11 "-channel,identity,keepalive" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set chan [open [makeFile {} testfile.tmp] wb+]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-headers {accept-encoding identity} \
|
|||
|
|
-timeout 5000 -channel $chan -keepalive 1]
|
|||
|
|
http::wait $tok
|
|||
|
|
seek $chan 0
|
|||
|
|
set data [read $chan]
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding]\
|
|||
|
|
[meta $tok transfer-encoding]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
close $chan
|
|||
|
|
removeFile testfile.tmp
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok {} {} chunked}
|
|||
|
|
|
|||
|
|
test http11-2.12 "-channel,negotiate,keepalive" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set chan [open [makeFile {} testfile.tmp] wb+]
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-timeout 5000 -channel $chan -keepalive 1]
|
|||
|
|
http::wait $tok
|
|||
|
|
seek $chan 0
|
|||
|
|
set data [read $chan]
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding]\
|
|||
|
|
[meta $tok transfer-encoding] [meta $tok x-requested-encodings]\
|
|||
|
|
[expr {[file size testdoc.html]-[file size testfile.tmp]}]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
close $chan
|
|||
|
|
removeFile testfile.tmp
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok {} gzip chunked gzip,deflate,compress 0}
|
|||
|
|
|
|||
|
|
|
|||
|
|
# -------------------------------------------------------------------------
|
|||
|
|
#
|
|||
|
|
# The following tests for the -handler option will require changes in
|
|||
|
|
# the future. At the moment we cannot handler chunked data with this
|
|||
|
|
# option. Therefore we currently force HTTP/1.0 protocol version.
|
|||
|
|
#
|
|||
|
|
# Once this is solved, these tests should be fixed to assume chunked
|
|||
|
|
# returns in 3.2 and 3.3 and HTTP/1.1 in all but test 3.1
|
|||
|
|
|
|||
|
|
proc handler {var sock token} {
|
|||
|
|
upvar #0 $var data
|
|||
|
|
set chunk [read $sock]
|
|||
|
|
append data $chunk
|
|||
|
|
#::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])"
|
|||
|
|
return [string length $chunk]
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
proc handlerPause {var sock token} {
|
|||
|
|
upvar #0 $var data
|
|||
|
|
set chunk [read $sock]
|
|||
|
|
append data $chunk
|
|||
|
|
#::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])"
|
|||
|
|
after 100 set ::WaitHere 0
|
|||
|
|
vwait ::WaitHere
|
|||
|
|
return [string length $chunk]
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
test http11-3.0 "-handler,close,identity" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set testdata ""
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
|
|||
|
|
-timeout 10000 -handler [namespace code [list handler testdata]]]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding] \
|
|||
|
|
[meta $tok transfer-encoding] \
|
|||
|
|
[expr {[file size testdoc.html]-[string length $testdata]}]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
unset -nocomplain testdata
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
|
|||
|
|
|
|||
|
|
test http11-3.1 "-handler,protocol1.0" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set testdata ""
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
|
|||
|
|
-timeout 10000 -protocol 1.0 \
|
|||
|
|
-handler [namespace code [list handler testdata]]]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding] \
|
|||
|
|
[meta $tok transfer-encoding] \
|
|||
|
|
[expr {[file size testdoc.html]-[string length $testdata]}]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
unset -nocomplain testdata
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
|
|||
|
|
|
|||
|
|
test http11-3.2 "-handler,close,chunked" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set testdata ""
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-timeout 10000 -keepalive 0 -binary 1\
|
|||
|
|
-handler [namespace code [list handler testdata]]]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding] \
|
|||
|
|
[meta $tok transfer-encoding] \
|
|||
|
|
[expr {[file size testdoc.html]-[string length $testdata]}]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
unset -nocomplain testdata
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
|
|||
|
|
|
|||
|
|
test http11-3.3 "-handler,keepalive,chunked" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set testdata ""
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
|
|||
|
|
-timeout 10000 -keepalive 1 -binary 1\
|
|||
|
|
-handler [namespace code [list handler testdata]]]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding] \
|
|||
|
|
[meta $tok transfer-encoding] \
|
|||
|
|
[expr {[file size testdoc.html]-[string length $testdata]}]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
unset -nocomplain testdata
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
|
|||
|
|
|
|||
|
|
# http11-3.4
|
|||
|
|
# This test is a blatant attempt to confuse the client by instructing the server
|
|||
|
|
# to send neither "Connection: close" nor "Content-Length" when in non-chunked
|
|||
|
|
# mode.
|
|||
|
|
# The client has no way to know the response-body is complete unless the
|
|||
|
|
# server signals this by closing the connection.
|
|||
|
|
# In an HTTP/1.1 response the absence of "Connection: close" means
|
|||
|
|
# "Connection: keep-alive", i.e. the server will keep the connection
|
|||
|
|
# open. In HTTP/1.0 this is not the case, and this is a test that
|
|||
|
|
# the Tcl client assumes "Connection: close" by default in HTTP/1.0.
|
|||
|
|
test http11-3.4 "-handler,close,identity; HTTP/1.0 server does not send Connection: close header or Content-Length" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set testdata ""
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1&nosendclose=any \
|
|||
|
|
-timeout 10000 -handler [namespace code [list handler testdata]]]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding] \
|
|||
|
|
[meta $tok transfer-encoding] \
|
|||
|
|
[expr {[file size testdoc.html]-[string length $testdata]}]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
unset -nocomplain testdata
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.0 200 OK} ok {} {} {} 0}
|
|||
|
|
|
|||
|
|
# It is not forbidden for a handler to enter the event loop.
|
|||
|
|
test http11-3.5 "-handler,close,identity as http11-3.0 but handlerPause enters event loop" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set testdata ""
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
|
|||
|
|
-timeout 10000 -handler [namespace code [list handlerPause testdata]]]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding] \
|
|||
|
|
[meta $tok transfer-encoding] \
|
|||
|
|
[expr {[file size testdoc.html]-[string length $testdata]}]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
unset -nocomplain testdata ::WaitHere
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
|
|||
|
|
|
|||
|
|
test http11-3.6 "-handler,close,identity as http11-3.0 but with -progress" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set testdata ""
|
|||
|
|
set logdata ""
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
|
|||
|
|
-timeout 10000 -handler [namespace code [list handler testdata]] \
|
|||
|
|
-progress [namespace code [list progress logdata]]]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding] \
|
|||
|
|
[meta $tok transfer-encoding] \
|
|||
|
|
[expr {[file size testdoc.html]-[string length $testdata]}] \
|
|||
|
|
[expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
|
|||
|
|
[expr {[lindex $logdata 0] - [string length $testdata]}]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
unset -nocomplain testdata logdata ::WaitHere
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0 0 0}
|
|||
|
|
|
|||
|
|
test http11-3.7 "-handler,close,identity as http11-3.0 but with -progress progressPause enters event loop" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set testdata ""
|
|||
|
|
set logdata ""
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
|
|||
|
|
-timeout 10000 -handler [namespace code [list handler testdata]] \
|
|||
|
|
-progress [namespace code [list progressPause logdata]]]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding] \
|
|||
|
|
[meta $tok transfer-encoding] \
|
|||
|
|
[expr {[file size testdoc.html]-[string length $testdata]}] \
|
|||
|
|
[expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
|
|||
|
|
[expr {[lindex $logdata 0] - [string length $testdata]}]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
unset -nocomplain testdata logdata ::WaitHere
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0 0 0}
|
|||
|
|
|
|||
|
|
test http11-3.8 "close,identity no -handler but with -progress" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set logdata ""
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
|
|||
|
|
-timeout 10000 \
|
|||
|
|
-progress [namespace code [list progress logdata]] \
|
|||
|
|
-headers {accept-encoding {}}]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding] \
|
|||
|
|
[meta $tok transfer-encoding] \
|
|||
|
|
[expr {[file size testdoc.html]-[string length [http::data $tok]]}] \
|
|||
|
|
[expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
|
|||
|
|
[expr {[lindex $logdata 0] - [string length [http::data $tok]]}]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
unset -nocomplain logdata ::WaitHere
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok close {} {} 0 0 0}
|
|||
|
|
|
|||
|
|
test http11-3.9 "close,identity no -handler but with -progress progressPause enters event loop" -setup {
|
|||
|
|
variable httpd [create_httpd]
|
|||
|
|
set logdata ""
|
|||
|
|
} -body {
|
|||
|
|
set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
|
|||
|
|
-timeout 10000 \
|
|||
|
|
-progress [namespace code [list progressPause logdata]] \
|
|||
|
|
-headers {accept-encoding {}}]
|
|||
|
|
http::wait $tok
|
|||
|
|
list [http::status $tok] [http::code $tok] [check_crc $tok]\
|
|||
|
|
[meta $tok connection] [meta $tok content-encoding] \
|
|||
|
|
[meta $tok transfer-encoding] \
|
|||
|
|
[expr {[file size testdoc.html]-[string length [http::data $tok]]}] \
|
|||
|
|
[expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
|
|||
|
|
[expr {[lindex $logdata 0] - [string length [http::data $tok]]}]
|
|||
|
|
} -cleanup {
|
|||
|
|
http::cleanup $tok
|
|||
|
|
unset -nocomplain logdata ::WaitHere
|
|||
|
|
halt_httpd
|
|||
|
|
} -result {ok {HTTP/1.1 200 OK} ok close {} {} 0 0 0}
|
|||
|
|
|
|||
|
|
test http11-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 http11-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 http11-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 http11-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}
|
|||
|
|
|
|||
|
|
# -------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
# Eliminate valgrind "still reachable" reports on outstanding "Detached"
|
|||
|
|
# structures in the detached list which stem from PipeClose2Proc not waiting
|
|||
|
|
# around for background processes to complete, meaning that previous calls to
|
|||
|
|
# Tcl_ReapDetachedProcs might not have had a chance to reap all processes.
|
|||
|
|
after 10
|
|||
|
|
exec [info nameofexecutable] << {}
|
|||
|
|
|
|||
|
|
foreach p {create_httpd httpd_read halt_httpd meta check_crc} {
|
|||
|
|
if {[llength [info proc $p]]} {rename $p {}}
|
|||
|
|
}
|
|||
|
|
removeFile testdoc.html
|
|||
|
|
unset -nocomplain httpd_port httpd p
|
|||
|
|
|
|||
|
|
::tcltest::cleanupTests
|