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 10if {"::tcltest" ni [namespace children]} { 11 package require tcltest 2.5 12 namespace import -force ::tcltest::* 13} 14 15package require http 2.9 16 17# start the server 18variable httpd_output 19proc 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 42proc 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 53proc 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 65proc 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 79proc 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 89makeFile "<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 91# ------------------------------------------------------------------------- 92 93test 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 104test 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 117test 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 130test 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 143test 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 156test 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 169test 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 182test 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 195test 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 208test 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 221test 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 234test 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 247test 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 260test 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 285proc progress {var token total current} { 286 upvar #0 $var log 287 set log [list $current $total] 288 return 289} 290 291proc 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 299test 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 317test 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 336test 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 355test 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 375test 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 395test 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 421test 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 447test 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 467test 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 487test 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 507test 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 527test 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 547test 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 568test 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 588test 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 618proc 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 626proc 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 636test 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 653test 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 671test 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 689test 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. 717test 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. 735test 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 752test 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 773test 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 794test 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 815test 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 836test 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 852test 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 869test 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 886test 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 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. 914after 10 915exec [info nameofexecutable] << {} 916 917foreach p {create_httpd httpd_read halt_httpd meta check_crc} { 918 if {[llength [info proc $p]]} {rename $p {}} 919} 920removeFile testdoc.html 921unset -nocomplain httpd_port httpd p 922 923::tcltest::cleanupTests 924