diff --git a/collects/web-server/configuration.ss b/collects/web-server/configuration.ss index 55221e1a9e..47a1abb343 100644 --- a/collects/web-server/configuration.ss +++ b/collects/web-server/configuration.ss @@ -99,6 +99,7 @@ (define access (make-hash-table)) (define instances (make-hash-table)) (define scripts (box (make-hash-table 'equal))) + (define scripts-lock (make-semaphore 1)) (define make-servlet-namespace the-make-servlet-namespace))) ; begin stolen from commander.ss, which was stolen from private/drscheme/eval.ss diff --git a/collects/web-server/sig.ss b/collects/web-server/sig.ss index d769e14ee6..02f782c2b0 100644 --- a/collects/web-server/sig.ss +++ b/collects/web-server/sig.ss @@ -17,6 +17,7 @@ virtual-hosts access scripts ;; : equal-hash-table + scripts-lock initial-connection-timeout)) ; more here - rename diff --git a/collects/web-server/web-server-unit.ss b/collects/web-server/web-server-unit.ss index 26d92c9ea2..fb31088dae 100644 --- a/collects/web-server/web-server-unit.ss +++ b/collects/web-server/web-server-unit.ss @@ -143,7 +143,9 @@ [(string=? "/conf/refresh-servlets" path) ;; more here - this is broken - only out of date or specifically mentioned ;; scripts should be flushed. This destroys persistent state! - (set-box! config:scripts (make-hash-table 'equal)) + (call-with-semaphore config:scripts-lock + (lambda () + (set-box! config:scripts (make-hash-table 'equal)))) (output-response/method conn ((responders-servlets-refreshed (host-responders host-info))) @@ -590,9 +592,11 @@ ;; timestamps are no longer checked for performance. The cache must be explicitly ;; refreshed (see dispatch). (define (cached-load name) - (hash-table-get (unbox config:scripts) - name - (lambda () (reload-servlet-script name)))) + (call-with-semaphore config:scripts-lock + (lambda () + (hash-table-get (unbox config:scripts) + name + (lambda () (reload-servlet-script name)))))) ;; exn:i/o:filesystem:servlet-not-found = ;; (make-exn:fail:filesystem:exists:servlet str continuation-marks str sym) @@ -605,6 +609,7 @@ (cond [(load-servlet/path servlet-filename) => (lambda (svlt) + ; This is only called from cached-load, so config:scripts is locked (hash-table-put! (unbox config:scripts) servlet-filename svlt) svlt)] [else