From fbea030c27d33f0ecb40b31f2345ca434a087f1b Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Tue, 3 Jan 2012 14:11:00 -0700
Subject: [PATCH] Fixing PR12443

There is a big comment in thread.rkt that explains the problem and the
"fix". I think something better could and should be done, but I don't
know what it is.

original commit: 022ce2d8d7de60d63d21eb67119466283d9e8be3
---
 collects/mzlib/thread.rkt | 111 ++++++++++++++++++++++----------------
 1 file changed, 66 insertions(+), 45 deletions(-)

diff --git a/collects/mzlib/thread.rkt b/collects/mzlib/thread.rkt
index c4bcf7a..0f2b955 100644
--- a/collects/mzlib/thread.rkt
+++ b/collects/mzlib/thread.rkt
@@ -59,51 +59,72 @@
     (let ([l (tcp-listen port-number 5 #t)]
           [can-break? (break-enabled)])
       (dynamic-wind
-        void
-        (lambda ()
-          ;; All connections should use the same parameterization,
-          ;;  to facilitate transferring continuations from one
-          ;;  connection to another:
-          (let ([paramz (current-parameterization)])
-            ;; Loop to handle connections:
-            (let loop ()
-              (with-handlers ([exn:fail:network? handle-exn])
-                ;; Make a custodian for the next session:
-                (let ([c (make-custodian)])
-                  (parameterize ([current-custodian c])
-                    ;; disable breaks during session set-up...
-                    (parameterize-break #f
-                      ;; ... but enable breaks while blocked on an accept:
-                      (let-values ([(r w) ((if can-break?
-                                             tcp-accept/enable-break
-                                             tcp-accept)
-                                           l)])
-                        ;; Handler thread:
-                        (let ([t (thread (lambda ()
-                                           ;; First, install the parameterization
-                                           ;;  used for all connections:
-                                           (call-with-parameterization
-                                            paramz
-                                            (lambda ()
-                                              ;; Install this connection's custodian
-                                              ;;  for this thread in the shared
-                                              ;;  parameterization:
-                                              (current-custodian c)
-                                              ;; Enable breaking:
-                                              (when can-break?
-                                                (break-enabled #t))
-                                              ;; Call the handler
-                                              (handler r w)))))])
-                          ;; Clean-up and timeout thread:
-                          (thread (lambda ()
-                                    (sync/timeout connection-timeout t)
-                                    (when (thread-running? t)
-                                      ;; Only happens if connection-timeout is not #f
-                                      (break-thread t))
-                                    (sync/timeout connection-timeout t)
-                                    (custodian-shutdown-all c)))))))))
-              (loop))))
-        (lambda () (tcp-close l)))))
+          void
+          (lambda ()
+            ;; All connections should use the same parameterization,
+            ;;  to facilitate transferring continuations from one
+            ;;  connection to another:
+            (let ([paramz (current-parameterization)])
+              ;; Loop to handle connections:
+              (let loop ()
+                ;; Introducing this thread causes PR12443 to no longer fail.
+                
+                ;; The Web Server will definitely kill the custodian
+                ;; associated with the resources of the connection. I
+                ;; think what is going on is that the loop here is
+                ;; attached to one of these custodians (eventually)
+                ;; and then the listening loop thread gets killed
+                ;; too. This patch basically just disconnects the loop
+                ;; from the new custodian. The error reported in the
+                ;; PR still shows up, but it has no effect on the
+                ;; response time/etc, whereas before it would stop
+                ;; listening and 'ab' would fail.
+                (thread-wait
+                 (thread
+                  (λ ()
+                     (with-handlers 
+                      ([exn:fail:network? handle-exn])
+                      ;; Make a custodian for the next session:
+                      (let ([c (make-custodian)])
+                        (parameterize
+                         ([current-custodian c])
+                         ;; disable breaks during session set-up...
+                         (parameterize-break 
+                          #f
+                          ;; ... but enable breaks while blocked on an accept:
+                          (let-values ([(r w) ((if can-break?
+                                                   tcp-accept/enable-break
+                                                   tcp-accept)
+                                               l)])
+                            ;; Handler thread:
+                            (let ([t 
+                                   (thread 
+                                    (lambda ()
+                                      ;; First, install the parameterization
+                                      ;;  used for all connections:
+                                      (call-with-parameterization
+                                       paramz
+                                       (lambda ()
+                                         ;; Install this connection's custodian
+                                         ;;  for this thread in the shared
+                                         ;;  parameterization:
+                                         (current-custodian c)
+                                         ;; Enable breaking:
+                                         (when can-break?
+                                               (break-enabled #t))
+                                         ;; Call the handler
+                                         (handler r w)))))])
+                              ;; Clean-up and timeout thread:
+                              (thread 
+                               (lambda ()
+                                 (sync/timeout connection-timeout t)
+                                 (when (thread-running? t)
+                                       ;; Only happens if connection-timeout is not #f
+                                       (break-thread t))
+                                 (sync/timeout connection-timeout t)
+                                 (custodian-shutdown-all c))))))))))))
+                (loop))))
+          (lambda () (tcp-close l)))))
 
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;; Couroutine