From 2b5797c2b1c6e2a734eab76582b847a38a69240c Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Mon, 6 Feb 2006 19:34:07 +0000
Subject: [PATCH] correcting bug related to help-desk versus standalone

svn: r2148
---
 collects/web-server/response.ss        | 49 ++++++++++++--------------
 collects/web-server/web-server-unit.ss |  6 ++--
 2 files changed, 26 insertions(+), 29 deletions(-)

diff --git a/collects/web-server/response.ss b/collects/web-server/response.ss
index 9698c0563b..903d492e7b 100644
--- a/collects/web-server/response.ss
+++ b/collects/web-server/response.ss
@@ -111,17 +111,21 @@
   (define DAYS
     #("Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"))
   
+  (define (ext:wrap f)
+    (lambda (conn . args)
+      (if (connection-close? conn)
+          (error 'output-response "Attempt to write to closed connection.")
+          (with-handlers ([exn? (lambda (exn)
+                                  (kill-connection! conn)
+                                  (raise exn))])
+            (call-with-semaphore (connection-mutex conn)
+                                 (lambda ()
+                                   (apply f conn args)
+                                   (flush-output (connection-o-port conn))))))))
+      
+  
   ;; **************************************************
   ;; output-response: connection response -> void
-  (define (ext:output-response conn resp)
-    (with-handlers ([exn? (lambda (exn)
-                            (kill-connection! conn)
-                            (raise exn))])
-      (call-with-semaphore (connection-mutex conn)
-                           (lambda ()
-                             (output-response conn resp)
-                             (flush-output (connection-o-port conn))))))
-  
   (define (output-response conn resp)
     (cond
       [(response/full? resp)
@@ -171,6 +175,9 @@
               (display str o-port)
               (newline o-port)))))]))
   
+  (define ext:output-response
+    (ext:wrap output-response))
+
   ;; response/full->size: response/full -> number
   ;; compute the size for a response/full
   (define (response/full->size resp/f)
@@ -183,15 +190,6 @@
   
   ;; **************************************************
   ;; output-file: connection path symbol bytes -> void
-  (define (ext:output-file conn file-path method mime-type)
-    (with-handlers ([exn? (lambda (exn)
-                            (kill-connection! conn)
-                            (raise exn))])
-      (call-with-semaphore (connection-mutex conn)
-                           (lambda ()
-                             (output-file conn file-path method mime-type)
-                             (flush-output (connection-o-port conn))))))
-  
   (define (output-file conn file-path method mime-type)
     (output-headers conn 200 "Okay"
                     `(("Content-length: " ,(file-size file-path)))
@@ -204,18 +202,12 @@
         (call-with-input-file file-path
           (lambda (i-port) (copy-port i-port (connection-o-port conn)))))))
   
+  (define ext:output-file
+    (ext:wrap output-file))
+
   ;; **************************************************
   ;; output-response/method: connection response/full symbol -> void
   ;; If it is a head request output headers only, otherwise output as usual
-  (define (ext:output-response/method conn resp meth)
-    (with-handlers ([exn? (lambda (exn)
-                            (kill-connection! conn)
-                            (raise exn))])
-      (call-with-semaphore (connection-mutex conn)
-                           (lambda ()
-                             (output-response/method conn resp meth)
-                             (flush-output (connection-o-port conn))))))
-  
   (define (output-response/method conn resp meth)
     (cond
       [(eqv? meth 'head)
@@ -224,6 +216,9 @@
       [else
        (output-response conn resp)]))
   
+  (define ext:output-response/method
+    (ext:wrap output-response/method))
+
   ;; **************************************************
   ;; output-headers/response: connection response (listof (listof string)) -> void
   ;; Write the headers for a response to an output port
diff --git a/collects/web-server/web-server-unit.ss b/collects/web-server/web-server-unit.ss
index e3548c149f..92b2f12372 100644
--- a/collects/web-server/web-server-unit.ss
+++ b/collects/web-server/web-server-unit.ss
@@ -95,7 +95,6 @@
                                        ip op (current-custodian) #f)])
              (with-handlers ([exn:fail:network?
                               (lambda (e)
-                                (set-connection-close?! conn #t)
                                 (kill-connection! conn)
                                 (raise e))])
                (serve-connection conn port-addresses))))))
@@ -105,9 +104,12 @@
       (define (serve-connection conn port-addresses)
         (let connection-loop ()
           (let-values ([(req close?) (config:read-request conn config:port port-addresses)])
-            (set-connection-close?! conn close?)
+            (unless close?
+              (set-connection-close?! conn #f))
             (adjust-connection-timeout! conn config:initial-connection-timeout)
             (config:dispatch conn req)
+            (when close?
+              (set-connection-close?! conn #t))
             (cond
               [(connection-close? conn) (kill-connection! conn)]
               [else (connection-loop)]))))))