handler: remove global request mutex; isolate context via thread parameters

ober

d3e6fa180975e5467131668d5e64706a3dd85d5e

diff --git a/sinatra/context.ss b/sinatra/context.ss
index 426a3cf..871c6bb 100644
--- a/sinatra/context.ss
+++ b/sinatra/context.ss
@@ -1,3 +1,5 @@
+(import (only (chezscheme) make-thread-parameter))
+
 (export current-app
         current-request
         current-response
@@ -14,14 +16,16 @@
         splat
         captures)
 
-;; Dynamic parameters for request context
-(def current-app (make-parameter #f))
-(def current-request (make-parameter #f))
-(def current-response (make-parameter #f))
-(def current-params (make-parameter (hash)))
-(def current-halt-k (make-parameter #f))
-(def current-pass-k (make-parameter #f))
-(def current-raw-response (make-parameter #f))
+;; Per-thread dynamic parameters for request context. Each HTTP worker
+;; thread services one request at a time, so thread-local parameters give
+;; every concurrent request its own isolated context without a global lock.
+(def current-app (make-thread-parameter #f))
+(def current-request (make-thread-parameter #f))
+(def current-response (make-thread-parameter #f))
+(def current-params (make-thread-parameter (hash)))
+(def current-halt-k (make-thread-parameter #f))
+(def current-pass-k (make-thread-parameter #f))
+(def current-raw-response (make-thread-parameter #f))
 
 ;; Convenience accessors for use inside route handlers
 
diff --git a/sinatra/handler-test.ss b/sinatra/handler-test.ss
index c6aa8ba..087dc44 100644
--- a/sinatra/handler-test.ss
+++ b/sinatra/handler-test.ss
@@ -4,6 +4,7 @@
         (std net httpd)
         (prefix (std net thread-httpd) th:)
         (std format)
+        (only (chezscheme) current-time time-second time-nanosecond)
         (sinatra app)
         (sinatra handler)
         (sinatra context)
@@ -12,6 +13,15 @@
 
 (export handler-test)
 
+;; Helper: run thunk, returning (values result elapsed-nanoseconds).
+(def (elapsed-nanos thunk)
+  (let* ((t0 (current-time))
+         (result (thunk))
+         (t1 (current-time)))
+    (values result
+            (- (+ (* (time-second t1) 1000000000) (time-nanosecond t1))
+               (+ (* (time-second t0) 1000000000) (time-nanosecond t0))))))
+
 ;; Find a free port for testing
 (def (find-free-port)
   (+ 10000 (random-integer 50000)))
@@ -167,4 +177,43 @@
           (lambda (port)
             (let ((resp (http-get (format "http://127.0.0.1:~a/test" port))))
               (check (request-text resp) => "first"))))))
+
+    (test-case "concurrent handler: slow route does not block fast route"
+      (let ((app (make-sinatra-app)))
+        (sinatra-get app "/slow"
+          (lambda () (thread-sleep! 0.5) "slow done"))
+        (sinatra-get app "/fast"
+          (lambda () "fast done"))
+        (let* ((handler (sinatra-handler app))
+               (slow-req (th:make-request "GET" "/slow" "HTTP/1.1" '() ""))
+               (fast-req (th:make-request "GET" "/fast" "HTTP/1.1" '() ""))
+               (slow-thread (make-thread (lambda () (handler slow-req)) 'slow)))
+          (thread-start! slow-thread)
+          (let-values (((resp ns) (elapsed-nanos
+                                    (lambda ()
+                                      (handler fast-req)))))
+            (check (th:response-status resp) => 200)
+            (check (th:response-body resp) => "fast done")
+            (check (< ns 200000000) => #t))
+          (let ((slow-resp (thread-join! slow-thread)))
+            (check (th:response-status slow-resp) => 200)
+            (check (th:response-body slow-resp) => "slow done")))))
+
+    (test-case "concurrent handler: per-request params and response are isolated"
+      (let ((app (make-sinatra-app)))
+        (sinatra-get app "/hello/:name"
+          (lambda ()
+            (thread-sleep! 0.05)
+            (string-append "Hi " (param "name"))))
+        (let* ((handler (sinatra-handler app))
+               (req-a (th:make-request "GET" "/hello/Alice" "HTTP/1.1" '() ""))
+               (req-b (th:make-request "GET" "/hello/Bob" "HTTP/1.1" '() ""))
+               (t-a (make-thread (lambda () (handler req-a)) 'a))
+               (t-b (make-thread (lambda () (handler req-b)) 'b)))
+          (thread-start! t-a)
+          (thread-start! t-b)
+          (let ((resp-a (thread-join! t-a))
+                (resp-b (thread-join! t-b)))
+            (check (th:response-body resp-a) => "Hi Alice")
+            (check (th:response-body resp-b) => "Hi Bob")))))
   ))
diff --git a/sinatra/handler.ss b/sinatra/handler.ss
index 826e5e7..6d181d2 100644
--- a/sinatra/handler.ss
+++ b/sinatra/handler.ss
@@ -1,9 +1,5 @@
 (import (std text json)
         (std sugar)
-        (rename (only (std misc thread) make-mutex mutex-lock! mutex-unlock!)
-                (make-mutex sinatra-make-mutex)
-                (mutex-lock! sinatra-mutex-lock!)
-                (mutex-unlock! sinatra-mutex-unlock!))
         (only (std secmon telemetry)
               secmon-telemetry-from-env
               secmon-telemetry-emit!)
@@ -22,24 +18,16 @@
 
 (export sinatra-handler)
 
-(def *sinatra-handler-context-mutex* (sinatra-make-mutex))
-
 ;; Create an httpd handler function for the given sinatra app.
 ;; Returns (lambda (req) ...) suitable for Jerboa std/net/httpd.
+;; Each request runs on its own httpd worker thread; per-request context
+;; is isolated by Chez parameters under parameterize inside make-base-handler,
+;; which are dynamically scoped to the handling thread. No global lock is
+;; held: a slow request cannot block a concurrent fast request.
 (def (sinatra-handler app)
   (let ((base-handler (make-base-handler app))
         (mw-list (app-middleware app)))
-    (let ((handler (compose-middleware mw-list base-handler)))
-      (lambda (req)
-        ;; Chez dynamic parameters used for request context are not isolated
-        ;; reliably across simultaneous raw HTTP worker threads. Keep request
-        ;; context deterministic; expensive preprocessing runs in separate
-        ;; worker processes and all normal route results are cached.
-        (sinatra-mutex-lock! *sinatra-handler-context-mutex*)
-        (try
-          (handler req)
-          (finally
-            (sinatra-mutex-unlock! *sinatra-handler-context-mutex*)))))))
+    (compose-middleware mw-list base-handler)))
 
 ;; secmon daemon telemetry
 
diff --git a/sinatra/helpers.ss b/sinatra/helpers.ss
index a334e7c..c3efc0d 100644
--- a/sinatra/helpers.ss
+++ b/sinatra/helpers.ss
@@ -1,4 +1,5 @@
 (import (std text json)
+        (only (chezscheme) make-thread-parameter)
         (sinatra context)
         (sinatra response)
         (sinatra request)
@@ -27,8 +28,8 @@
         production?
         test?)
 
-;; Parameter: holds exception in error handler context
-(def current-error (make-parameter #f))
+;; Per-thread parameter: holds exception in error handler context
+(def current-error (make-thread-parameter #f))
 
 ;; Halt — immediately finish the response
 (def (halt . args)
diff --git a/sinatra/logging.ss b/sinatra/logging.ss
index ab1327a..c792bae 100644
--- a/sinatra/logging.ss
+++ b/sinatra/logging.ss
@@ -1,4 +1,5 @@
 (import (std format)
+        (only (chezscheme) make-thread-parameter)
         (sinatra context)
         (sinatra request)
         (sinatra response))
@@ -7,8 +8,8 @@
         sinatra-logger
         current-logger)
 
-;; Parameter for logger output port
-(def current-logger (make-parameter (current-output-port)))
+;; Per-thread parameter for logger output port
+(def current-logger (make-thread-parameter (current-output-port)))
 
 ;; Log a completed request
 (def (log-request method path status duration-ms)
diff --git a/sinatra/session.ss b/sinatra/session.ss
index 1dd1259..00fd2d5 100644
--- a/sinatra/session.ss
+++ b/sinatra/session.ss
@@ -1,6 +1,7 @@
 (import (std text json)
         (std text base64)
         (only (std crypto) hmac-sha256)
+        (only (chezscheme) make-thread-parameter)
         (sinatra cookies)
         (sinatra context)
         (sinatra response)
@@ -19,8 +20,8 @@
         encode-session
         decode-session)
 
-;; Parameter holding current session data
-(def current-session (make-parameter #f))
+;; Per-thread parameter holding current session data for the active request
+(def current-session (make-thread-parameter #f))
 
 ;; Session cookie name
 (def +session-cookie-name+ "sinatra.session")