Introducing error when send/suspend like operations used outside of servlet-instance

svn: r857

collects/web-server/dispatch-servlets.ss

@@ -209,6 +209,8 @@
                                    (paths-servlet (host-paths host-info))
                                    (url-path->string (url-path uri)))]
                [the-servlet (cached-load real-servlet-path)])
+          (let ([last-inst (thread-cell-ref current-servlet-instance)])
+            (thread-cell-set! current-servlet-instance #f)
             (with-handlers ([exn:servlet:instance?
                              (lambda (the-exn)
                                (output-response/method
@@ -218,8 +220,7 @@
                             [exn:servlet:continuation?
                              (lambda (the-exn)
                                ((exn:servlet:continuation-expiration-handler the-exn) req))])
-            (let* ([last-inst (thread-cell-ref current-servlet-instance)]
+              (let* ([inst 
-                   [inst 
                       (hash-table-get config:instances uk-instance
                                       (lambda ()
                                         (raise
@@ -255,9 +256,8 @@
                          (make-exn:servlet:continuation
                           "" (current-continuation-marks)
                           k-expiration-handler)))))
-              (thread-cell-set! current-servlet-instance last-inst)
+                (semaphore-post (servlet-instance-mutex inst))))
-              (semaphore-post (servlet-instance-mutex inst))
+            (thread-cell-set! current-servlet-instance last-inst)))))
-              )))))
       
       ;; ************************************************************
       ;; ************************************************************

collects/web-server/servlet-tables.ss

@@ -4,6 +4,7 @@
            (lib "list.ss")
            "timer.ss")
   (provide (struct exn:servlet:instance ())
+           (struct exn:servlet:current-instance ())
            (struct exn:servlet:continuation (expiration-handler))
            (struct servlet (handler namespace instance-expiration-handler))
            (struct execution-context (connection request suspend))
@@ -46,6 +47,8 @@
   (define-struct (exn:servlet:instance exn) ())
   ;; not found in the continuatin table
   (define-struct (exn:servlet:continuation exn) (expiration-handler))
+  ;; not in dynamic extent of servlet
+  (define-struct (exn:servlet:current-instance exn) ())
 
   (define-values (make-k-table reset-k-table get-k-id!)
     (let ([id-slot 'next-k-id])

collects/web-server/servlet.ss

@@ -32,23 +32,32 @@
   (define current-servlet-continuation-expiration-handler
     (make-parameter #f))
   
+  ;; get-current-servlet-instance : -> servlet
+  (define (get-current-servlet-instance)
+    (let ([inst (thread-cell-ref current-servlet-instance)])
+      (unless inst
+        (raise (make-exn:servlet:current-instance 
+                "(lib \"servlet.ss\" \"web-server\") used outside the dynamic-extent of a servlet-instance"
+                (current-continuation-marks))))
+      inst))
+  
   ;; adjust-timeout! : sec -> void
   ;; adjust the timeout on the servlet
   (define (adjust-timeout! secs)
-    (reset-timer (servlet-instance-timer (thread-cell-ref current-servlet-instance))
+    (reset-timer (servlet-instance-timer (get-current-servlet-instance))
                  secs))
 
   ;; send/back: response -> void
   ;; send a response and don't clear the continuation table
   (define (send/back resp)
-    (let ([ctxt (servlet-instance-context (thread-cell-ref current-servlet-instance))])
+    (let ([ctxt (servlet-instance-context (get-current-servlet-instance))])
       (output-response (execution-context-connection ctxt) resp)
       ((execution-context-suspend ctxt))))
 
   ;; send/finish: response -> void
   ;; send a response and clear the continuation table
   (define (send/finish resp)
-    (clear-continuations! (thread-cell-ref current-servlet-instance))
+    (clear-continuations! (get-current-servlet-instance))
     ; If we readjust the timeout to something small, the session will expire shortly
     ; we cannot wait for send/back to return, because it doesn't
     ; Also, we cannot get the initial-connection-timeout variable from here
@@ -61,7 +70,7 @@
   (define send/suspend
     (opt-lambda (response-generator [expiration-handler (current-servlet-continuation-expiration-handler)])
       (let/cc k
-        (let* ([inst (thread-cell-ref current-servlet-instance)]
+        (let* ([inst (get-current-servlet-instance)]
                [ctxt (servlet-instance-context inst)]
                [k-url (store-continuation!
                        k expiration-handler
@@ -75,7 +84,7 @@
   ;; clear the continuation table, then behave like send/suspend
   (define send/forward
     (opt-lambda (response-generator [expiration-handler (current-servlet-continuation-expiration-handler)])
-      (clear-continuations! (thread-cell-ref current-servlet-instance))
+      (clear-continuations! (get-current-servlet-instance))
       (send/suspend response-generator expiration-handler)))
   
   ;; send/suspend/callback : xexpr/callback? -> void