Simplifying
svn: r6621
This commit is contained in:
parent
1f0c06c0e8
commit
e433ec1144
|
@ -11,10 +11,9 @@
|
||||||
"../servlet/web-cells.ss"
|
"../servlet/web-cells.ss"
|
||||||
"../servlet/web.ss"
|
"../servlet/web.ss"
|
||||||
"../configuration/responders.ss"
|
"../configuration/responders.ss"
|
||||||
|
"../configuration/namespace.ss"
|
||||||
"../managers/manager.ss"
|
"../managers/manager.ss"
|
||||||
"../managers/timeouts.ss"
|
"../managers/timeouts.ss"
|
||||||
"../managers/lru.ss"
|
|
||||||
"../managers/none.ss"
|
|
||||||
"../private/servlet.ss"
|
"../private/servlet.ss"
|
||||||
"../private/cache-table.ss"
|
"../private/cache-table.ss"
|
||||||
"../private/util.ss")
|
"../private/util.ss")
|
||||||
|
@ -23,9 +22,11 @@
|
||||||
(provide make)
|
(provide make)
|
||||||
|
|
||||||
(define interface-version 'v1)
|
(define interface-version 'v1)
|
||||||
(define/kw (make config:instances config:scripts config:make-servlet-namespace
|
(define/kw (make config:scripts
|
||||||
#:key
|
#:key
|
||||||
url->path
|
url->path
|
||||||
|
[make-servlet-namespace
|
||||||
|
(make-make-servlet-namespace)]
|
||||||
[responders-servlet-loading
|
[responders-servlet-loading
|
||||||
servlet-loading-responder]
|
servlet-loading-responder]
|
||||||
[responders-servlet
|
[responders-servlet
|
||||||
|
@ -183,7 +184,7 @@
|
||||||
|
|
||||||
;; load-servlet/path path -> servlet
|
;; load-servlet/path path -> servlet
|
||||||
(define (load-servlet/path a-path)
|
(define (load-servlet/path a-path)
|
||||||
(parameterize ([current-namespace (config:make-servlet-namespace
|
(parameterize ([current-namespace (make-servlet-namespace
|
||||||
#:additional-specs
|
#:additional-specs
|
||||||
'((lib "servlet.ss" "web-server")
|
'((lib "servlet.ss" "web-server")
|
||||||
(lib "servlet.ss" "web-server" "private")
|
(lib "servlet.ss" "web-server" "private")
|
||||||
|
@ -210,17 +211,7 @@
|
||||||
(v1.module->v1.lambda timeout start)))]
|
(v1.module->v1.lambda timeout start)))]
|
||||||
[(v2 v2-transitional) ; XXX: Depreciate v2-transitional
|
[(v2 v2-transitional) ; XXX: Depreciate v2-transitional
|
||||||
(let ([start (dynamic-require module-name 'start)]
|
(let ([start (dynamic-require module-name 'start)]
|
||||||
[manager (with-handlers
|
[manager (dynamic-require module-name 'manager)])
|
||||||
([exn:fail:contract?
|
|
||||||
(lambda (exn)
|
|
||||||
(define timeout (dynamic-require module-name 'timeout))
|
|
||||||
(define instance-expiration-handler
|
|
||||||
(dynamic-require module-name 'instance-expiration-handler))
|
|
||||||
(create-timeout-manager
|
|
||||||
instance-expiration-handler
|
|
||||||
timeouts-servlet-connection
|
|
||||||
timeout))])
|
|
||||||
(dynamic-require module-name 'manager))])
|
|
||||||
(make-servlet (current-custodian)
|
(make-servlet (current-custodian)
|
||||||
(current-namespace)
|
(current-namespace)
|
||||||
manager
|
manager
|
||||||
|
@ -230,8 +221,10 @@
|
||||||
[(response? s)
|
[(response? s)
|
||||||
(make-servlet (current-custodian)
|
(make-servlet (current-custodian)
|
||||||
(current-namespace)
|
(current-namespace)
|
||||||
(create-none-manager
|
(create-timeout-manager
|
||||||
default-servlet-instance-expiration-handler)
|
default-servlet-instance-expiration-handler
|
||||||
|
timeouts-servlet-connection
|
||||||
|
timeouts-servlet-connection)
|
||||||
(v0.response->v1.lambda s a-path))]
|
(v0.response->v1.lambda s a-path))]
|
||||||
[else
|
[else
|
||||||
(error 'load-servlet/path "Loading ~e produced ~n~e~n instead of a servlet." a-path s)])))
|
(error 'load-servlet/path "Loading ~e produced ~n~e~n instead of a servlet." a-path s)])))
|
||||||
|
|
|
@ -151,6 +151,8 @@ This function writes a @scheme[configuration-table] to @scheme[path].
|
||||||
@scheme[make-servlet-namespace] procedure needed by the @scheme[make] functions
|
@scheme[make-servlet-namespace] procedure needed by the @scheme[make] functions
|
||||||
of @file{dispatchers/dispatch-servlets.ss} and @file{dispatchers/dispatch-lang.ss}.
|
of @file{dispatchers/dispatch-servlets.ss} and @file{dispatchers/dispatch-lang.ss}.
|
||||||
|
|
||||||
|
@; XXX Define make-servlet-namespace?
|
||||||
|
|
||||||
@; XXX Use actual keyword argument syntax
|
@; XXX Use actual keyword argument syntax
|
||||||
|
|
||||||
@defproc[(make-make-servlet-namespace (#:to-be-copied-module-specs to-be-copied-module-specs (listof module-spec?)))
|
@defproc[(make-make-servlet-namespace (#:to-be-copied-module-specs to-be-copied-module-specs (listof module-spec?)))
|
||||||
|
|
|
@ -246,13 +246,13 @@ It defines a dispatcher construction procedure:
|
||||||
that runs servlets written in Scheme.
|
that runs servlets written in Scheme.
|
||||||
|
|
||||||
@; XXX Add default manager arg
|
@; XXX Add default manager arg
|
||||||
@; XXX Remove config:instances
|
|
||||||
@; XXX Remove config:scripts
|
@; XXX Remove config:scripts
|
||||||
@; XXX Define make-servlet-namespace?
|
@defproc[(make [config:scripts (box/c cache-table?)]
|
||||||
@defproc[(make [config:instances any/c]
|
|
||||||
[config:scripts (box/c cache-table?)]
|
|
||||||
[config:make-servlet-namespace make-servlet-namespace?]
|
|
||||||
[#:url->path url->path url->path?]
|
[#:url->path url->path url->path?]
|
||||||
|
[#:make-servlet-namespace
|
||||||
|
make-servlet-namespace
|
||||||
|
make-servlet-namespace?
|
||||||
|
(make-make-servlet-namespace)]
|
||||||
[#:responders-servlet-loading
|
[#:responders-servlet-loading
|
||||||
responders-servlet-loading
|
responders-servlet-loading
|
||||||
((url url?) (exn any/c) . -> . response?)
|
((url url?) (exn any/c) . -> . response?)
|
||||||
|
@ -294,7 +294,6 @@ that runs servlets written in Scheme.
|
||||||
that runs servlets written in the Web Language.
|
that runs servlets written in the Web Language.
|
||||||
|
|
||||||
@; XXX Don't include timeout logic in here, put it outside.
|
@; XXX Don't include timeout logic in here, put it outside.
|
||||||
@; XXX Include configuration.scrbl exports
|
|
||||||
@defproc[(make [#:url->path url->path url->path?]
|
@defproc[(make [#:url->path url->path url->path?]
|
||||||
[#:make-servlet-namespace make-servlet-namespace
|
[#:make-servlet-namespace make-servlet-namespace
|
||||||
make-servlet-namespace?
|
make-servlet-namespace?
|
||||||
|
|
|
@ -15,7 +15,7 @@
|
||||||
|
|
||||||
(define (mkd p)
|
(define (mkd p)
|
||||||
(define-values (! d)
|
(define-values (! d)
|
||||||
(servlets:make #f (box (make-cache-table)) (make-make-servlet-namespace)
|
(servlets:make (box (make-cache-table))
|
||||||
#:url->path (lambda _ (values p url0s))
|
#:url->path (lambda _ (values p url0s))
|
||||||
#:responders-servlet-loading
|
#:responders-servlet-loading
|
||||||
(lambda (u exn)
|
(lambda (u exn)
|
||||||
|
|
|
@ -65,7 +65,8 @@
|
||||||
(collect-garbage)
|
(collect-garbage)
|
||||||
((responders-collect-garbage (host-responders host-info)))))
|
((responders-collect-garbage (host-responders host-info)))))
|
||||||
(let-values ([(clear-cache! servlet-dispatch)
|
(let-values ([(clear-cache! servlet-dispatch)
|
||||||
(servlets:make config:instances config:scripts config:make-servlet-namespace
|
(servlets:make config:scripts
|
||||||
|
#:make-servlet-namespace config:make-servlet-namespace
|
||||||
#:url->path
|
#:url->path
|
||||||
(fsmap:make-url->valid-path
|
(fsmap:make-url->valid-path
|
||||||
(fsmap:make-url->path (paths-servlet (host-paths host-info))))
|
(fsmap:make-url->path (paths-servlet (host-paths host-info))))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user