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,21 +94,20 @@
                        [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)]
                    [current-namespace
                     (make-servlet-namespace
                      #:additional-specs
                      servlets:default-module-specs)])
-          (servlets:make-v2.servlet servlet-current-directory manager start))]
+      (servlets:make-v2.servlet servlet-current-directory manager start)))
-       [(dispatcher)
+  (define dispatcher
     (sequencer:make
      (if quit?
          (filter:make 
@@ -120,7 +119,6 @@
       (servlets:make (lambda (url) servlet)))
      (let-values ([(clear-cache! url->servlet)
                    (servlets:make-cached-url->servlet
-                        (box the-scripts)
                     (fsmap:filter-url->path
                      #rx"\\.(ss|scm)$"
                      (fsmap:make-url->valid-path
@@ -141,11 +139,11 @@
                    (build-path server-root-path "htdocs"))
       #:path->mime-type (make-path->mime-type (build-path server-root-path "mime.types"))
       #:indices (list "index.html" "index.htm"))
-         (lift:make (gen-file-not-found-responder file-not-found-path)))]
+     (lift:make (gen-file-not-found-responder file-not-found-path))))
-       [(shutdown-server)
+  (define shutdown-server
     (serve #:dispatch dispatcher
            #:listen-ip listen-ip
-               #:port the-port)])    
+           #:port the-port))
   (when launch-browser?
     ((send-url) standalone-url #t))
   (printf "Your Web application is running at ~a.~n" standalone-url)
@@ -157,4 +155,4 @@
           (shutdown-server))])
     (semaphore-wait/enable-break sema))
   ; We shouldn't get here, because nothing posts to the semaphore. But just in case...
-    (shutdown-server)))
+  (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