Changeset 12023 in project

Timestamp:

09/28/08 17:38:09 (12 years ago)

Author:

sjamaan

Message:

Implement request restarting

File:

• release/4/spiffy/trunk/spiffy.scm (modified) (4 diffs)

release/4/spiffy/trunk/spiffy.scm

@@ -38 +38 @@
 (module spiffy
   (start-server with-headers send-status send-static-file
-                current-request current-response current-file current-pathinfo
-                root-path server-port index-files mime-type-map default-mime-type
-                default-host
-                handle-directory handle-not-found)
+   current-request current-response current-file current-pathinfo
+   root-path server-port index-files mime-type-map default-mime-type default-host
+   handle-directory handle-not-found
+   restart-request)
 
 (import chicken scheme extras ports files data-structures)
@@ -97 +97 @@
                   "The resource you requested could not be found"))))
 
+
+;;; Internal parameters
+(define request-restarter (make-parameter #f))
 
 (define (send-status code reason #!optional text)
@@ -204 +207 @@
         (current-request))))
 
+(define (restart-request req)
+  ((request-restarter) req (request-restarter)))
+
 (define (handle-incoming-request in out)
   (parameterize ((current-request (read-request in))
@@ -211 +217 @@
                                            `((content-type text/html))))))
     (let ((path (uri-path (request-uri (current-request)))))
-      (parameterize ((current-request (normalize-current-request-uri)))
-            (if (and (uri-host (request-uri (current-request))) (pair? path))
-                (process-entry "" path)
-                ;; No host in the request? That's an error.
-                (send-status 400 "Bad request"
-                             "Your client sent a request that the server did not understand")))
+      (receive (req cont)
+        (call/cc (lambda (c) (values (normalize-current-request-uri) c)))
+        (parameterize ((current-request req)
+                       (request-restarter cont))
+          (if (and (uri-host (request-uri (current-request))) (pair? path))
+              (process-entry "" path)
+              ;; No host in the request? That's an error.
+              (send-status 400 "Bad request"
+                           "Your client sent a request that the server did not understand"))))
       ;; For now, just close the ports and allow the thread to exit
       (close-output-port out)