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