Adding web-cells
svn: r1095
This commit is contained in:
Jay McCarthy
parent
99c1f896da
commit
1c99e77b91
|
|
@ -19,384 +19,386 @@
|
|||
|
||||
(define interface-version 'v1)
|
||||
(define (gen-dispatcher host-info config:instances config:scripts config:make-servlet-namespace)
|
||||
;; ************************************************************
|
||||
;; ************************************************************
|
||||
;; SERVING SERVLETS
|
||||
|
||||
;; servlet-content-producer: connection request host -> void
|
||||
(define (servlet-content-producer conn req host-info)
|
||||
(let ([meth (request-method req)])
|
||||
(if (eq? meth 'head)
|
||||
(output-response/method
|
||||
conn
|
||||
(make-response/full
|
||||
200 "Okay" (current-seconds) TEXT/HTML-MIME-TYPE
|
||||
'() (list "ignored"))
|
||||
meth)
|
||||
(let ([uri (request-uri req)])
|
||||
(set-request-bindings/raw!
|
||||
req
|
||||
(read-bindings/handled conn meth uri (request-headers req)
|
||||
host-info))
|
||||
(cond
|
||||
[(continuation-url? uri)
|
||||
=> (lambda (k-ref)
|
||||
(invoke-servlet-continuation conn req k-ref host-info))]
|
||||
[else
|
||||
(servlet-content-producer/path conn req host-info uri)])))))
|
||||
|
||||
;; read-bindings/handled: connection symbol url headers host -> (listof (list (symbol string))
|
||||
;; read the bindings and handle any exceptions
|
||||
(define (read-bindings/handled conn meth uri headers host-info)
|
||||
(with-handlers ([exn? (lambda (e)
|
||||
(output-response/method
|
||||
conn
|
||||
;((responders-protocol (host-responders host-info))
|
||||
; (exn-message e))
|
||||
((responders-servlet-loading (host-responders
|
||||
host-info))
|
||||
uri e)
|
||||
|
||||
|
||||
meth)
|
||||
'())])
|
||||
(read-bindings conn meth uri headers)))
|
||||
|
||||
;; servlet-content-producer/path: connection request host url -> void
|
||||
;; This is not a continuation url so the loading behavior is determined
|
||||
;; by the url path. Build the servlet path and then load the servlet
|
||||
(define (servlet-content-producer/path conn req host-info uri)
|
||||
(with-handlers (;; couldn't find the servlet
|
||||
[exn:fail:filesystem:exists:servlet?
|
||||
(lambda (the-exn)
|
||||
(output-response/method
|
||||
conn
|
||||
((responders-file-not-found (host-responders
|
||||
host-info))
|
||||
(request-uri req))
|
||||
(request-method req)))]
|
||||
;; servlet won't load (e.g. syntax error)
|
||||
[(lambda (x) #t)
|
||||
(lambda (the-exn)
|
||||
(output-response/method
|
||||
conn
|
||||
((responders-servlet-loading
|
||||
(host-responders host-info))
|
||||
uri the-exn)
|
||||
(request-method req)))])
|
||||
(let ([sema (make-semaphore 0)]
|
||||
[last-inst (thread-cell-ref current-servlet-instance)])
|
||||
(let/cc suspend
|
||||
(let* ([servlet-custodian (make-servlet-custodian)]
|
||||
[inst (create-new-instance!
|
||||
config:instances servlet-custodian
|
||||
(make-execution-context
|
||||
conn req (lambda () (suspend #t)))
|
||||
sema
|
||||
(start-timer 0 void))]
|
||||
[real-servlet-path (with-handlers ([void (lambda (e)
|
||||
(raise (make-exn:fail:filesystem:exists:servlet
|
||||
(exn-message e)
|
||||
(exn-continuation-marks e))))])
|
||||
(url-path->path
|
||||
(paths-servlet (host-paths host-info))
|
||||
(url-path->string (url-path uri))))]
|
||||
[servlet-exit-handler (make-servlet-exit-handler inst)])
|
||||
(parameterize ([current-directory (get-servlet-base-dir real-servlet-path)]
|
||||
[current-custodian servlet-custodian]
|
||||
[current-servlet-continuation-expiration-handler
|
||||
(make-default-servlet-continuation-expiration-handler host-info)]
|
||||
[exit-handler servlet-exit-handler])
|
||||
(thread-cell-set! current-servlet-instance inst)
|
||||
(let (;; timer thread must be within the dynamic extent of
|
||||
;; servlet custodian
|
||||
[time-bomb (start-timer (timeouts-default-servlet
|
||||
(host-timeouts host-info))
|
||||
(lambda ()
|
||||
(servlet-exit-handler #f)))]
|
||||
;; any resources (e.g. threads) created when the
|
||||
;; servlet is loaded should be within the dynamic
|
||||
;; extent of the servlet custodian
|
||||
[the-servlet (cached-load real-servlet-path)])
|
||||
(parameterize ([current-namespace (servlet-namespace the-servlet)])
|
||||
(set-servlet-instance-timer! inst time-bomb)
|
||||
(with-handlers ([(lambda (x) #t)
|
||||
(make-servlet-exception-handler inst host-info)])
|
||||
;; Two possibilities:
|
||||
;; - module servlet. start : Request -> Void handles
|
||||
;; output-response via send/finish, etc.
|
||||
;; - unit/sig or simple xexpr servlet. These must produce a
|
||||
;; response, which is then output by the server.
|
||||
;; Here, we do not know if the servlet was a module,
|
||||
;; unit/sig, or Xexpr; we do know whether it produces a
|
||||
;; response.
|
||||
(let ([r ((servlet-handler the-servlet) req)])
|
||||
(when (response? r)
|
||||
(send/back r)))))))))
|
||||
(thread-cell-set! current-servlet-instance last-inst)
|
||||
(semaphore-post sema))))
|
||||
|
||||
;; make-servlet-exit-handler: servlet-instance -> alpha -> void
|
||||
;; exit handler for a servlet
|
||||
(define (make-servlet-exit-handler inst)
|
||||
(lambda (x)
|
||||
(remove-instance! config:instances inst)
|
||||
(kill-connection!
|
||||
(execution-context-connection
|
||||
(servlet-instance-context inst)))
|
||||
(custodian-shutdown-all (servlet-instance-custodian inst))))
|
||||
|
||||
;; make-default-server-continuation-expiration-handler : host -> (request -> response)
|
||||
(define (make-default-servlet-continuation-expiration-handler host-info)
|
||||
(lambda (req)
|
||||
(send/back
|
||||
;; ************************************************************
|
||||
;; ************************************************************
|
||||
;; SERVING SERVLETS
|
||||
|
||||
;; servlet-content-producer: connection request host -> void
|
||||
(define (servlet-content-producer conn req host-info)
|
||||
(let ([meth (request-method req)])
|
||||
(if (eq? meth 'head)
|
||||
(output-response/method
|
||||
conn
|
||||
(make-response/full
|
||||
200 "Okay" (current-seconds) TEXT/HTML-MIME-TYPE
|
||||
'() (list "ignored"))
|
||||
meth)
|
||||
(let ([uri (request-uri req)])
|
||||
(set-request-bindings/raw!
|
||||
req
|
||||
(read-bindings/handled conn meth uri (request-headers req)
|
||||
host-info))
|
||||
(cond
|
||||
[(continuation-url? uri)
|
||||
=> (lambda (k-ref)
|
||||
(invoke-servlet-continuation conn req k-ref host-info))]
|
||||
[else
|
||||
(servlet-content-producer/path conn req host-info uri)])))))
|
||||
|
||||
;; read-bindings/handled: connection symbol url headers host -> (listof (list (symbol string))
|
||||
;; read the bindings and handle any exceptions
|
||||
(define (read-bindings/handled conn meth uri headers host-info)
|
||||
(with-handlers ([exn? (lambda (e)
|
||||
(output-response/method
|
||||
conn
|
||||
;((responders-protocol (host-responders host-info))
|
||||
; (exn-message e))
|
||||
((responders-servlet-loading (host-responders
|
||||
host-info))
|
||||
uri e)
|
||||
|
||||
|
||||
meth)
|
||||
'())])
|
||||
(read-bindings conn meth uri headers)))
|
||||
|
||||
;; servlet-content-producer/path: connection request host url -> void
|
||||
;; This is not a continuation url so the loading behavior is determined
|
||||
;; by the url path. Build the servlet path and then load the servlet
|
||||
(define (servlet-content-producer/path conn req host-info uri)
|
||||
(with-handlers (;; couldn't find the servlet
|
||||
[exn:fail:filesystem:exists:servlet?
|
||||
(lambda (the-exn)
|
||||
(output-response/method
|
||||
conn
|
||||
((responders-file-not-found (host-responders
|
||||
host-info))
|
||||
(request-uri req))
|
||||
(request-method req)))]
|
||||
;; servlet won't load (e.g. syntax error)
|
||||
[(lambda (x) #t)
|
||||
(lambda (the-exn)
|
||||
(output-response/method
|
||||
conn
|
||||
((responders-servlet-loading
|
||||
(host-responders host-info))
|
||||
uri the-exn)
|
||||
(request-method req)))])
|
||||
(let ([sema (make-semaphore 0)]
|
||||
[last-inst (thread-cell-ref current-servlet-instance)])
|
||||
(let/cc suspend
|
||||
; Create the session frame
|
||||
(with-frame
|
||||
(let* ([servlet-custodian (make-servlet-custodian)]
|
||||
[inst (create-new-instance!
|
||||
config:instances servlet-custodian
|
||||
(make-execution-context
|
||||
conn req (lambda () (suspend #t)))
|
||||
sema
|
||||
(start-timer 0 void))]
|
||||
[real-servlet-path (with-handlers ([void (lambda (e)
|
||||
(raise (make-exn:fail:filesystem:exists:servlet
|
||||
(exn-message e)
|
||||
(exn-continuation-marks e))))])
|
||||
(url-path->path
|
||||
(paths-servlet (host-paths host-info))
|
||||
(url-path->string (url-path uri))))]
|
||||
[servlet-exit-handler (make-servlet-exit-handler inst)])
|
||||
(parameterize ([current-directory (get-servlet-base-dir real-servlet-path)]
|
||||
[current-custodian servlet-custodian]
|
||||
[current-servlet-continuation-expiration-handler
|
||||
(make-default-servlet-continuation-expiration-handler host-info)]
|
||||
[exit-handler servlet-exit-handler])
|
||||
(thread-cell-set! current-servlet-instance inst)
|
||||
(let (;; timer thread must be within the dynamic extent of
|
||||
;; servlet custodian
|
||||
[time-bomb (start-timer (timeouts-default-servlet
|
||||
(host-timeouts host-info))
|
||||
(lambda ()
|
||||
(servlet-exit-handler #f)))]
|
||||
;; any resources (e.g. threads) created when the
|
||||
;; servlet is loaded should be within the dynamic
|
||||
;; extent of the servlet custodian
|
||||
[the-servlet (cached-load real-servlet-path)])
|
||||
(parameterize ([current-namespace (servlet-namespace the-servlet)])
|
||||
(set-servlet-instance-timer! inst time-bomb)
|
||||
(with-handlers ([(lambda (x) #t)
|
||||
(make-servlet-exception-handler inst host-info)])
|
||||
;; Two possibilities:
|
||||
;; - module servlet. start : Request -> Void handles
|
||||
;; output-response via send/finish, etc.
|
||||
;; - unit/sig or simple xexpr servlet. These must produce a
|
||||
;; response, which is then output by the server.
|
||||
;; Here, we do not know if the servlet was a module,
|
||||
;; unit/sig, or Xexpr; we do know whether it produces a
|
||||
;; response.
|
||||
(let ([r ((servlet-handler the-servlet) req)])
|
||||
(when (response? r)
|
||||
(send/back r))))))))))
|
||||
(thread-cell-set! current-servlet-instance last-inst)
|
||||
(semaphore-post sema))))
|
||||
|
||||
;; make-servlet-exit-handler: servlet-instance -> alpha -> void
|
||||
;; exit handler for a servlet
|
||||
(define (make-servlet-exit-handler inst)
|
||||
(lambda (x)
|
||||
(remove-instance! config:instances inst)
|
||||
(kill-connection!
|
||||
(execution-context-connection
|
||||
(servlet-instance-context inst)))
|
||||
(custodian-shutdown-all (servlet-instance-custodian inst))))
|
||||
|
||||
;; make-default-server-continuation-expiration-handler : host -> (request -> response)
|
||||
(define (make-default-servlet-continuation-expiration-handler host-info)
|
||||
(lambda (req)
|
||||
(send/back
|
||||
((responders-file-not-found (host-responders
|
||||
host-info))
|
||||
(request-uri req)))))
|
||||
|
||||
|
||||
;; make-default-server-instance-expiration-handler : host -> (request -> response)
|
||||
(define (make-default-servlet-instance-expiration-handler host-info)
|
||||
(lambda (req)
|
||||
((responders-file-not-found (host-responders
|
||||
host-info))
|
||||
(request-uri req)))))
|
||||
|
||||
|
||||
;; make-default-server-instance-expiration-handler : host -> (request -> response)
|
||||
(define (make-default-servlet-instance-expiration-handler host-info)
|
||||
(lambda (req)
|
||||
((responders-file-not-found (host-responders
|
||||
host-info))
|
||||
(request-uri req))))
|
||||
|
||||
;; make-servlet-exception-handler: host -> exn -> void
|
||||
;; This exception handler traps all unhandled servlet exceptions
|
||||
;; * Must occur within the dynamic extent of the servlet
|
||||
;; custodian since several connection custodians will typically
|
||||
;; be shutdown during the dynamic extent of a continuation
|
||||
;; * Use the connection from the current-servlet-context in case
|
||||
;; the exception is raised while invoking a continuation.
|
||||
;; * Use the suspend from the servlet-instanct-context which is
|
||||
;; closed over the current tcp ports which may need to be
|
||||
;; closed for an http 1.0 request.
|
||||
;; * Also, suspend will post to the semaphore so that future
|
||||
;; requests won't be blocked.
|
||||
;; * This fixes PR# 7066
|
||||
(define (make-servlet-exception-handler inst host-info)
|
||||
(lambda (the-exn)
|
||||
(let* ([ctxt (servlet-instance-context inst)]
|
||||
[req (execution-context-request ctxt)]
|
||||
[resp ((responders-servlet (host-responders
|
||||
host-info))
|
||||
(request-uri req)
|
||||
the-exn)])
|
||||
;; Don't handle twice
|
||||
(with-handlers ([exn:fail? (lambda (exn) (void))])
|
||||
(output-response/method
|
||||
(execution-context-connection ctxt)
|
||||
resp (request-method req)))
|
||||
((execution-context-suspend ctxt)))))
|
||||
|
||||
;; path -> path
|
||||
;; The actual servlet's parent directory.
|
||||
(define (get-servlet-base-dir servlet-path)
|
||||
(let loop ((path servlet-path))
|
||||
(let-values ([(base name must-be-dir?) (split-path path)])
|
||||
(if must-be-dir?
|
||||
(or (and (directory-exists? path) path)
|
||||
(loop base))
|
||||
(or (and (directory-exists? base) base)
|
||||
(loop base))))))
|
||||
|
||||
;; invoke-servlet-continuation: connection request continuation-reference
|
||||
;; host -> void
|
||||
;; pull the continuation out of the table and apply it
|
||||
(define (invoke-servlet-continuation conn req k-ref host-info)
|
||||
(let-values ([(uk-instance uk-id uk-salt) (apply values k-ref)])
|
||||
(let* ([uri (request-uri req)]
|
||||
[real-servlet-path (url-path->path
|
||||
(paths-servlet (host-paths host-info))
|
||||
(url-path->string (url-path uri)))]
|
||||
[the-servlet (cached-load real-servlet-path)])
|
||||
(parameterize ([current-custodian (servlet-custodian the-servlet)])
|
||||
(let ([default-servlet-instance-expiration-handler
|
||||
(make-default-servlet-instance-expiration-handler host-info)]
|
||||
[default-servlet-continuation-expiration-handler
|
||||
(make-default-servlet-continuation-expiration-handler host-info)]
|
||||
[last-inst (thread-cell-ref current-servlet-instance)])
|
||||
(thread-cell-set! current-servlet-instance #f)
|
||||
(with-handlers ([exn:servlet:instance?
|
||||
(lambda (the-exn)
|
||||
(output-response/method
|
||||
conn
|
||||
((servlet-instance-expiration-handler the-servlet) req)
|
||||
(request-method req)))]
|
||||
[exn:servlet:continuation?
|
||||
(lambda (the-exn)
|
||||
((exn:servlet:continuation-expiration-handler the-exn) req))]
|
||||
[exn:servlet:no-current-instance?
|
||||
(lambda (the-exn)
|
||||
(output-response/method
|
||||
conn
|
||||
((default-servlet-instance-expiration-handler) req)
|
||||
(request-method req)))])
|
||||
(let* ([inst
|
||||
(hash-table-get config:instances uk-instance
|
||||
(lambda ()
|
||||
(raise
|
||||
(make-exn:servlet:instance
|
||||
"" (current-continuation-marks)))))]
|
||||
[k-table
|
||||
(servlet-instance-k-table inst)])
|
||||
(let/cc suspend
|
||||
; We don't use call-with-semaphore or dynamic-wind because we
|
||||
; always call a continuation. The exit-handler above ensures that
|
||||
; the post is done.
|
||||
(semaphore-wait (servlet-instance-mutex inst))
|
||||
(thread-cell-set! current-servlet-instance inst)
|
||||
(set-servlet-instance-context!
|
||||
inst
|
||||
(make-execution-context
|
||||
conn req (lambda () (suspend #t))))
|
||||
(increment-timer (servlet-instance-timer inst)
|
||||
(servlet-connection-interval-timeout the-servlet))
|
||||
(let-values ([(k k-expiration-handler k-salt)
|
||||
(apply values
|
||||
(hash-table-get
|
||||
k-table uk-id
|
||||
(lambda ()
|
||||
(raise
|
||||
(make-exn:servlet:continuation
|
||||
"" (current-continuation-marks)
|
||||
default-servlet-continuation-expiration-handler)))))])
|
||||
(if (and k (= k-salt uk-salt))
|
||||
(k req)
|
||||
(raise
|
||||
(make-exn:servlet:continuation
|
||||
"" (current-continuation-marks)
|
||||
k-expiration-handler)))))
|
||||
(semaphore-post (servlet-instance-mutex inst))))
|
||||
(thread-cell-set! current-servlet-instance last-inst))))))
|
||||
|
||||
;; ************************************************************
|
||||
;; ************************************************************
|
||||
;; Paul's ugly loading code:
|
||||
|
||||
;; cached-load : path -> script, namespace
|
||||
;; timestamps are no longer checked for performance. The cache must be explicitly
|
||||
;; refreshed (see dispatch).
|
||||
(define (cached-load servlet-path)
|
||||
(let ([entry-id (string->symbol (path->string servlet-path))])
|
||||
(cache-table-lookup!
|
||||
(unbox config:scripts)
|
||||
entry-id
|
||||
(lambda ()
|
||||
(reload-servlet-script servlet-path)))))
|
||||
|
||||
;; exn:i/o:filesystem:servlet-not-found =
|
||||
;; (make-exn:fail:filesystem:exists:servlet str continuation-marks str sym)
|
||||
(define-struct (exn:fail:filesystem:exists:servlet
|
||||
exn:fail:filesystem:exists) ())
|
||||
|
||||
;; reload-servlet-script : str -> cache-entry
|
||||
;; The servlet is not cached in the servlet-table, so reload it from the filesystem.
|
||||
(define (reload-servlet-script servlet-filename)
|
||||
(cond
|
||||
[(load-servlet/path servlet-filename)
|
||||
=> (lambda (entry)
|
||||
entry)]
|
||||
[else
|
||||
(raise (make-exn:fail:filesystem:exists:servlet
|
||||
(string->immutable-string (format "Couldn't find ~a" servlet-filename))
|
||||
(current-continuation-marks) ))]))
|
||||
|
||||
;; load-servlet/path path -> (union #f cache-entry)
|
||||
;; given a string path to a filename attempt to load a servlet
|
||||
;; A servlet-file will contain either
|
||||
;;;; A signed-unit-servlet
|
||||
;;;; A module servlet, currently only 'v1
|
||||
;;;;;; (XXX: I don't know what 'typed-model-split-store0 was, so it was removed.)
|
||||
;;;; A response
|
||||
(define (load-servlet/path a-path)
|
||||
(define (v0.servlet->v1.lambda servlet)
|
||||
(lambda (initial-request)
|
||||
(invoke-unit/sig servlet servlet^)))
|
||||
(define (v0.response->v1.lambda response-path response)
|
||||
(letrec ([go (lambda ()
|
||||
(begin
|
||||
(set! go (lambda () (load/use-compiled a-path)))
|
||||
response))])
|
||||
(lambda (initial-request) (go))))
|
||||
(define (v1.module->v1.lambda timeout start)
|
||||
(lambda (initial-request)
|
||||
(adjust-timeout! timeout)
|
||||
(start initial-request)))
|
||||
(let ([servlet-custodian (make-servlet-custodian)])
|
||||
(parameterize ([current-namespace (config:make-servlet-namespace)]
|
||||
[current-custodian servlet-custodian])
|
||||
(and (file-exists? a-path)
|
||||
(let ([s (load/use-compiled a-path)])
|
||||
(cond
|
||||
;; signed-unit servlet
|
||||
; MF: I'd also like to test that s has the correct import signature.
|
||||
[(unit/sig? s)
|
||||
(make-servlet (v0.servlet->v1.lambda s)
|
||||
servlet-custodian
|
||||
(current-namespace)
|
||||
(timeouts-default-servlet
|
||||
(host-timeouts host-info))
|
||||
(make-default-servlet-instance-expiration-handler host-info))]
|
||||
; FIX - reason about exceptions from dynamic require (catch and report if not already)
|
||||
;; module servlet
|
||||
[(void? s)
|
||||
(let* ([module-name `(file ,(path->string a-path))]
|
||||
[version (dynamic-require module-name 'interface-version)])
|
||||
(case version
|
||||
[(v1)
|
||||
(let ([timeout (dynamic-require module-name 'timeout)]
|
||||
[start (dynamic-require module-name 'start)])
|
||||
(make-servlet (v1.module->v1.lambda timeout start)
|
||||
servlet-custodian
|
||||
(current-namespace)
|
||||
(timeouts-default-servlet
|
||||
(host-timeouts host-info))
|
||||
(make-default-servlet-instance-expiration-handler host-info)))]
|
||||
[(v2-transitional) ; XXX: Undocumented
|
||||
(let ([timeout (dynamic-require module-name 'timeout)]
|
||||
[instance-expiration-handler (dynamic-require module-name 'instance-expiration-handler)]
|
||||
[start (dynamic-require module-name 'start)])
|
||||
(make-servlet (v1.module->v1.lambda timeout start)
|
||||
servlet-custodian
|
||||
(current-namespace)
|
||||
timeout
|
||||
instance-expiration-handler))]
|
||||
[else
|
||||
(raise (format "unknown servlet version ~e" version))]))]
|
||||
;; response
|
||||
[(response? s)
|
||||
(make-servlet (v0.response->v1.lambda s a-path)
|
||||
servlet-custodian
|
||||
(current-namespace)
|
||||
(timeouts-default-servlet
|
||||
(host-timeouts host-info))
|
||||
(make-default-servlet-instance-expiration-handler host-info))]
|
||||
[else
|
||||
(raise 'load-servlet/path "Loading ~e produced ~n~e~n instead of a servlet." a-path s)]))))))
|
||||
|
||||
(define servlet-bin?
|
||||
(let ([svt-bin-re (regexp "^/servlets(;id.*\\*.*\\*.*)?/.*")])
|
||||
(lambda (str)
|
||||
(regexp-match svt-bin-re str))))
|
||||
|
||||
;; return dispatcher
|
||||
(lambda (conn req)
|
||||
(let-values ([(uri method path) (decompose-request req)])
|
||||
(cond [(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!
|
||||
(cache-table-clear! (unbox config:scripts))
|
||||
(output-response/method
|
||||
conn
|
||||
((responders-servlets-refreshed (host-responders host-info)))
|
||||
method)]
|
||||
[(servlet-bin? path)
|
||||
(adjust-connection-timeout!
|
||||
conn
|
||||
(timeouts-servlet-connection (host-timeouts host-info)))
|
||||
;; more here - make timeouts proportional to size of bindings
|
||||
(servlet-content-producer conn req host-info)]
|
||||
[else
|
||||
(next-dispatcher)])))))
|
||||
(request-uri req))))
|
||||
|
||||
;; make-servlet-exception-handler: host -> exn -> void
|
||||
;; This exception handler traps all unhandled servlet exceptions
|
||||
;; * Must occur within the dynamic extent of the servlet
|
||||
;; custodian since several connection custodians will typically
|
||||
;; be shutdown during the dynamic extent of a continuation
|
||||
;; * Use the connection from the current-servlet-context in case
|
||||
;; the exception is raised while invoking a continuation.
|
||||
;; * Use the suspend from the servlet-instanct-context which is
|
||||
;; closed over the current tcp ports which may need to be
|
||||
;; closed for an http 1.0 request.
|
||||
;; * Also, suspend will post to the semaphore so that future
|
||||
;; requests won't be blocked.
|
||||
;; * This fixes PR# 7066
|
||||
(define (make-servlet-exception-handler inst host-info)
|
||||
(lambda (the-exn)
|
||||
(let* ([ctxt (servlet-instance-context inst)]
|
||||
[req (execution-context-request ctxt)]
|
||||
[resp ((responders-servlet (host-responders
|
||||
host-info))
|
||||
(request-uri req)
|
||||
the-exn)])
|
||||
;; Don't handle twice
|
||||
(with-handlers ([exn:fail? (lambda (exn) (void))])
|
||||
(output-response/method
|
||||
(execution-context-connection ctxt)
|
||||
resp (request-method req)))
|
||||
((execution-context-suspend ctxt)))))
|
||||
|
||||
;; path -> path
|
||||
;; The actual servlet's parent directory.
|
||||
(define (get-servlet-base-dir servlet-path)
|
||||
(let loop ((path servlet-path))
|
||||
(let-values ([(base name must-be-dir?) (split-path path)])
|
||||
(if must-be-dir?
|
||||
(or (and (directory-exists? path) path)
|
||||
(loop base))
|
||||
(or (and (directory-exists? base) base)
|
||||
(loop base))))))
|
||||
|
||||
;; invoke-servlet-continuation: connection request continuation-reference
|
||||
;; host -> void
|
||||
;; pull the continuation out of the table and apply it
|
||||
(define (invoke-servlet-continuation conn req k-ref host-info)
|
||||
(let-values ([(uk-instance uk-id uk-salt) (apply values k-ref)])
|
||||
(let* ([uri (request-uri req)]
|
||||
[real-servlet-path (url-path->path
|
||||
(paths-servlet (host-paths host-info))
|
||||
(url-path->string (url-path uri)))]
|
||||
[the-servlet (cached-load real-servlet-path)])
|
||||
(parameterize ([current-custodian (servlet-custodian the-servlet)])
|
||||
(let ([default-servlet-instance-expiration-handler
|
||||
(make-default-servlet-instance-expiration-handler host-info)]
|
||||
[default-servlet-continuation-expiration-handler
|
||||
(make-default-servlet-continuation-expiration-handler host-info)]
|
||||
[last-inst (thread-cell-ref current-servlet-instance)])
|
||||
(thread-cell-set! current-servlet-instance #f)
|
||||
(with-handlers ([exn:servlet:instance?
|
||||
(lambda (the-exn)
|
||||
(output-response/method
|
||||
conn
|
||||
((servlet-instance-expiration-handler the-servlet) req)
|
||||
(request-method req)))]
|
||||
[exn:servlet:continuation?
|
||||
(lambda (the-exn)
|
||||
((exn:servlet:continuation-expiration-handler the-exn) req))]
|
||||
[exn:servlet:no-current-instance?
|
||||
(lambda (the-exn)
|
||||
(output-response/method
|
||||
conn
|
||||
((default-servlet-instance-expiration-handler) req)
|
||||
(request-method req)))])
|
||||
(let* ([inst
|
||||
(hash-table-get config:instances uk-instance
|
||||
(lambda ()
|
||||
(raise
|
||||
(make-exn:servlet:instance
|
||||
"" (current-continuation-marks)))))]
|
||||
[k-table
|
||||
(servlet-instance-k-table inst)])
|
||||
(let/cc suspend
|
||||
; We don't use call-with-semaphore or dynamic-wind because we
|
||||
; always call a continuation. The exit-handler above ensures that
|
||||
; the post is done.
|
||||
(semaphore-wait (servlet-instance-mutex inst))
|
||||
(thread-cell-set! current-servlet-instance inst)
|
||||
(set-servlet-instance-context!
|
||||
inst
|
||||
(make-execution-context
|
||||
conn req (lambda () (suspend #t))))
|
||||
(increment-timer (servlet-instance-timer inst)
|
||||
(servlet-connection-interval-timeout the-servlet))
|
||||
(let-values ([(k k-expiration-handler k-salt)
|
||||
(apply values
|
||||
(hash-table-get
|
||||
k-table uk-id
|
||||
(lambda ()
|
||||
(raise
|
||||
(make-exn:servlet:continuation
|
||||
"" (current-continuation-marks)
|
||||
default-servlet-continuation-expiration-handler)))))])
|
||||
(if (and k (= k-salt uk-salt))
|
||||
(k req)
|
||||
(raise
|
||||
(make-exn:servlet:continuation
|
||||
"" (current-continuation-marks)
|
||||
k-expiration-handler)))))
|
||||
(semaphore-post (servlet-instance-mutex inst))))
|
||||
(thread-cell-set! current-servlet-instance last-inst))))))
|
||||
|
||||
;; ************************************************************
|
||||
;; ************************************************************
|
||||
;; Paul's ugly loading code:
|
||||
|
||||
;; cached-load : path -> script, namespace
|
||||
;; timestamps are no longer checked for performance. The cache must be explicitly
|
||||
;; refreshed (see dispatch).
|
||||
(define (cached-load servlet-path)
|
||||
(let ([entry-id (string->symbol (path->string servlet-path))])
|
||||
(cache-table-lookup!
|
||||
(unbox config:scripts)
|
||||
entry-id
|
||||
(lambda ()
|
||||
(reload-servlet-script servlet-path)))))
|
||||
|
||||
;; exn:i/o:filesystem:servlet-not-found =
|
||||
;; (make-exn:fail:filesystem:exists:servlet str continuation-marks str sym)
|
||||
(define-struct (exn:fail:filesystem:exists:servlet
|
||||
exn:fail:filesystem:exists) ())
|
||||
|
||||
;; reload-servlet-script : str -> cache-entry
|
||||
;; The servlet is not cached in the servlet-table, so reload it from the filesystem.
|
||||
(define (reload-servlet-script servlet-filename)
|
||||
(cond
|
||||
[(load-servlet/path servlet-filename)
|
||||
=> (lambda (entry)
|
||||
entry)]
|
||||
[else
|
||||
(raise (make-exn:fail:filesystem:exists:servlet
|
||||
(string->immutable-string (format "Couldn't find ~a" servlet-filename))
|
||||
(current-continuation-marks) ))]))
|
||||
|
||||
;; load-servlet/path path -> (union #f cache-entry)
|
||||
;; given a string path to a filename attempt to load a servlet
|
||||
;; A servlet-file will contain either
|
||||
;;;; A signed-unit-servlet
|
||||
;;;; A module servlet, currently only 'v1
|
||||
;;;;;; (XXX: I don't know what 'typed-model-split-store0 was, so it was removed.)
|
||||
;;;; A response
|
||||
(define (load-servlet/path a-path)
|
||||
(define (v0.servlet->v1.lambda servlet)
|
||||
(lambda (initial-request)
|
||||
(invoke-unit/sig servlet servlet^)))
|
||||
(define (v0.response->v1.lambda response-path response)
|
||||
(letrec ([go (lambda ()
|
||||
(begin
|
||||
(set! go (lambda () (load/use-compiled a-path)))
|
||||
response))])
|
||||
(lambda (initial-request) (go))))
|
||||
(define (v1.module->v1.lambda timeout start)
|
||||
(lambda (initial-request)
|
||||
(adjust-timeout! timeout)
|
||||
(start initial-request)))
|
||||
(let ([servlet-custodian (make-servlet-custodian)])
|
||||
(parameterize ([current-namespace (config:make-servlet-namespace)]
|
||||
[current-custodian servlet-custodian])
|
||||
(and (file-exists? a-path)
|
||||
(let ([s (load/use-compiled a-path)])
|
||||
(cond
|
||||
;; signed-unit servlet
|
||||
; MF: I'd also like to test that s has the correct import signature.
|
||||
[(unit/sig? s)
|
||||
(make-servlet (v0.servlet->v1.lambda s)
|
||||
servlet-custodian
|
||||
(current-namespace)
|
||||
(timeouts-default-servlet
|
||||
(host-timeouts host-info))
|
||||
(make-default-servlet-instance-expiration-handler host-info))]
|
||||
; FIX - reason about exceptions from dynamic require (catch and report if not already)
|
||||
;; module servlet
|
||||
[(void? s)
|
||||
(let* ([module-name `(file ,(path->string a-path))]
|
||||
[version (dynamic-require module-name 'interface-version)])
|
||||
(case version
|
||||
[(v1)
|
||||
(let ([timeout (dynamic-require module-name 'timeout)]
|
||||
[start (dynamic-require module-name 'start)])
|
||||
(make-servlet (v1.module->v1.lambda timeout start)
|
||||
servlet-custodian
|
||||
(current-namespace)
|
||||
(timeouts-default-servlet
|
||||
(host-timeouts host-info))
|
||||
(make-default-servlet-instance-expiration-handler host-info)))]
|
||||
[(v2-transitional) ; XXX: Undocumented
|
||||
(let ([timeout (dynamic-require module-name 'timeout)]
|
||||
[instance-expiration-handler (dynamic-require module-name 'instance-expiration-handler)]
|
||||
[start (dynamic-require module-name 'start)])
|
||||
(make-servlet (v1.module->v1.lambda timeout start)
|
||||
servlet-custodian
|
||||
(current-namespace)
|
||||
timeout
|
||||
instance-expiration-handler))]
|
||||
[else
|
||||
(raise (format "unknown servlet version ~e" version))]))]
|
||||
;; response
|
||||
[(response? s)
|
||||
(make-servlet (v0.response->v1.lambda s a-path)
|
||||
servlet-custodian
|
||||
(current-namespace)
|
||||
(timeouts-default-servlet
|
||||
(host-timeouts host-info))
|
||||
(make-default-servlet-instance-expiration-handler host-info))]
|
||||
[else
|
||||
(raise 'load-servlet/path "Loading ~e produced ~n~e~n instead of a servlet." a-path s)]))))))
|
||||
|
||||
(define servlet-bin?
|
||||
(let ([svt-bin-re (regexp "^/servlets(;id.*\\*.*\\*.*)?/.*")])
|
||||
(lambda (str)
|
||||
(regexp-match svt-bin-re str))))
|
||||
|
||||
;; return dispatcher
|
||||
(lambda (conn req)
|
||||
(let-values ([(uri method path) (decompose-request req)])
|
||||
(cond [(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!
|
||||
(cache-table-clear! (unbox config:scripts))
|
||||
(output-response/method
|
||||
conn
|
||||
((responders-servlets-refreshed (host-responders host-info)))
|
||||
method)]
|
||||
[(servlet-bin? path)
|
||||
(adjust-connection-timeout!
|
||||
conn
|
||||
(timeouts-servlet-connection (host-timeouts host-info)))
|
||||
;; more here - make timeouts proportional to size of bindings
|
||||
(servlet-content-producer conn req host-info)]
|
||||
[else
|
||||
(next-dispatcher)])))))
|
||||
|
|
@ -6,11 +6,13 @@
|
|||
"response.ss"
|
||||
"servlet-helpers.ss"
|
||||
"xexpr-callback.ss"
|
||||
"timer.ss")
|
||||
"timer.ss"
|
||||
"web-cells.ss")
|
||||
|
||||
;; Weak contracts: the input is checked in output-response, and a message is
|
||||
;; sent directly to the client (Web browser) instead of the terminal/log.
|
||||
(provide/contract
|
||||
[redirect/get (-> request?)]
|
||||
[adjust-timeout! (number? . -> . any)]
|
||||
[send/back (any/c . -> . any)]
|
||||
[send/finish (any/c . -> . any)]
|
||||
|
|
@ -18,14 +20,22 @@
|
|||
[send/forward (((string? . -> . any/c)) ((request? . -> . any/c)) . opt-> . request?)]
|
||||
;;; validate-xexpr/callback is not checked anywhere:
|
||||
[send/suspend/callback (xexpr/callback? . -> . any)])
|
||||
|
||||
|
||||
(provide
|
||||
clear-continuation-table!
|
||||
send/suspend/dispatch
|
||||
current-servlet-continuation-expiration-handler
|
||||
(all-from "web-cells.ss")
|
||||
(all-from "servlet-helpers.ss")
|
||||
(all-from "xexpr-callback.ss"))
|
||||
|
||||
;; ************************************************************
|
||||
;; HIGHER-LEVEL EXPORTS
|
||||
|
||||
; redirect/get : -> request
|
||||
(define (redirect/get)
|
||||
(send/suspend (lambda (k-url) (redirect-to k-url temporarily))))
|
||||
|
||||
;; ************************************************************
|
||||
;; EXPORTS
|
||||
|
||||
|
|
@ -72,16 +82,17 @@
|
|||
;; send a response and apply the continuation to the next request
|
||||
(define send/suspend
|
||||
(opt-lambda (response-generator [expiration-handler (current-servlet-continuation-expiration-handler)])
|
||||
(let/cc k
|
||||
(let* ([inst (get-current-servlet-instance)]
|
||||
[ctxt (servlet-instance-context inst)]
|
||||
[k-url (store-continuation!
|
||||
k expiration-handler
|
||||
(request-uri (execution-context-request ctxt))
|
||||
inst)]
|
||||
[response (response-generator k-url)])
|
||||
(output-response (execution-context-connection ctxt) response)
|
||||
((execution-context-suspend ctxt))))))
|
||||
(with-frame-after
|
||||
(let/cc k
|
||||
(let* ([inst (get-current-servlet-instance)]
|
||||
[ctxt (servlet-instance-context inst)]
|
||||
[k-url (store-continuation!
|
||||
k expiration-handler
|
||||
(request-uri (execution-context-request ctxt))
|
||||
inst)]
|
||||
[response (response-generator k-url)])
|
||||
(output-response (execution-context-connection ctxt) response)
|
||||
((execution-context-suspend ctxt)))))))
|
||||
|
||||
;; send/forward: (url -> response) [(request -> response)] -> request
|
||||
;; clear the continuation table, then behave like send/suspend
|
||||
|
|
|
|||
245
collects/web-server/web-cells.ss
Normal file
245
collects/web-server/web-cells.ss
Normal file
|
|
@ -0,0 +1,245 @@
|
|||
(module web-cells mzscheme
|
||||
(require (lib "struct.ss"))
|
||||
|
||||
(define-struct (exn:fail:frame:top exn) ())
|
||||
(define (exn:fail:frame:top-raise)
|
||||
(raise (make-exn:fail:frame:top
|
||||
"Reached top of stack"
|
||||
(current-continuation-marks))))
|
||||
(provide exn:fail:frame:top?)
|
||||
|
||||
;; frames
|
||||
(define-struct frame ())
|
||||
(define-struct (frame:empty frame) ())
|
||||
; frame:ns : (alist * (box frame) * namespace)
|
||||
(define-struct (frame:ns frame) (annotations boxed-parent namespace))
|
||||
|
||||
; frame:ns?/raise : frame -> frame
|
||||
(define (frame:ns?/raise f)
|
||||
(if (frame:ns? f)
|
||||
f
|
||||
(exn:fail:frame:top-raise)))
|
||||
|
||||
; make-frame/parent : (box frame) -> frame:ns
|
||||
(define (make-frame/parent parent-frame-box)
|
||||
(make-frame:ns (list) parent-frame-box (make-namespace 'empty)))
|
||||
|
||||
; search-frames : frame:ns (frame:ns -> boolean?) -> frame
|
||||
; Returns the first frame in the stack that matches the predicate
|
||||
(define (search-frames a-frame predicate?)
|
||||
(if (predicate? a-frame)
|
||||
a-frame
|
||||
(search-frames (frame:ns?/raise
|
||||
(unbox (frame:ns-boxed-parent a-frame)))
|
||||
predicate?)))
|
||||
|
||||
; frame-ref : frame:ns symbol -> any
|
||||
; Lookups up the variable in the frame and its parent(s)
|
||||
(define (frame-ref a-frame var)
|
||||
#;(printf "~S~n" (list (namespace-mapped-symbols (frame:ns-namespace a-frame)) var))
|
||||
(namespace-variable-value
|
||||
var #f
|
||||
(lambda ()
|
||||
(frame-ref (frame:ns?/raise
|
||||
(unbox (frame:ns-boxed-parent a-frame)))
|
||||
var))
|
||||
(frame:ns-namespace a-frame)))
|
||||
|
||||
; frame-set? : frame:ns symbol -> boolean
|
||||
(define (frame-set? a-frame var)
|
||||
(not
|
||||
(not
|
||||
(namespace-variable-value
|
||||
var #f
|
||||
(lambda () #f)
|
||||
(frame:ns-namespace a-frame)))))
|
||||
|
||||
; frame-set! : frame:ns symbol any -> void
|
||||
; Sets the variable in the frame to a value
|
||||
(define (frame-set! a-frame var val)
|
||||
(namespace-set-variable-value!
|
||||
var val
|
||||
#t (frame:ns-namespace a-frame)))
|
||||
|
||||
;; frame stacks
|
||||
|
||||
(define *global-root-id* (gensym))
|
||||
(define *session-root-id* (gensym))
|
||||
|
||||
; *frame-stack* : (box frame)
|
||||
(define *frame-stack*
|
||||
(make-parameter
|
||||
(box (copy-struct frame:ns (make-frame/parent (box (make-frame:empty)))
|
||||
[frame:ns-annotations (list (cons *global-root-id* #t))]))))
|
||||
|
||||
; annotation-present? : symbol frame:ns -> boolean
|
||||
(define (annotation-present? i a-frame)
|
||||
(not (not (assq i (frame:ns-annotations a-frame)))))
|
||||
|
||||
; global-root? : frame:ns -> boolean
|
||||
(define (global-root? a-frame)
|
||||
(annotation-present? *global-root-id* a-frame))
|
||||
|
||||
; session-root? : frame:ns -> boolean
|
||||
(define (session-root? a-frame)
|
||||
(annotation-present? *session-root-id* a-frame))
|
||||
|
||||
; make-frame/top : -> frame:ns
|
||||
(define (make-frame/top)
|
||||
(let* ([cur-top-box (*frame-stack*)]
|
||||
[cur-top (unbox cur-top-box)])
|
||||
(cond
|
||||
#;[(not (frame:ns? cur-top))
|
||||
; Construct global
|
||||
(copy-struct frame:ns (make-frame/parent cur-top-box)
|
||||
[frame:ns-annotations (list (cons *global-root-id* #t))])]
|
||||
[(global-root? cur-top)
|
||||
; Construct session
|
||||
(copy-struct frame:ns (make-frame/parent cur-top-box)
|
||||
[frame:ns-annotations (list (cons *session-root-id* #t))])]
|
||||
[else
|
||||
; Construct normal
|
||||
(make-frame/parent cur-top-box)])))
|
||||
|
||||
; push-frame! : -> void
|
||||
; Pushs a new frame onto the session stack
|
||||
(define (push-frame!)
|
||||
(*frame-stack* (box (make-frame/top))))
|
||||
|
||||
; pop-frame! : -> void
|
||||
; Pops the frame from the stack
|
||||
(define (pop-frame!)
|
||||
(*frame-stack* (frame:ns-boxed-parent (unbox (*frame-stack*)))))
|
||||
|
||||
; save-stack/push/return : (-> 'a) -> 'a
|
||||
; Pushes a frame after the thunk's execution with the same parent as the call site
|
||||
(define (save-stack/push/return thunk)
|
||||
(let ([initial-stack (*frame-stack*)])
|
||||
(begin0 (thunk)
|
||||
(*frame-stack* initial-stack)
|
||||
(push-frame!))))
|
||||
|
||||
; syntax version of above
|
||||
(define-syntax with-frame-after
|
||||
(syntax-rules ()
|
||||
[(_ body ...)
|
||||
(save-stack/push/return (lambda () body ...))]))
|
||||
|
||||
; parameterized-push : (-> 'a) -> 'a
|
||||
(define (parameterized-push thunk)
|
||||
(parameterize ([*frame-stack* (box (make-frame/top))])
|
||||
(thunk)))
|
||||
|
||||
; syntax version of above
|
||||
(define-syntax with-frame
|
||||
(syntax-rules ()
|
||||
[(_ body ...)
|
||||
(parameterized-push (lambda () body ...))]))
|
||||
|
||||
; search-stack : (frame -> boolean) -> frame
|
||||
(define (search-stack predicate?)
|
||||
(search-frames (frame:ns?/raise (unbox (*frame-stack*)))
|
||||
predicate?))
|
||||
|
||||
; cells
|
||||
(define-struct cell (id))
|
||||
(define-struct (cell:global cell) ())
|
||||
(define-struct (cell:session cell) ())
|
||||
(define-struct (cell:local cell) ())
|
||||
|
||||
; ext:make-'a 'b -> 'a
|
||||
(define (ext:make-cell:global default)
|
||||
(let ([new-name (gensym)])
|
||||
(frame-set! (search-stack global-root?)
|
||||
new-name default)
|
||||
(make-cell:global new-name)))
|
||||
(define (ext:make-cell:session default)
|
||||
(let ([new-name (gensym)])
|
||||
(frame-set! (search-stack global-root?)
|
||||
new-name default)
|
||||
(make-cell:session new-name)))
|
||||
(define (ext:make-cell:local default)
|
||||
(let ([new-name (gensym)])
|
||||
(frame-set! (search-stack global-root?)
|
||||
new-name default)
|
||||
(make-cell:local new-name)))
|
||||
|
||||
; cell:global-ref : cell:global -> any
|
||||
; returns the value of the global cell
|
||||
(define (cell:global-ref gc)
|
||||
(frame-ref (search-stack global-root?)
|
||||
(cell-id gc)))
|
||||
; cell:global-set! : cell:global any -> void
|
||||
; sets the value of the global cell
|
||||
(define (cell:global-set! gc nv)
|
||||
(frame-set! (search-stack global-root?)
|
||||
(cell-id gc)
|
||||
nv))
|
||||
|
||||
; cell:session-ref : cell:session -> any
|
||||
; returns the value of the session cell
|
||||
(define (cell:session-ref sc)
|
||||
(frame-ref (search-stack session-root?)
|
||||
(cell-id sc)))
|
||||
; cell:session-set! : cell:session any -> void
|
||||
; sets the value of the session cell
|
||||
(define (cell:session-set! sc nv)
|
||||
(frame-set! (search-stack session-root?)
|
||||
(cell-id sc)
|
||||
nv))
|
||||
|
||||
; cell:local-ref : cell:local -> any
|
||||
; returns the value of the local cell
|
||||
(define (cell:local-ref lc)
|
||||
(frame-ref (search-stack frame?)
|
||||
(cell-id lc)))
|
||||
; cell:local-set! : cell:local any -> void
|
||||
; sets the value of the local cell at the last place it was set, including the default
|
||||
(define (cell:local-set! lc nv)
|
||||
(frame-set! (search-stack
|
||||
(lambda (f) (frame-set? f (cell-id lc))))
|
||||
(cell-id lc)
|
||||
nv))
|
||||
; cell:local-mask : cell:local any -> void
|
||||
; masks the local cell to the given value
|
||||
(define (cell:local-mask lc nv)
|
||||
(frame-set! (search-stack frame?)
|
||||
(cell-id lc)
|
||||
nv))
|
||||
|
||||
; cell-ref : cell -> any
|
||||
(define (cell-ref c)
|
||||
(cond
|
||||
[(cell:global? c) (cell:global-ref c)]
|
||||
[(cell:session? c) (cell:session-ref c)]
|
||||
[(cell:local? c) (cell:local-ref c)]))
|
||||
|
||||
; ;; linking parameters to cells
|
||||
; (define *parameter-links* (ext:make-cell:session (list)))
|
||||
; (define-struct parameter-link (parameter cell))
|
||||
;
|
||||
; ; link-parameter : parameter cell -> void
|
||||
; (define (link-parameter p c)
|
||||
; (cell:session-set! *parameter-links*
|
||||
; (cons (make-parameter-link p c)
|
||||
; (cell:session-ref *parameter-links*))))
|
||||
;
|
||||
; ; reinstall-linked-parameters : -> void
|
||||
; (define (reinstall-linked-parameters)
|
||||
; (for-each (lambda (link)
|
||||
; ((parameter-link-parameter link)
|
||||
; (cell-ref (parameter-link-cell link))))
|
||||
; (cell:session-ref *parameter-links*)))
|
||||
|
||||
(provide with-frame
|
||||
with-frame-after
|
||||
(rename ext:make-cell:global make-web-cell:global)
|
||||
(rename cell:global-ref web-cell:global-ref)
|
||||
(rename cell:global-set! web-cell:global-set!)
|
||||
(rename ext:make-cell:session make-web-cell:session)
|
||||
(rename cell:session-ref web-cell:session-ref)
|
||||
(rename cell:session-set! web-cell:session-set!)
|
||||
(rename ext:make-cell:local make-web-cell:local)
|
||||
(rename cell:local-ref web-cell:local-ref)
|
||||
(rename cell:local-set! web-cell:local-set!)
|
||||
(rename cell:local-mask web-cell:local-mask)))
|
||||
Loading…
Reference in New Issue
Block a user