Moving config:scripts back inside the adt barrier

svn: r12348

collects/tests/web-server/dispatchers/dispatch-servlets-test.ss

@@ -17,7 +17,6 @@
 (define (mkd p)
   (define-values (! u->s)
     (servlets:make-cached-url->servlet
-     (box (make-cache-table))
      (lambda _ (values p url0s))
      (servlets:make-default-path->servlet)))
   (define d

collects/web-server/dispatchers/dispatch-servlets.ss

@@ -107,19 +107,18 @@
 (provide/contract
  [url->servlet/c contract?]
  [make-cached-url->servlet
-  (-> (box/c cache-table?)
+  (-> url->path/c
-      url->path/c
       path->servlet/c
       (values (-> void)
               url->servlet/c))])
 
 (define (make-cached-url->servlet         
-         config:scripts
          url->path 
          path->servlet)
+  (define config:scripts (make-cache-table))
   (values (lambda ()
             ;; This is broken - only out of date or specifically mentioned scripts should be flushed.  This destroys persistent state!
-            (cache-table-clear! (unbox config:scripts)))
+            (cache-table-clear! config:scripts))
           (lambda (uri)
             (define-values (servlet-path _)
               (with-handlers
@@ -128,7 +127,7 @@
                                    (exn-message e)
                                    (exn-continuation-marks e))))])
                 (url->path uri)))
-            (cache-table-lookup! (unbox config:scripts)
+            (cache-table-lookup! config:scripts
                                  (string->symbol (path->string servlet-path))
                                  (lambda () (path->servlet servlet-path))))))
 

collects/web-server/scribblings/dispatchers.scrbl

@@ -372,14 +372,13 @@ Equivalent to @scheme[(path? . -> . servlet?)].
 @defthing[url->servlet/c contract?]{Equivalent to @scheme[(url? . -> . servlet?)]}
 
 @defproc[(make-cached-url->servlet
-          [config:scripts (box/c cache-table?)]
           [url->path url->path/c]
           [path->serlvet path->servlet/c])         
          (values (-> void)
                  url->servlet/c)]{
  The first return value flushes the cache. 
  The second is a procedure that uses @scheme[url->path] to resolve the URL to a path, then uses @scheme[path->servlet] to resolve
- that path to a servlet, caching the results in @scheme[config:scripts].
+ that path to a servlet, caching the results in an internal table.
 }
                         
 @defproc[(make [url->servlet url->servlet/c]

collects/web-server/scribblings/web-config-unit.scrbl

@@ -25,10 +25,6 @@ Provides contains the following identifiers.
  Contains the configuration of individual virtual hosts.
 }
 
-@defthing[scripts (box/c (cache-table? path? servlet?))]{
- Contains initially loaded servlets.
-}
-
 @defthing[initial-connection-timeout integer?]{
  Specifies the initial timeout given to a connection.
 }

collects/web-server/servlet-env.ss

@@ -94,67 +94,65 @@
                        [file-not-found-path (build-path server-root-path "conf" "not-found.html")]
                        #:mime-types-path
                        [mime-types-path (build-path server-root-path "mime.types")])
-  (let*-values
+  (define standalone-url
-      ([(standalone-url)
+    (format "http://localhost:~a~a" the-port servlet-path))
-        (format "http://localhost:~a~a" the-port servlet-path)]
+  (define make-servlet-namespace
-       [(make-servlet-namespace) (make-make-servlet-namespace
+    (make-make-servlet-namespace
-                                  #:to-be-copied-module-specs servlet-namespace)]
+     #:to-be-copied-module-specs servlet-namespace))
-       [(the-scripts) (make-cache-table)]
+  (define sema (make-semaphore 0))
-       [(sema) (make-semaphore 0)]
+  (define servlet
-       [(servlet)
+    (parameterize ([current-custodian (make-custodian)]
-        (parameterize ([current-custodian (make-custodian)]
+                   [current-namespace
-                       [current-namespace
+                    (make-servlet-namespace
-                        (make-servlet-namespace
+                     #:additional-specs
-                         #:additional-specs
+                     servlets:default-module-specs)])
-                         servlets:default-module-specs)])
+      (servlets:make-v2.servlet servlet-current-directory manager start)))
-          (servlets:make-v2.servlet servlet-current-directory manager start))]
+  (define dispatcher
-       [(dispatcher)
+    (sequencer:make
-        (sequencer:make
+     (if quit?
-         (if quit?
-             (filter:make 
-              #rx"^/quit$"
-              (quit-server sema))
-             (lambda _ (next-dispatcher)))
          (filter:make 
-          servlet-regexp
+          #rx"^/quit$"
-          (servlets:make (lambda (url) servlet)))
+          (quit-server sema))
-         (let-values ([(clear-cache! url->servlet)
+         (lambda _ (next-dispatcher)))
-                       (servlets:make-cached-url->servlet
+     (filter:make
-                        (box the-scripts)
+      servlet-regexp
-                        (fsmap:filter-url->path
+      (servlets:make (lambda (url) servlet)))
-                         #rx"\\.(ss|scm)$"
+     (let-values ([(clear-cache! url->servlet)
-                         (fsmap:make-url->valid-path
+                   (servlets:make-cached-url->servlet
-                          (fsmap:make-url->path servlets-root)))
+                    (fsmap:filter-url->path
-                        (servlets:make-default-path->servlet
+                     #rx"\\.(ss|scm)$"
-                         #:make-servlet-namespace make-servlet-namespace))])
+                     (fsmap:make-url->valid-path
-           (servlets:make url->servlet))
+                      (fsmap:make-url->path servlets-root)))
-         (apply sequencer:make
+                    (servlets:make-default-path->servlet
-                (map (lambda (extra-files-path)
+                     #:make-servlet-namespace make-servlet-namespace))])
-                       (files:make 
+       (servlets:make url->servlet))
-                        #:url->path (fsmap:make-url->path
+     (apply sequencer:make
-                                     extra-files-path)
+            (map (lambda (extra-files-path)
-                        #:path->mime-type (make-path->mime-type mime-types-path)
+                   (files:make 
-                        #:indices (list "index.html" "index.htm")))
+                    #:url->path (fsmap:make-url->path
-                     extra-files-paths))
+                                 extra-files-path)
-         (files:make 
+                    #:path->mime-type (make-path->mime-type mime-types-path)
-          #:url->path (fsmap:make-url->path 
+                    #:indices (list "index.html" "index.htm")))
-                       (build-path server-root-path "htdocs"))
+                 extra-files-paths))
-          #:path->mime-type (make-path->mime-type (build-path server-root-path "mime.types"))
+     (files:make 
-          #:indices (list "index.html" "index.htm"))
+      #:url->path (fsmap:make-url->path 
-         (lift:make (gen-file-not-found-responder file-not-found-path)))]
+                   (build-path server-root-path "htdocs"))
-       [(shutdown-server)
+      #:path->mime-type (make-path->mime-type (build-path server-root-path "mime.types"))
-        (serve #:dispatch dispatcher
+      #:indices (list "index.html" "index.htm"))
-               #:listen-ip listen-ip
+     (lift:make (gen-file-not-found-responder file-not-found-path))))
-               #:port the-port)])    
+  (define shutdown-server
-    (when launch-browser?
+    (serve #:dispatch dispatcher
-      ((send-url) standalone-url #t))
+           #:listen-ip listen-ip
-    (printf "Your Web application is running at ~a.~n" standalone-url)
+           #:port the-port))
-    (printf "Click 'Stop' at any time to terminate the Web Server.~n")
+  (when launch-browser?
-    (with-handlers
+    ((send-url) standalone-url #t))
-        ([exn:break?
+  (printf "Your Web application is running at ~a.~n" standalone-url)
-          (lambda (exn)
+  (printf "Click 'Stop' at any time to terminate the Web Server.~n")
-            (printf "~nWeb Server stopped.~n")
+  (with-handlers
-            (shutdown-server))])
+      ([exn:break?
-      (semaphore-wait/enable-break sema))
+        (lambda (exn)
-    ; We shouldn't get here, because nothing posts to the semaphore. But just in case...
+          (printf "~nWeb Server stopped.~n")
-    (shutdown-server)))
+          (shutdown-server))])
+    (semaphore-wait/enable-break sema))
+  ; We shouldn't get here, because nothing posts to the semaphore. But just in case...
+  (shutdown-server))

collects/web-server/web-config-sig.ss

@@ -2,7 +2,6 @@
 
 max-waiting 
 virtual-hosts
-scripts
 initial-connection-timeout
 port
 listen-ip

collects/web-server/web-config-unit.ss

@@ -88,7 +88,6 @@
     (define listen-ip the-listen-ip)
     (define initial-connection-timeout (configuration-table-initial-connection-timeout table))
     (define virtual-hosts the-virtual-hosts)
-    (define scripts (box (make-cache-table)))
     (define make-servlet-namespace the-make-servlet-namespace)))
 
 ; apply-default-functions-to-host-table : str host-table -> host

collects/web-server/web-server-unit.ss

@@ -77,7 +77,6 @@
                             ((responders-collect-garbage (host-responders host-info)))))     
      (let-values ([(clear-cache! url->servlet)
                    (servlets:make-cached-url->servlet
-                    config:scripts
                     (fsmap:filter-url->path
                      #rx"\\.(ss|scm)$"
                      (fsmap:make-url->valid-path