util/src/TclTk/tcl8.6.12/tests/http11.test

   1 # http11.test --                                                -*- tcl-*-
   2 #
   3 #       Test HTTP/1.1 features.
   4 #
   5 # Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
   6 #
   7 # See the file "license.terms" for information on usage and redistribution
   8 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
   9
  10 if {"::tcltest" ni [namespace children]} {
  11     package require tcltest 2.5
  12     namespace import -force ::tcltest::*
  13 }
  14
  15 package require http 2.9
  16
  17 # start the server
  18 variable httpd_output
  19 proc create_httpd {} {
  20     proc httpd_read {chan} {
  21         variable httpd_output
  22         if {[gets $chan line] >= 0} {
  23             #puts stderr "read '$line'"
  24             set httpd_output $line
  25         }
  26         if {[eof $chan]} {
  27             puts stderr "eof from httpd"
  28             fileevent $chan readable {}
  29             close $chan
  30         }
  31     }
  32     variable httpd_output
  33     set httpd_script [file join [pwd] [file dirname [info script]] httpd11.tcl]
  34     set httpd [open "|[list [interpreter] -encoding utf-8 $httpd_script]" r+]
  35     fconfigure $httpd -buffering line -blocking 0
  36     fileevent $httpd readable [list httpd_read $httpd]
  37     vwait httpd_output
  38     variable httpd_port [lindex $httpd_output 2]
  39     return $httpd
  40 }
  41
  42 proc halt_httpd {} {
  43     variable httpd_output
  44     variable httpd
  45     if {[info exists httpd]} {
  46         puts $httpd "quit"
  47         vwait httpd_output
  48         close $httpd
  49     }
  50     unset -nocomplain httpd_output httpd
  51 }
  52
  53 proc meta {tok {key ""}} {
  54     set meta [http::meta $tok]
  55     if {$key ne ""} {
  56         if {[dict exists $meta $key]} {
  57             return [dict get $meta $key]
  58         } else {
  59             return ""
  60         }
  61     }
  62     return $meta
  63 }
  64
  65 proc state {tok {key ""}} {
  66     upvar 1 $tok state
  67     if {$key ne ""} {
  68         if {[array names state -exact $key] ne {}} {
  69             return $state($key)
  70         } else {
  71             return ""
  72         }
  73     }
  74     set res [array get state]
  75     dict set res body <elided>
  76     return $res
  77 }
  78
  79 proc check_crc {tok args} {
  80     set crc [meta $tok x-crc32]
  81     set data [expr {[llength $args] ? [lindex $args 0] : [http::data $tok]}]
  82     set chk [format %x [zlib crc32 $data]]
  83     if {$crc ne $chk} {
  84         return  "crc32 mismatch: $crc ne $chk"
  85     }
  86     return "ok"
  87 }
  88
  89 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
  90 \f
  91 # -------------------------------------------------------------------------
  92
  93 test http11-1.0 "normal request for document " -setup {
  94     variable httpd [create_httpd]
  95 } -body {
  96     set tok [http::geturl http://localhost:$httpd_port/testdoc.html -timeout 10000]
  97     http::wait $tok
  98     list [http::status $tok] [http::code $tok] [check_crc $tok] [meta $tok connection]
  99 } -cleanup {
 100     http::cleanup $tok
 101     halt_httpd
 102 } -result {ok {HTTP/1.1 200 OK} ok close}
 103
 104 test http11-1.1 "normal,gzip,non-chunked" -setup {
 105     variable httpd [create_httpd]
 106 } -body {
 107     set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
 108                  -timeout 10000 -headers {accept-encoding gzip}]
 109     http::wait $tok
 110     list [http::status $tok] [http::code $tok] [check_crc $tok] \
 111         [meta $tok content-encoding] [meta $tok transfer-encoding]
 112 } -cleanup {
 113     http::cleanup $tok
 114     halt_httpd
 115 } -result {ok {HTTP/1.1 200 OK} ok gzip {}}
 116
 117 test http11-1.2 "normal,deflated,non-chunked" -setup {
 118     variable httpd [create_httpd]
 119 } -body {
 120     set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
 121                  -timeout 10000 -headers {accept-encoding deflate}]
 122     http::wait $tok
 123     list [http::status $tok] [http::code $tok] [check_crc $tok] \
 124         [meta $tok content-encoding] [meta $tok transfer-encoding]
 125 } -cleanup {
 126     http::cleanup $tok
 127     halt_httpd
 128 } -result {ok {HTTP/1.1 200 OK} ok deflate {}}
 129
 130 test http11-1.3 "normal,compressed,non-chunked" -setup {
 131     variable httpd [create_httpd]
 132 } -body {
 133     set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
 134                  -timeout 10000 -headers {accept-encoding compress}]
 135     http::wait $tok
 136     list [http::status $tok] [http::code $tok] [check_crc $tok] \
 137         [meta $tok content-encoding] [meta $tok transfer-encoding]
 138 } -cleanup {
 139     http::cleanup $tok
 140     halt_httpd
 141 } -result {ok {HTTP/1.1 200 OK} ok compress {}}
 142
 143 test http11-1.4 "normal,identity,non-chunked" -setup {
 144     variable httpd [create_httpd]
 145 } -body {
 146     set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
 147                  -timeout 10000 -headers {accept-encoding identity}]
 148     http::wait $tok
 149     list [http::status $tok] [http::code $tok] [check_crc $tok] \
 150         [meta $tok content-encoding] [meta $tok transfer-encoding]
 151 } -cleanup {
 152     http::cleanup $tok
 153     halt_httpd
 154 } -result {ok {HTTP/1.1 200 OK} ok {} {}}
 155
 156 test http11-1.5 "normal request for document, unsupported coding" -setup {
 157     variable httpd [create_httpd]
 158 } -body {
 159     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 160                  -timeout 10000 -headers {accept-encoding unsupported}]
 161     http::wait $tok
 162     list [http::status $tok] [http::code $tok] [check_crc $tok] \
 163         [meta $tok content-encoding]
 164 } -cleanup {
 165     http::cleanup $tok
 166     halt_httpd
 167 } -result {ok {HTTP/1.1 200 OK} ok {}}
 168
 169 test http11-1.6 "normal, specify 1.1 " -setup {
 170     variable httpd [create_httpd]
 171 } -body {
 172     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 173                  -protocol 1.1 -timeout 10000]
 174     http::wait $tok
 175     list [http::status $tok] [http::code $tok] [check_crc $tok] \
 176         [meta $tok connection] [meta $tok transfer-encoding]
 177 } -cleanup {
 178     http::cleanup $tok
 179     halt_httpd
 180 } -result {ok {HTTP/1.1 200 OK} ok close chunked}
 181
 182 test http11-1.7 "normal, 1.1 and keepalive " -setup {
 183     variable httpd [create_httpd]
 184 } -body {
 185     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 186                  -protocol 1.1 -keepalive 1 -timeout 10000]
 187     http::wait $tok
 188     list [http::status $tok] [http::code $tok] [check_crc $tok] \
 189         [meta $tok connection] [meta $tok transfer-encoding]
 190 } -cleanup {
 191     http::cleanup $tok
 192     halt_httpd
 193 } -result {ok {HTTP/1.1 200 OK} ok {} chunked}
 194
 195 test http11-1.8 "normal, 1.1 and keepalive, server close" -setup {
 196     variable httpd [create_httpd]
 197 } -body {
 198     set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
 199                  -protocol 1.1 -keepalive 1 -timeout 10000]
 200     http::wait $tok
 201     list [http::status $tok] [http::code $tok] [check_crc $tok] \
 202         [meta $tok connection] [meta $tok transfer-encoding]
 203 } -cleanup {
 204     http::cleanup $tok
 205     halt_httpd
 206 } -result {ok {HTTP/1.1 200 OK} ok close {}}
 207
 208 test http11-1.9 "normal,gzip,chunked" -setup {
 209     variable httpd [create_httpd]
 210 } -body {
 211     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 212                  -timeout 10000 -headers {accept-encoding gzip}]
 213     http::wait $tok
 214     list [http::status $tok] [http::code $tok] [check_crc $tok] \
 215         [meta $tok content-encoding] [meta $tok transfer-encoding]
 216 } -cleanup {
 217     http::cleanup $tok
 218     halt_httpd
 219 } -result {ok {HTTP/1.1 200 OK} ok gzip chunked}
 220
 221 test http11-1.10 "normal,deflate,chunked" -setup {
 222     variable httpd [create_httpd]
 223 } -body {
 224     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 225                  -timeout 10000 -headers {accept-encoding deflate}]
 226     http::wait $tok
 227     list [http::status $tok] [http::code $tok] [check_crc $tok] \
 228         [meta $tok content-encoding] [meta $tok transfer-encoding]
 229 } -cleanup {
 230     http::cleanup $tok
 231     halt_httpd
 232 } -result {ok {HTTP/1.1 200 OK} ok deflate chunked}
 233
 234 test http11-1.11 "normal,compress,chunked" -setup {
 235     variable httpd [create_httpd]
 236 } -body {
 237     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 238                  -timeout 10000 -headers {accept-encoding compress}]
 239     http::wait $tok
 240     list [http::status $tok] [http::code $tok] [check_crc $tok] \
 241         [meta $tok content-encoding] [meta $tok transfer-encoding]
 242 } -cleanup {
 243     http::cleanup $tok
 244     halt_httpd
 245 } -result {ok {HTTP/1.1 200 OK} ok compress chunked}
 246
 247 test http11-1.12 "normal,identity,chunked" -setup {
 248     variable httpd [create_httpd]
 249 } -body {
 250     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 251                  -timeout 10000 -headers {accept-encoding identity}]
 252     http::wait $tok
 253     list [http::status $tok] [http::code $tok] [check_crc $tok] \
 254         [meta $tok content-encoding] [meta $tok transfer-encoding]
 255 } -cleanup {
 256     http::cleanup $tok
 257     halt_httpd
 258 } -result {ok {HTTP/1.1 200 OK} ok {} chunked}
 259
 260 test http11-1.13 "normal, 1.1 and keepalive as server default, no zip" -setup {
 261     variable httpd [create_httpd]
 262     set zipTmp [http::config -zip]
 263     http::config -zip 0
 264 } -body {
 265     set tok [http::geturl http://localhost:$httpd_port/testdoc.html?transfer= \
 266                  -protocol 1.1 -keepalive 1 -timeout 10000]
 267     http::wait $tok
 268     set res1 [list [http::status $tok] [http::code $tok] [check_crc $tok] \
 269         [meta $tok connection] [meta $tok transfer-encoding] [state $tok reusing] [state $tok connection]]
 270     set toj [http::geturl http://localhost:$httpd_port/testdoc.html?transfer= \
 271                  -protocol 1.1 -keepalive 1 -timeout 10000]
 272     http::wait $toj
 273     set res2 [list [http::status $toj] [http::code $toj] [check_crc $toj] \
 274         [meta $toj connection] [meta $toj transfer-encoding] [state $toj reusing] [state $toj connection]]
 275     concat $res1 -- $res2
 276 } -cleanup {
 277     http::cleanup $tok
 278     http::cleanup $toj
 279     halt_httpd
 280     http::config -zip $zipTmp
 281 } -result {ok {HTTP/1.1 200 OK} ok {} {} 0 keep-alive -- ok {HTTP/1.1 200 OK} ok {} {} 1 keep-alive}
 282
 283 # -------------------------------------------------------------------------
 284
 285 proc progress {var token total current} {
 286     upvar #0 $var log
 287     set log [list $current $total]
 288     return
 289 }
 290
 291 proc progressPause {var token total current} {
 292     upvar #0 $var log
 293     set log [list $current $total]
 294     after 100 set ::WaitHere 0
 295     vwait ::WaitHere
 296     return
 297 }
 298
 299 test http11-2.0 "-channel" -setup {
 300     variable httpd [create_httpd]
 301     set chan [open [makeFile {} testfile.tmp] wb+]
 302 } -body {
 303     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 304                  -timeout 5000 -channel $chan]
 305     http::wait $tok
 306     seek $chan 0
 307     set data [read $chan]
 308     list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
 309         [meta $tok connection] [meta $tok transfer-encoding]
 310 } -cleanup {
 311     http::cleanup $tok
 312     close $chan
 313     removeFile testfile.tmp
 314     halt_httpd
 315 } -result {ok {HTTP/1.1 200 OK} ok close chunked}
 316
 317 test http11-2.1 "-channel, encoding gzip" -setup {
 318     variable httpd [create_httpd]
 319     set chan [open [makeFile {} testfile.tmp] wb+]
 320 } -body {
 321     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 322                  -timeout 5000 -channel $chan -headers {accept-encoding gzip}]
 323     http::wait $tok
 324     seek $chan 0
 325     set data [read $chan]
 326     list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
 327         [meta $tok connection] [meta $tok content-encoding]\
 328         [meta $tok transfer-encoding]
 329 } -cleanup {
 330     http::cleanup $tok
 331     close $chan
 332     removeFile testfile.tmp
 333     halt_httpd
 334 } -result {ok {HTTP/1.1 200 OK} ok close gzip chunked}
 335
 336 test http11-2.2 "-channel, encoding deflate" -setup {
 337     variable httpd [create_httpd]
 338     set chan [open [makeFile {} testfile.tmp] wb+]
 339 } -body {
 340     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 341                  -timeout 5000 -channel $chan -headers {accept-encoding deflate}]
 342     http::wait $tok
 343     seek $chan 0
 344     set data [read $chan]
 345     list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
 346         [meta $tok connection] [meta $tok content-encoding]\
 347         [meta $tok transfer-encoding]
 348 } -cleanup {
 349     http::cleanup $tok
 350     close $chan
 351     removeFile testfile.tmp
 352     halt_httpd
 353 } -result {ok {HTTP/1.1 200 OK} ok close deflate chunked}
 354
 355 test http11-2.3 "-channel,encoding compress" -setup {
 356     variable httpd [create_httpd]
 357     set chan [open [makeFile {} testfile.tmp] wb+]
 358 } -body {
 359     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 360                  -timeout 5000 -channel $chan \
 361                  -headers {accept-encoding compress}]
 362     http::wait $tok
 363     seek $chan 0
 364     set data [read $chan]
 365     list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
 366         [meta $tok connection] [meta $tok content-encoding]\
 367         [meta $tok transfer-encoding]
 368 } -cleanup {
 369     http::cleanup $tok
 370     close $chan
 371     removeFile testfile.tmp
 372     halt_httpd
 373 } -result {ok {HTTP/1.1 200 OK} ok close compress chunked}
 374
 375 test http11-2.4 "-channel,encoding identity" -setup {
 376     variable httpd [create_httpd]
 377     set chan [open [makeFile {} testfile.tmp] wb+]
 378 } -body {
 379     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 380                  -timeout 5000 -channel $chan \
 381                  -headers {accept-encoding identity}]
 382     http::wait $tok
 383     seek $chan 0
 384     set data [read $chan]
 385     list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
 386         [meta $tok connection] [meta $tok content-encoding]\
 387         [meta $tok transfer-encoding]
 388 } -cleanup {
 389     http::cleanup $tok
 390     close $chan
 391     removeFile testfile.tmp
 392     halt_httpd
 393 } -result {ok {HTTP/1.1 200 OK} ok close {} chunked}
 394
 395 test http11-2.4.1 "-channel,encoding identity with -progress" -setup {
 396     variable httpd [create_httpd]
 397     set chan [open [makeFile {} testfile.tmp] wb+]
 398     set logdata ""
 399 } -body {
 400     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 401                  -timeout 5000 -channel $chan \
 402                  -headers {accept-encoding identity} \
 403                  -progress [namespace code [list progress logdata]]]
 404
 405     http::wait $tok
 406     seek $chan 0
 407     set data [read $chan]
 408     list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
 409         [meta $tok connection] [meta $tok content-encoding]\
 410         [meta $tok transfer-encoding] \
 411         [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
 412         [expr {[lindex $logdata 0] - [string length $data]}]
 413 } -cleanup {
 414     http::cleanup $tok
 415     close $chan
 416     removeFile testfile.tmp
 417     halt_httpd
 418     unset -nocomplain logdata data
 419 } -result {ok {HTTP/1.1 200 OK} ok close {} chunked 0 0}
 420
 421 test http11-2.4.2 "-channel,encoding identity with -progress progressPause enters event loop" -constraints knownBug -setup {
 422     variable httpd [create_httpd]
 423     set chan [open [makeFile {} testfile.tmp] wb+]
 424     set logdata ""
 425 } -body {
 426     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 427                  -timeout 5000 -channel $chan \
 428                  -headers {accept-encoding identity} \
 429                  -progress [namespace code [list progressPause logdata]]]
 430
 431     http::wait $tok
 432     seek $chan 0
 433     set data [read $chan]
 434     list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
 435         [meta $tok connection] [meta $tok content-encoding]\
 436         [meta $tok transfer-encoding] \
 437         [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
 438         [expr {[lindex $logdata 0] - [string length $data]}]
 439 } -cleanup {
 440     http::cleanup $tok
 441     close $chan
 442     removeFile testfile.tmp
 443     halt_httpd
 444     unset -nocomplain logdata data ::WaitHere
 445 } -result {ok {HTTP/1.1 200 OK} ok close {} chunked 0 0}
 446
 447 test http11-2.5 "-channel,encoding unsupported" -setup {
 448     variable httpd [create_httpd]
 449     set chan [open [makeFile {} testfile.tmp] wb+]
 450 } -body {
 451     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 452                  -timeout 5000 -channel $chan \
 453                  -headers {accept-encoding unsupported}]
 454     http::wait $tok
 455     seek $chan 0
 456     set data [read $chan]
 457     list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
 458         [meta $tok connection] [meta $tok content-encoding]\
 459         [meta $tok transfer-encoding]
 460 } -cleanup {
 461     http::cleanup $tok
 462     close $chan
 463     removeFile testfile.tmp
 464     halt_httpd
 465 } -result {ok {HTTP/1.1 200 OK} ok close {} chunked}
 466
 467 test http11-2.6 "-channel,encoding gzip,non-chunked" -setup {
 468     variable httpd [create_httpd]
 469     set chan [open [makeFile {} testfile.tmp] wb+]
 470 } -body {
 471     set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
 472                  -timeout 5000 -channel $chan -headers {accept-encoding gzip}]
 473     http::wait $tok
 474     seek $chan 0
 475     set data [read $chan]
 476     list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
 477         [meta $tok connection] [meta $tok content-encoding]\
 478         [meta $tok transfer-encoding]\
 479         [expr {[file size testdoc.html]-[file size testfile.tmp]}]
 480 } -cleanup {
 481     http::cleanup $tok
 482     close $chan
 483     removeFile testfile.tmp
 484     halt_httpd
 485 } -result {ok {HTTP/1.1 200 OK} ok close gzip {} 0}
 486
 487 test http11-2.7 "-channel,encoding deflate,non-chunked" -setup {
 488     variable httpd [create_httpd]
 489     set chan [open [makeFile {} testfile.tmp] wb+]
 490 } -body {
 491     set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
 492                  -timeout 5000 -channel $chan -headers {accept-encoding deflate}]
 493     http::wait $tok
 494     seek $chan 0
 495     set data [read $chan]
 496     list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
 497         [meta $tok connection] [meta $tok content-encoding]\
 498         [meta $tok transfer-encoding]\
 499         [expr {[file size testdoc.html]-[file size testfile.tmp]}]
 500 } -cleanup {
 501     http::cleanup $tok
 502     close $chan
 503     removeFile testfile.tmp
 504     halt_httpd
 505 } -result {ok {HTTP/1.1 200 OK} ok close deflate {} 0}
 506
 507 test http11-2.8 "-channel,encoding compress,non-chunked" -setup {
 508     variable httpd [create_httpd]
 509     set chan [open [makeFile {} testfile.tmp] wb+]
 510 } -body {
 511     set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
 512                  -timeout 5000 -channel $chan -headers {accept-encoding compress}]
 513     http::wait $tok
 514     seek $chan 0
 515     set data [read $chan]
 516     list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
 517         [meta $tok connection] [meta $tok content-encoding]\
 518         [meta $tok transfer-encoding]\
 519         [expr {[file size testdoc.html]-[file size testfile.tmp]}]
 520 } -cleanup {
 521     http::cleanup $tok
 522     close $chan
 523     removeFile testfile.tmp
 524     halt_httpd
 525 } -result {ok {HTTP/1.1 200 OK} ok close compress {} 0}
 526
 527 test http11-2.9 "-channel,encoding identity,non-chunked" -setup {
 528     variable httpd [create_httpd]
 529     set chan [open [makeFile {} testfile.tmp] wb+]
 530 } -body {
 531     set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
 532                  -timeout 5000 -channel $chan -headers {accept-encoding identity}]
 533     http::wait $tok
 534     seek $chan 0
 535     set data [read $chan]
 536     list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
 537         [meta $tok connection] [meta $tok content-encoding]\
 538         [meta $tok transfer-encoding]\
 539         [expr {[file size testdoc.html]-[file size testfile.tmp]}]
 540 } -cleanup {
 541     http::cleanup $tok
 542     close $chan
 543     removeFile testfile.tmp
 544     halt_httpd
 545 } -result {ok {HTTP/1.1 200 OK} ok close {} {} 0}
 546
 547 test http11-2.10 "-channel,deflate,keepalive" -setup {
 548     variable httpd [create_httpd]
 549     set chan [open [makeFile {} testfile.tmp] wb+]
 550 } -body {
 551     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 552                  -timeout 5000 -channel $chan -keepalive 1 \
 553                  -headers {accept-encoding deflate}]
 554     http::wait $tok
 555     seek $chan 0
 556     set data [read $chan]
 557     list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
 558         [meta $tok connection] [meta $tok content-encoding]\
 559         [meta $tok transfer-encoding]\
 560         [expr {[file size testdoc.html]-[file size testfile.tmp]}]
 561 } -cleanup {
 562     http::cleanup $tok
 563     close $chan
 564     removeFile testfile.tmp
 565     halt_httpd
 566 } -result {ok {HTTP/1.1 200 OK} ok {} deflate chunked 0}
 567
 568 test http11-2.11 "-channel,identity,keepalive" -setup {
 569     variable httpd [create_httpd]
 570     set chan [open [makeFile {} testfile.tmp] wb+]
 571 } -body {
 572     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 573                  -headers {accept-encoding identity} \
 574                  -timeout 5000 -channel $chan -keepalive 1]
 575     http::wait $tok
 576     seek $chan 0
 577     set data [read $chan]
 578     list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
 579         [meta $tok connection] [meta $tok content-encoding]\
 580         [meta $tok transfer-encoding]
 581 } -cleanup {
 582     http::cleanup $tok
 583     close $chan
 584     removeFile testfile.tmp
 585     halt_httpd
 586 } -result {ok {HTTP/1.1 200 OK} ok {} {} chunked}
 587
 588 test http11-2.12 "-channel,negotiate,keepalive" -setup {
 589     variable httpd [create_httpd]
 590     set chan [open [makeFile {} testfile.tmp] wb+]
 591 } -body {
 592     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 593                  -timeout 5000 -channel $chan -keepalive 1]
 594     http::wait $tok
 595     seek $chan 0
 596     set data [read $chan]
 597     list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
 598         [meta $tok connection] [meta $tok content-encoding]\
 599         [meta $tok transfer-encoding] [meta $tok x-requested-encodings]\
 600         [expr {[file size testdoc.html]-[file size testfile.tmp]}]
 601 } -cleanup {
 602     http::cleanup $tok
 603     close $chan
 604     removeFile testfile.tmp
 605     halt_httpd
 606 } -result {ok {HTTP/1.1 200 OK} ok {} gzip chunked gzip,deflate,compress 0}
 607
 608
 609 # -------------------------------------------------------------------------
 610 #
 611 # The following tests for the -handler option will require changes in
 612 # the future. At the moment we cannot handler chunked data with this
 613 # option. Therefore we currently force HTTP/1.0 protocol version.
 614 #
 615 # Once this is solved, these tests should be fixed to assume chunked
 616 # returns in 3.2 and 3.3 and HTTP/1.1 in all but test 3.1
 617
 618 proc handler {var sock token} {
 619     upvar #0 $var data
 620     set chunk [read $sock]
 621     append data $chunk
 622     #::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])"
 623     return [string length $chunk]
 624 }
 625
 626 proc handlerPause {var sock token} {
 627     upvar #0 $var data
 628     set chunk [read $sock]
 629     append data $chunk
 630     #::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])"
 631     after 100 set ::WaitHere 0
 632     vwait ::WaitHere
 633     return [string length $chunk]
 634 }
 635
 636 test http11-3.0 "-handler,close,identity" -setup {
 637     variable httpd [create_httpd]
 638     set testdata ""
 639 } -body {
 640     set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
 641                  -timeout 10000 -handler [namespace code [list handler testdata]]]
 642     http::wait $tok
 643     list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
 644         [meta $tok connection] [meta $tok content-encoding] \
 645         [meta $tok transfer-encoding] \
 646         [expr {[file size testdoc.html]-[string length $testdata]}]
 647 } -cleanup {
 648     http::cleanup $tok
 649     unset -nocomplain testdata
 650     halt_httpd
 651 } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
 652
 653 test http11-3.1 "-handler,protocol1.0" -setup {
 654     variable httpd [create_httpd]
 655     set testdata ""
 656 } -body {
 657     set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
 658                  -timeout 10000 -protocol 1.0 \
 659                  -handler [namespace code [list handler testdata]]]
 660     http::wait $tok
 661     list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
 662         [meta $tok connection] [meta $tok content-encoding] \
 663         [meta $tok transfer-encoding] \
 664         [expr {[file size testdoc.html]-[string length $testdata]}]
 665 } -cleanup {
 666     http::cleanup $tok
 667     unset -nocomplain testdata
 668     halt_httpd
 669 } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
 670
 671 test http11-3.2 "-handler,close,chunked" -setup {
 672     variable httpd [create_httpd]
 673     set testdata ""
 674 } -body {
 675     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 676                  -timeout 10000 -keepalive 0 -binary 1\
 677                  -handler [namespace code [list handler testdata]]]
 678     http::wait $tok
 679     list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
 680         [meta $tok connection] [meta $tok content-encoding] \
 681         [meta $tok transfer-encoding] \
 682         [expr {[file size testdoc.html]-[string length $testdata]}]
 683 } -cleanup {
 684     http::cleanup $tok
 685     unset -nocomplain testdata
 686     halt_httpd
 687 } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
 688
 689 test http11-3.3 "-handler,keepalive,chunked" -setup {
 690     variable httpd [create_httpd]
 691     set testdata ""
 692 } -body {
 693     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 694                  -timeout 10000 -keepalive 1 -binary 1\
 695                  -handler [namespace code [list handler testdata]]]
 696     http::wait $tok
 697     list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
 698         [meta $tok connection] [meta $tok content-encoding] \
 699         [meta $tok transfer-encoding] \
 700         [expr {[file size testdoc.html]-[string length $testdata]}]
 701 } -cleanup {
 702     http::cleanup $tok
 703     unset -nocomplain testdata
 704     halt_httpd
 705 } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
 706
 707 # http11-3.4
 708 # This test is a blatant attempt to confuse the client by instructing the server
 709 # to send neither "Connection: close" nor "Content-Length" when in non-chunked
 710 # mode.
 711 # The client has no way to know the response-body is complete unless the
 712 # server signals this by closing the connection.
 713 # In an HTTP/1.1 response the absence of "Connection: close" means
 714 # "Connection: keep-alive", i.e. the server will keep the connection
 715 # open.  In HTTP/1.0 this is not the case, and this is a test that
 716 # the Tcl client assumes "Connection: close" by default in HTTP/1.0.
 717 test http11-3.4 "-handler,close,identity; HTTP/1.0 server does not send Connection: close header or Content-Length" -setup {
 718     variable httpd [create_httpd]
 719     set testdata ""
 720 } -body {
 721     set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1&nosendclose=any \
 722                  -timeout 10000 -handler [namespace code [list handler testdata]]]
 723     http::wait $tok
 724     list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
 725         [meta $tok connection] [meta $tok content-encoding] \
 726         [meta $tok transfer-encoding] \
 727         [expr {[file size testdoc.html]-[string length $testdata]}]
 728 } -cleanup {
 729     http::cleanup $tok
 730     unset -nocomplain testdata
 731     halt_httpd
 732 } -result {ok {HTTP/1.0 200 OK} ok {} {} {} 0}
 733
 734 # It is not forbidden for a handler to enter the event loop.
 735 test http11-3.5 "-handler,close,identity as http11-3.0 but handlerPause enters event loop" -setup {
 736     variable httpd [create_httpd]
 737     set testdata ""
 738 } -body {
 739     set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
 740                  -timeout 10000 -handler [namespace code [list handlerPause testdata]]]
 741     http::wait $tok
 742     list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
 743         [meta $tok connection] [meta $tok content-encoding] \
 744         [meta $tok transfer-encoding] \
 745         [expr {[file size testdoc.html]-[string length $testdata]}]
 746 } -cleanup {
 747     http::cleanup $tok
 748     unset -nocomplain testdata ::WaitHere
 749     halt_httpd
 750 } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
 751
 752 test http11-3.6 "-handler,close,identity as http11-3.0 but with -progress" -setup {
 753     variable httpd [create_httpd]
 754     set testdata ""
 755     set logdata ""
 756 } -body {
 757     set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
 758                  -timeout 10000 -handler [namespace code [list handler testdata]] \
 759                  -progress [namespace code [list progress logdata]]]
 760     http::wait $tok
 761     list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
 762         [meta $tok connection] [meta $tok content-encoding] \
 763         [meta $tok transfer-encoding] \
 764         [expr {[file size testdoc.html]-[string length $testdata]}] \
 765         [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
 766         [expr {[lindex $logdata 0] - [string length $testdata]}]
 767 } -cleanup {
 768     http::cleanup $tok
 769     unset -nocomplain testdata logdata ::WaitHere
 770     halt_httpd
 771 } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0 0 0}
 772
 773 test http11-3.7 "-handler,close,identity as http11-3.0 but with -progress progressPause enters event loop" -setup {
 774     variable httpd [create_httpd]
 775     set testdata ""
 776     set logdata ""
 777 } -body {
 778     set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
 779                  -timeout 10000 -handler [namespace code [list handler testdata]] \
 780                  -progress [namespace code [list progressPause logdata]]]
 781     http::wait $tok
 782     list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
 783         [meta $tok connection] [meta $tok content-encoding] \
 784         [meta $tok transfer-encoding] \
 785         [expr {[file size testdoc.html]-[string length $testdata]}] \
 786         [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
 787         [expr {[lindex $logdata 0] - [string length $testdata]}]
 788 } -cleanup {
 789     http::cleanup $tok
 790     unset -nocomplain testdata logdata ::WaitHere
 791     halt_httpd
 792 } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0 0 0}
 793
 794 test http11-3.8 "close,identity no -handler but with -progress" -setup {
 795     variable httpd [create_httpd]
 796     set logdata ""
 797 } -body {
 798     set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
 799                  -timeout 10000 \
 800                  -progress [namespace code [list progress logdata]] \
 801                  -headers {accept-encoding {}}]
 802     http::wait $tok
 803     list [http::status $tok] [http::code $tok] [check_crc $tok]\
 804         [meta $tok connection] [meta $tok content-encoding] \
 805         [meta $tok transfer-encoding] \
 806         [expr {[file size testdoc.html]-[string length [http::data $tok]]}] \
 807         [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
 808         [expr {[lindex $logdata 0] - [string length [http::data $tok]]}]
 809 } -cleanup {
 810     http::cleanup $tok
 811     unset -nocomplain logdata ::WaitHere
 812     halt_httpd
 813 } -result {ok {HTTP/1.1 200 OK} ok close {} {} 0 0 0}
 814
 815 test http11-3.9 "close,identity no -handler but with -progress progressPause enters event loop" -setup {
 816     variable httpd [create_httpd]
 817     set logdata ""
 818 } -body {
 819     set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
 820                  -timeout 10000 \
 821                  -progress [namespace code [list progressPause logdata]] \
 822                  -headers {accept-encoding {}}]
 823     http::wait $tok
 824     list [http::status $tok] [http::code $tok] [check_crc $tok]\
 825         [meta $tok connection] [meta $tok content-encoding] \
 826         [meta $tok transfer-encoding] \
 827         [expr {[file size testdoc.html]-[string length [http::data $tok]]}] \
 828         [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
 829         [expr {[lindex $logdata 0] - [string length [http::data $tok]]}]
 830 } -cleanup {
 831     http::cleanup $tok
 832     unset -nocomplain logdata ::WaitHere
 833     halt_httpd
 834 } -result {ok {HTTP/1.1 200 OK} ok close {} {} 0 0 0}
 835
 836 test http11-4.0 "normal post request" -setup {
 837     variable httpd [create_httpd]
 838 } -body {
 839     set query [http::formatQuery q 1 z 2]
 840     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 841                  -query $query -timeout 10000]
 842     http::wait $tok
 843     list status [http::status $tok] code [http::code $tok]\
 844         crc [check_crc $tok]\
 845         connection [meta $tok connection]\
 846         query-length [meta $tok x-query-length]
 847 } -cleanup {
 848     http::cleanup $tok
 849     halt_httpd
 850 } -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 7}
 851
 852 test http11-4.1 "normal post request, check query length" -setup {
 853     variable httpd [create_httpd]
 854 } -body {
 855     set query [http::formatQuery q 1 z 2]
 856     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
 857                  -headers [list x-check-query yes] \
 858                  -query $query -timeout 10000]
 859     http::wait $tok
 860     list status [http::status $tok] code [http::code $tok]\
 861         crc [check_crc $tok]\
 862         connection [meta $tok connection]\
 863         query-length [meta $tok x-query-length]
 864 } -cleanup {
 865     http::cleanup $tok
 866     halt_httpd
 867 } -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 7}
 868
 869 test http11-4.2 "normal post request, check long query length" -setup {
 870     variable httpd [create_httpd]
 871 } -body {
 872     set query [string repeat a 24576]
 873     set tok [http::geturl http://localhost:$httpd_port/testdoc.html\
 874                  -headers [list x-check-query yes]\
 875                  -query $query -timeout 10000]
 876     http::wait $tok
 877     list status [http::status $tok] code [http::code $tok]\
 878         crc [check_crc $tok]\
 879         connection [meta $tok connection]\
 880         query-length [meta $tok x-query-length]
 881 } -cleanup {
 882     http::cleanup $tok
 883     halt_httpd
 884 } -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 24576}
 885
 886 test http11-4.3 "normal post request, check channel query length" -setup {
 887     variable httpd [create_httpd]
 888     set chan [open [makeFile {} testfile.tmp] wb+]
 889     puts -nonewline $chan [string repeat [encoding convertto utf-8 "This is a test\n"] 8192]
 890     flush $chan
 891     seek $chan 0
 892 } -body {
 893     set tok [http::geturl http://localhost:$httpd_port/testdoc.html\
 894                  -headers [list x-check-query yes]\
 895                  -querychannel $chan -timeout 10000]
 896     http::wait $tok
 897     list status [http::status $tok] code [http::code $tok]\
 898         crc [check_crc $tok]\
 899         connection [meta $tok connection]\
 900         query-length [meta $tok x-query-length]
 901 } -cleanup {
 902     http::cleanup $tok
 903     close $chan
 904     removeFile testfile.tmp
 905     halt_httpd
 906 } -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 122880}
 907 \f
 908 # -------------------------------------------------------------------------
 909
 910 # Eliminate valgrind "still reachable" reports on outstanding "Detached"
 911 # structures in the detached list which stem from PipeClose2Proc not waiting
 912 # around for background processes to complete, meaning that previous calls to
 913 # Tcl_ReapDetachedProcs might not have had a chance to reap all processes.
 914 after 10
 915 exec [info nameofexecutable] << {}
 916
 917 foreach p {create_httpd httpd_read halt_httpd meta check_crc} {
 918     if {[llength [info proc $p]]} {rename $p {}}
 919 }
 920 removeFile testdoc.html
 921 unset -nocomplain httpd_port httpd p
 922
 923 ::tcltest::cleanupTests