From 30459cf543ed1cbf05205b19d4fa0a8426af6f85 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Thu, 25 Aug 2005 17:02:50 +0000 Subject: [PATCH] Changing internal servlet representation to procedures from request to response, and adding adjust-timeout! to servlet.ss module svn: r674 --- collects/web-server/servlet.ss | 22 ++++++---- collects/web-server/web-server-unit.ss | 56 ++++++++++---------------- 2 files changed, 36 insertions(+), 42 deletions(-) diff --git a/collects/web-server/servlet.ss b/collects/web-server/servlet.ss index f8e57bb35f..a540f3c768 100644 --- a/collects/web-server/servlet.ss +++ b/collects/web-server/servlet.ss @@ -5,17 +5,19 @@ "servlet-tables.ss" "response.ss" "servlet-helpers.ss" - "xexpr-callback.ss") + "xexpr-callback.ss" + "timer.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 - (send/back (any/c . -> . any)) - (send/finish (any/c . -> . any)) - (send/suspend ((string? . -> . any/c) . -> . request?)) - (send/forward ((string? . -> . any/c) . -> . request?)) - ;;; validate-xexpr/callback is not checked anywhere: - (send/suspend/callback (xexpr/callback? . -> . any))) + [adjust-timeout! (number? . -> . any)] + [send/back (any/c . -> . any)] + [send/finish (any/c . -> . any)] + [send/suspend ((string? . -> . any/c) . -> . request?)] + [send/forward ((string? . -> . any/c) . -> . request?)] + ;;; validate-xexpr/callback is not checked anywhere: + [send/suspend/callback (xexpr/callback? . -> . any)]) (provide send/suspend/dispatch @@ -24,6 +26,12 @@ ;; ************************************************************ ;; EXPORTS + + ;; adjust-timeout! : sec -> void + ;; adjust the timeout on the servlet + (define (adjust-timeout! secs) + (reset-timer (servlet-instance-timer (current-servlet-instance)) + secs)) ;; send/back: response -> void ;; send a response and don't clear the continuation table diff --git a/collects/web-server/web-server-unit.ss b/collects/web-server/web-server-unit.ss index fe5dc7290b..4fb1b9078f 100644 --- a/collects/web-server/web-server-unit.ss +++ b/collects/web-server/web-server-unit.ss @@ -7,9 +7,8 @@ "response.ss" "servlet-tables.ss" "servlet.ss" - "servlet-helpers.ss" - "timer.ss" - (lib "tcp-sig.ss" "net") + "timer.ss") + (require (lib "tcp-sig.ss" "net") (lib "unitsig.ss") (lib "string.ss") (lib "url.ss" "net") @@ -497,25 +496,17 @@ (with-handlers ([(lambda (x) #t) (make-servlet-exception-handler inst host-info)]) - - - ;; The following bindings need to be in scope for the - ;; invoke-unit/sig - (let ([adjust-timeout! - (lambda (secs) (reset-timer time-bomb secs))] - [initial-request req]) - - ;; 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 (invoke-unit/sig servlet-program servlet^)]) - (when (response? r) - (send/back r)))))))))) + ;; 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-program req)]) + (when (response? r) + (send/back r))))))))) (semaphore-post sema)))) ;; make-servlet-exit-handler: servlet-instance -> alpha -> void @@ -667,8 +658,8 @@ ;; 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 - ;;;;;; (two versions, 'v1 and I don't know what 'typed-model-split-store0 is) + ;;;; 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) (parameterize ([current-namespace (config:make-servlet-namespace)]) @@ -678,7 +669,9 @@ ;; signed-unit servlet ; MF: I'd also like to test that s has the correct import signature. [(unit/sig? s) - (make-cache-entry s (current-namespace))] + (make-cache-entry (lambda (initial-request) + (invoke-unit/sig s servlet^)) + (current-namespace))] ; FIX - reason about exceptions from dynamic require (catch and report if not already) ;; module servlet [(void? s) @@ -689,17 +682,10 @@ (let ([timeout (dynamic-require module-name 'timeout)] [start (dynamic-require module-name 'start)]) (make-cache-entry - (unit/sig () - (import servlet^) + (lambda (initial-request) (adjust-timeout! timeout) (start initial-request)) (current-namespace)))] - [(typed-model-split-store-0) - (let ([constrained (dynamic-require module-name 'type)] - [the-servlet (dynamic-require module-name 'servlet)]) - ; more here - check constraints - (make-cache-entry the-servlet - (current-namespace)))] [else (raise (format "unknown servlet version ~e" version))]))] ;; response @@ -708,8 +694,8 @@ (begin (set! go (lambda () (load/use-compiled a-path))) s))]) - (make-cache-entry (unit/sig () (import servlet^) (go)) + (make-cache-entry (lambda (initial-request) (go)) (current-namespace)))] [else - (raise (format "Loading ~e produced ~n~e~n instead of a servlet." a-path s))]))))) + (raise 'load-servlet/path "Loading ~e produced ~n~e~n instead of a servlet." a-path s)]))))) ))) \ No newline at end of file