From 9711d10c81cb0b4b76f6f5018c51a686e5c3809c Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Fri, 31 Aug 2007 18:34:08 +0000
Subject: [PATCH] Arjun

svn: r7243
---
 collects/web-server/servlet-env.ss | 102 ++++++++++++++---------------
 1 file changed, 49 insertions(+), 53 deletions(-)

diff --git a/collects/web-server/servlet-env.ss b/collects/web-server/servlet-env.ss
index 9253582f85..f61fed3a9b 100644
--- a/collects/web-server/servlet-env.ss
+++ b/collects/web-server/servlet-env.ss
@@ -1,14 +1,14 @@
 (module servlet-env mzscheme
   (require (prefix net: (lib "sendurl.ss" "net"))
-           (lib "unit.ss"))
+           (lib "list.ss"))
   (require "web-server.ss"
            "configuration/configuration-table.ss"
-           "web-config-unit.ss"
-           "web-config-sig.ss"
            "private/util.ss"
            "managers/timeouts.ss"
            "private/servlet.ss"
-           "private/cache-table.ss")
+           "configuration/namespace.ss"
+           "private/cache-table.ss"           
+           (prefix servlets: "dispatchers/dispatch-servlets.ss"))
   (require "servlet.ss")
   (provide (rename on-web:syntax on-web)
            send-url
@@ -30,39 +30,38 @@
                   "servlets/standalone.ss")))]))
   
   (define (on-web servlet-expr the-port the-path)
-    (let* ([standalone-url
-            (format "http://localhost:~a/~a" the-port the-path)]
-           [final-value
-            (void)]
-           [final-conn
-            (void)]
-           [sema
-            (make-semaphore 0)]
-           [new-servlet
-            (lambda (initial-request)
-              (let ([v (servlet-expr initial-request)])
-                (set! final-value v)
-                (semaphore-post sema)
-                (if (response? v)
-                    v
-                    `(html (head (title "Servlet has ended."))
-                           (body (p "This servlet has ended, please return to the interaction window."))))))]
-           [shutdown-server
-            (serve/web-config@ (build-standalone-servlet-configuration the-port the-path new-servlet))])
-      ((send-url) standalone-url #t)
-      ; Wait for final call
-      (semaphore-wait sema)
-      ; XXX: Find a way to wait for final HTML to be sent
-      ; Shutdown the server
-      (shutdown-server)
-      final-value))
-  
-  (define (build-standalone-servlet-configuration the-port the-path the-servlet)
-    (let ([basic-configuration@ (configuration-table->web-config@ default-configuration-table-path)]
-          [the-scripts (make-cache-table)])
-      (define-values/invoke-unit basic-configuration@ 
-        (import) 
-        (export (prefix i: web-config^)))
+    (let*-values
+        ([(standalone-url)
+          (format "http://localhost:~a/~a" the-port the-path)]
+         [(final-value)
+          (void)]
+         [(final-conn)
+          (void)]
+         [(sema)
+          (make-semaphore 0)]
+         [(make-servlet-namespace) (make-make-servlet-namespace)]
+         [(new-servlet)
+          (lambda (initial-request)
+            (let ([v (servlet-expr initial-request)])
+              (set! final-value v)
+              (semaphore-post sema)
+              (if (response? v)
+                  v
+                  `(html (head (title "Servlet has ended."))
+                         (body (p "This servlet has ended, please return to the interaction window."))))))]
+         [(the-scripts) (make-cache-table)]
+         [(clear-cache! servlet-dispatch)
+          (servlets:make (box the-scripts)
+                         #:make-servlet-namespace make-servlet-namespace
+                         #:url->path
+                         (lambda _
+                           (values (build-path (directory-part default-configuration-table-path)
+                                         "default-web-root" "."
+                                         the-path)
+                                   empty)))]
+         [(shutdown-server)
+          (serve #:dispatch servlet-dispatch
+                 #:port 9999)])
       (cache-table-lookup! the-scripts
                            (string->symbol
                             (path->string
@@ -71,20 +70,17 @@
                                          the-path)))
                            (lambda ()
                              (make-servlet (make-custodian)
-                                           (i:make-servlet-namespace)
+                                           (make-servlet-namespace)
                                            (create-timeout-manager
-                                             (lambda (request)
-                                             `(html (head "Return to the interaction window.")
-                                                    (body (p "Return to the interaction window."))))
-                                             30 30)
-                                           the-servlet)))
-      (unit
-        (import)
-        (export web-config^)
-        (define port the-port)
-        (define max-waiting i:max-waiting)
-        (define listen-ip i:listen-ip)
-        (define initial-connection-timeout i:initial-connection-timeout)
-        (define virtual-hosts i:virtual-hosts)
-        (define scripts (box the-scripts))
-        (define make-servlet-namespace i:make-servlet-namespace)))))
\ No newline at end of file
+                                            (lambda (request)
+                                              `(html (head "Return to the interaction window.")
+                                                     (body (p "Return to the interaction window."))))
+                                            30 30)
+                                           new-servlet)))
+      ((send-url) standalone-url #t)
+      ; Wait for final call
+      (semaphore-wait sema)
+      ; XXX: Find a way to wait for final HTML to be sent
+      ; Shutdown the server
+      (shutdown-server)
+      final-value)))
\ No newline at end of file