Tcl Source Code

Artifact cea8074a358af876d69cb0ac56346ece24e46702:

Attachment "httpd11.patch" to ticket [2762041fff] added by ferrieux 2010-02-12 07:02:53.

---

Index: httpd11.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/httpd11.tcl,v
retrieving revision 1.2
diff -u -p -r1.2 httpd11.tcl
--- httpd11.tcl	19 Apr 2009 18:27:59 -0000	1.2
+++ httpd11.tcl	12 Feb 2010 00:01:25 -0000
@@ -85,15 +85,15 @@ proc mime-type {filename} {
 proc Puts {chan s} {puts $chan $s; puts $s}
 
 proc Service {chan addr port} {
-    chan event $chan readable [info coroutine]
+#    chan event $chan readable [info coroutine]
     while {1} {
         set meta {}
         chan configure $chan -buffering line -encoding iso8859-1 -translation crlf
-        chan configure $chan -blocking 0
-        yield
+        chan configure $chan -blocking 1
+ #       yield
         while {[gets $chan line] < 0} {
             if {[eof $chan]} {chan event $chan readable {}; close $chan; return}
-            yield
+  #          yield
         }
         if {[eof $chan]} {chan event $chan readable {}; close $chan; return}
         foreach {req url protocol} {GET {} HTTP/1.1} break
@@ -105,7 +105,7 @@ proc Service {chan addr port} {
                 puts [list $key [string trim $val]]
                 lappend meta [string tolower $key] [string trim $val]
             }
-            yield
+    #        yield
         }
 
         set encoding identity
@@ -134,6 +134,7 @@ proc Service {chan addr port} {
                     }
                     # Check for excess query bytes [Bug 2715421]
                     if {[dict get? $meta x-check-query] eq "yes"} {
+			error ARGGH
                         chan configure $chan -blocking 0
                         append query [read $chan]
                     }
@@ -204,13 +205,20 @@ proc Service {chan addr port} {
         if {$transfer eq "chunked"} {
             blow-chunks $data $chan $encoding
         } elseif {$encoding ne "identity"} {
-            puts -nonewline $chan [zlib $encoding $data]
+	    set z [zlib $encoding $data]
+            puts -nonewline $chan $z
+	    #puts "ulen:[string length $data]"
+	    #puts "zlen:[string length $z]"
         } else {
             puts -nonewline $chan $data
         }
         
         if {$close} {
-            chan event $chan readable {}
+            #chan event $chan readable {}
+#alex
+	    fconfigure $chan -blocking 1
+            #puts "flush $chan"
+	    flush $chan
             close $chan
             puts "close $chan"
             return
@@ -222,7 +230,8 @@ proc Service {chan addr port} {
 }
 
 proc Accept {chan addr port} {
-    coroutine client$chan Service $chan $addr $port
+#alex    coroutine client$chan Service $chan $addr $port
+    Service $chan $addr $port
     return
 }