diff --git a/collects/tests/web-server/dispatchers/dispatch-lang-test.ss b/collects/tests/web-server/dispatchers/dispatch-lang-test.ss index 73b652b2e2..0a12cc6ccc 100644 --- a/collects/tests/web-server/dispatchers/dispatch-lang-test.ss +++ b/collects/tests/web-server/dispatchers/dispatch-lang-test.ss @@ -6,12 +6,13 @@ web-server/dispatchers/dispatch web-server/private/request-structs web-server/configuration/namespace - (prefix-in lang: web-server/dispatchers/dispatch-lang) + #;(prefix-in lang: web-server/dispatchers/dispatch-lang) + (prefix-in servlets: web-server/dispatchers/dispatch-servlets) "servlet-test-util.ss" "../util.ss") (provide dispatch-lang-tests) -(define (mkd p) +#;(define (mkd p) (lang:make #:url->path (lambda _ (values p (list p))) #:make-servlet-namespace (make-make-servlet-namespace) @@ -24,6 +25,21 @@ ((error-display-handler) (exn-message exn) exn) (raise exn)))) +(define (mkd p) + (define-values (! u->s) + (servlets:make-cached-url->servlet + (lambda _ (values p url0s)) + (servlets:make-default-path->servlet))) + (define d + (servlets:make u->s + #:responders-servlet-loading + (lambda (u exn) + (raise exn)) + #:responders-servlet + (lambda (u exn) + (raise exn)))) + d) + (define example-servlets (build-path (collection-path "web-server") "default-web-root" "htdocs" "lang-servlets/")) (define dispatch-lang-tests @@ -32,7 +48,7 @@ (test-exn "add-param.ss - Parameters, s/s/u (should fail)" - exn:dispatcher? + exn:fail:contract? (lambda () (let* ([xs #"10"] [ys #"17"] diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/add-param.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add-param.ss index 6ee4c7af9a..6099ad5021 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/add-param.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/add-param.ss @@ -1,5 +1,6 @@ #lang web-server -(provide start) +(define interface-version 'stateless) +(provide start interface-version) (define msg (make-parameter "unknown")) diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/add-simple.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add-simple.ss index 8ed534d794..8bcc653a5d 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/add-simple.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/add-simple.ss @@ -1,5 +1,6 @@ #lang web-server -(provide start) +(define interface-version 'stateless) +(provide start interface-version) (define msg (make-web-parameter "unknown")) diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/add.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add.ss index 267462d05b..eae0530e17 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/add.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/add.ss @@ -1,5 +1,6 @@ #lang web-server -(provide start) +(define interface-version 'stateless) +(provide start interface-version) ;; get-number-from-user: string -> number ;; ask the user for a number diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/add01.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add01.ss index 3b4d02c8fb..db066a6bc9 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/add01.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/add01.ss @@ -1,7 +1,8 @@ #lang scheme/base (require web-server/private/request-structs net/url) -(provide start) +(define interface-version 'stateless) +(provide start interface-version) (define (start req) (let* ([uri (request-uri req)] diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/add02.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add02.ss index 6767ebae36..46eacc3c06 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/add02.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/add02.ss @@ -1,5 +1,6 @@ #lang web-server -(provide start) +(define interface-version 'stateless) +(provide start interface-version) ;; get-number-from-user: string -> number ;; ask the user for a number diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/add03.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add03.ss index bbcef04f03..7f87454f70 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/add03.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/add03.ss @@ -1,5 +1,6 @@ #lang web-server -(provide start) +(define interface-version 'stateless) +(provide start interface-version) ;; get-number-from-user: string -> number ;; ask the user for a number diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/add04.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add04.ss index d8a55f8d08..cab7b4978a 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/add04.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/add04.ss @@ -1,5 +1,6 @@ #lang web-server -(provide start) +(define interface-version 'stateless) +(provide start interface-version) ;; get-number-from-user: string -> number ;; ask the user for a number diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/add06.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add06.ss index 3aff7d3ac4..8e647a261f 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/add06.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/add06.ss @@ -1,5 +1,6 @@ #lang web-server -(provide start) +(define interface-version 'stateless) +(provide start interface-version) ;; get-number-from-user: string -> number ;; ask the user for a number diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/check-dir.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/check-dir.ss index 2d7fbcfb97..a512c80322 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/check-dir.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/check-dir.ss @@ -1,5 +1,6 @@ #lang web-server -(provide start) +(define interface-version 'stateless) +(provide start interface-version) (define (directory-page n) (send/suspend/url diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/mm00.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/mm00.ss index 87e1095668..1603bdcb21 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/mm00.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/mm00.ss @@ -1,5 +1,6 @@ #lang web-server -(provide start) +(define interface-version 'stateless) +(provide start interface-version) (define (gn which) (cadr diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/mm01.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/mm01.ss index 1e1e4249b9..03e985be50 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/mm01.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/mm01.ss @@ -1,5 +1,7 @@ #lang web-server -(provide start) +(define interface-version 'stateless) +(provide start interface-version) + (define (gn which) (cadr (send/suspend diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/quiz01.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/quiz01.ss index 2ab8d40564..2081c0d178 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/quiz01.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/quiz01.ss @@ -1,6 +1,7 @@ #lang web-server (require "quiz-lib.ss") -(provide start) +(define interface-version 'stateless) +(provide start interface-version) ;; get-answer: mc-question -> number ;; get an answer for a multiple choice question diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/quiz02.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/quiz02.ss index a60f9ed757..c9d78d1510 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/quiz02.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/quiz02.ss @@ -1,6 +1,7 @@ #lang web-server (require "quiz-lib.ss") -(provide start) +(define interface-version 'stateless) +(provide start interface-version) ;; get-answer: mc-question -> number ;; get an answer for a multiple choice question diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/wc-comp.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/wc-comp.ss index f519eae359..e91cd862a0 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/wc-comp.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/wc-comp.ss @@ -1,6 +1,7 @@ #lang web-server (require web-server/lang/web-cell-component) -(provide start) +(define interface-version 'stateless) +(provide start interface-version) (define (start initial-request) ; A top-level frame must exist diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/wc-fake.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/wc-fake.ss index 589a5a5821..6df0482c72 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/wc-fake.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/wc-fake.ss @@ -1,5 +1,6 @@ #lang web-server -(provide start) +(define interface-version 'stateless) +(provide start interface-version) (define (start initial-request) (define counter1 0) diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/wc.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/wc.ss index f396b8ea45..7861468dd0 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/wc.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/wc.ss @@ -1,5 +1,6 @@ #lang web-server -(provide start) +(define interface-version 'stateless) +(provide start interface-version) (define (start initial-request) ; A top-level frame must exist diff --git a/collects/web-server/dispatchers/dispatch-lang.ss b/collects/web-server/dispatchers/dispatch-lang.ss deleted file mode 100644 index 595a12eff6..0000000000 --- a/collects/web-server/dispatchers/dispatch-lang.ss +++ /dev/null @@ -1,101 +0,0 @@ -#lang scheme/base -(require mzlib/list - scheme/contract - (only-in "../lang/web.ss" - initialize-servlet) - web-server/lang/web-cells - web-server/managers/none - web-server/private/servlet - "../private/request-structs.ss" - "../private/response-structs.ss" - "dispatch.ss" - net/url - "../private/web-server-structs.ss" - "../private/util.ss" - "../private/response.ss" - "../dispatchers/filesystem-map.ss" - "../configuration/namespace.ss" - "../configuration/responders.ss") - -(provide/contract - [interface-version dispatcher-interface-version/c] - [make - (->* (#:url->path url->path/c) - (#:make-servlet-namespace make-servlet-namespace/c - #:responders-servlet-loading (url? any/c . -> . response?) - #:responders-servlet (url? any/c . -> . response?)) - dispatcher/c)]) - -;; HACK -(define the-session-table (make-weak-hash)) - -(define (install-session ses paths) - (hash-set! the-session-table paths ses)) - -;; lookup-session : (listof string) -> (union session #f) -(define (lookup-session paths) - (hash-ref the-session-table paths - (lambda () #f))) -;; /HACK - - -(define interface-version 'v1) -(define (make #:url->path url->path - #:make-servlet-namespace [make-servlet-namespace (make-make-servlet-namespace)] - #:responders-servlet-loading [responders-servlet-loading servlet-loading-responder] - #:responders-servlet [responders-servlet servlet-error-responder]) - (lambda (conn req) - (define uri (request-uri req)) - (with-handlers ([void (lambda (exn) (next-dispatcher))]) - (define-values (a-path url-servlet-path) (url->path uri)) - (define url-servlet-paths (map path->string url-servlet-path)) - (with-handlers ([exn? - (lambda (the-exn) - (output-response/method - conn - (responders-servlet-loading uri the-exn) - (request-method req)))]) - - (define ses - (cond - [(lookup-session url-servlet-paths) - => (lambda (ses) ses)] - [else - (let () - (define cust (make-servlet-custodian)) - (define ns (make-servlet-namespace - #:additional-specs - '(web-server/lang/web-cells - web-server/lang/abort-resume - web-server/private/servlet - web-server/private/request-structs))) - (define dir (directory-part a-path)) - (define ses - (make-servlet - cust ns - (create-none-manager (lambda (req) (error "No continuations!"))) - dir - (lambda (req) (error "session not initialized")))) - (parameterize ([current-custodian cust] - [current-directory dir] - [current-namespace ns] - [current-execution-context (make-execution-context req)] - [current-servlet ses]) - (define start - (dynamic-require `(file ,(path->string a-path)) - 'start)) - (set-servlet-handler! ses (initialize-servlet start))) - (install-session ses url-servlet-paths) - ses)])) - (parameterize ([current-custodian (servlet-custodian ses)] - [current-directory (servlet-directory ses)] - [current-namespace (servlet-namespace ses)] - [current-execution-context (make-execution-context req)] - [current-servlet ses]) - (with-handlers ([exn? - (lambda (the-exn) - (output-response/method - conn - (responders-servlet uri the-exn) - (request-method req)))]) - (output-response conn ((servlet-handler ses) req)))))))) \ No newline at end of file diff --git a/collects/web-server/dispatchers/dispatch-servlets.ss b/collects/web-server/dispatchers/dispatch-servlets.ss index ce5e3cf100..cf5d13f268 100644 --- a/collects/web-server/dispatchers/dispatch-servlets.ss +++ b/collects/web-server/dispatchers/dispatch-servlets.ss @@ -4,6 +4,9 @@ (require "dispatch.ss" "../private/web-server-structs.ss" "../private/connection-manager.ss" + web-server/managers/none + (only-in "../lang/web.ss" + initialize-servlet) "../private/response.ss" "../private/request-structs.ss" "../private/response-structs.ss" @@ -42,34 +45,71 @@ (lambda (initial-request) ((unbox go)))) -(define (v1.module->v1.lambda timeout start) - (lambda (initial-request) - (adjust-timeout! timeout) - (start initial-request))) - (define (make-v1.servlet directory timeout start) - (make-v2.servlet directory - (create-timeout-manager - default-servlet-instance-expiration-handler - timeout - timeout) - (v1.module->v1.lambda timeout start))) + (make-v2.servlet + directory + (create-timeout-manager + default-servlet-instance-expiration-handler + timeout + timeout) + (lambda (initial-request) + (adjust-timeout! timeout) + (start initial-request)))) (define (make-v2.servlet directory manager start) - (make-servlet (current-custodian) - (current-namespace) - manager - directory - start)) + (make-servlet + (current-custodian) + (current-namespace) + manager + directory + (lambda (req) + (define uri (request-uri req)) + + (define-values (instance-id handler) + (cond + [(continuation-url? uri) + => (match-lambda + [(list instance-id k-id salt) + (values instance-id + (custodian-box-value ((manager-continuation-lookup manager) instance-id k-id salt)))])] + [else + (values ((manager-create-instance manager) (exit-handler)) + start)])) + + (parameterize ([current-servlet-instance-id instance-id]) + (handler req))))) -(define default-module-specs - '(web-server/servlet - web-server/private/servlet - web-server/servlet/web +(define (make-stateless.servlet directory start) + (define ses + (make-servlet + (current-custodian) (current-namespace) + (create-none-manager (lambda (req) (error "No continuations!"))) + directory + (lambda (req) (error "Session not initialized")))) + (parameterize ([current-directory directory] + [current-servlet ses]) + (set-servlet-handler! ses (initialize-servlet start))) + ses) + +(define common-module-specs + '(web-server/private/servlet + web-server/private/request-structs + web-server/private/response-structs)) + +(define servlet-module-specs + '(web-server/servlet/web web-server/servlet/web-cells)) +(define lang-module-specs + '(web-server/lang/web-cells + web-server/lang/abort-resume)) +(define default-module-specs + (append common-module-specs + servlet-module-specs + lang-module-specs)) (provide/contract [make-v1.servlet (path? integer? (request? . -> . response?) . -> . servlet?)] [make-v2.servlet (path? manager? (request? . -> . response?) . -> . servlet?)] + [make-stateless.servlet (path? (request? . -> . response?) . -> . servlet?)] [default-module-specs (listof module-path?)]) (define (make-default-path->servlet #:make-servlet-namespace [make-servlet-namespace (make-make-servlet-namespace)] @@ -93,8 +133,11 @@ (let ([start (dynamic-require module-name 'start)] [manager (dynamic-require module-name 'manager)]) (make-v2.servlet (directory-part a-path) manager start))] + [(stateless) + (let ([start (dynamic-require module-name 'start)]) + (make-stateless.servlet (directory-part a-path) start))] [else - (error 'path->servlet "unknown servlet version ~e, must be 'v1 or 'v2" version)]))] + (error 'path->servlet "unknown servlet version ~e, must be 'v1, 'v2, or 'stateless" version)]))] [(response? s) (make-v1.servlet (directory-part a-path) timeouts-default-servlet (v0.response->v1.lambda s a-path))] @@ -173,28 +216,14 @@ [current-custodian (servlet-custodian the-servlet)] [current-directory (servlet-directory the-servlet)] [current-namespace (servlet-namespace the-servlet)]) - (define manager (servlet-manager the-servlet)) - - (define-values (instance-id handler) - (cond - [(continuation-url? uri) - => (match-lambda - [(list instance-id k-id salt) - (values instance-id - (custodian-box-value ((manager-continuation-lookup manager) instance-id k-id salt)))])] - [else - (values ((manager-create-instance manager) (exit-handler)) - (servlet-handler the-servlet))])) - - (parameterize ([current-servlet-instance-id instance-id]) - (with-handlers ([(lambda (x) #t) - (lambda (exn) - (responders-servlet - (request-uri req) - exn))]) - (call-with-continuation-prompt - (lambda () - (handler req)) - servlet-prompt)))))) + (with-handlers ([(lambda (x) #t) + (lambda (exn) + (responders-servlet + (request-uri req) + exn))]) + (call-with-continuation-prompt + (lambda () + ((servlet-handler the-servlet) req)) + servlet-prompt))))) (output-response conn response)))) \ No newline at end of file diff --git a/collects/web-server/run.ss b/collects/web-server/run.ss index ef3462485c..cfda21691b 100644 --- a/collects/web-server/run.ss +++ b/collects/web-server/run.ss @@ -6,13 +6,14 @@ web-server/web-server web-server/configuration/responders web-server/private/mime-types + (prefix-in path-procedure: "dispatchers/dispatch-pathprocedure.ss") (prefix-in fsmap: web-server/dispatchers/filesystem-map) (prefix-in timeout: web-server/dispatchers/dispatch-timeout) (prefix-in files: web-server/dispatchers/dispatch-files) (prefix-in filter: web-server/dispatchers/dispatch-filter) (prefix-in lift: web-server/dispatchers/dispatch-lift) (prefix-in sequencer: web-server/dispatchers/dispatch-sequencer) - (prefix-in lang: web-server/dispatchers/dispatch-lang) + (prefix-in servlets: web-server/dispatchers/dispatch-servlets) (prefix-in stat: web-server/dispatchers/dispatch-stat)) (define server-root-path (make-parameter (collection-path "web-server" "default-web-root"))) @@ -35,6 +36,7 @@ (define default-host-path (build-path (server-root-path) "conf")) (define file-not-found-file (build-path default-host-path "not-found.html")) (define servlet-error-file (build-path default-host-path "servlet-error.html")) +(define servlet-refresh-file (build-path default-host-path "servlet-refresh.html")) (define url->path (fsmap:make-url->path @@ -47,11 +49,21 @@ (sequencer:make (timeout:make (* 5 60)) (stat:make) - (filter:make - #rx"\\.ss" - (lang:make #:url->path (fsmap:make-url->valid-path url->path) - #:responders-servlet-loading (gen-servlet-responder servlet-error-file) - #:responders-servlet (gen-servlet-responder servlet-error-file))) + (let-values ([(clear-cache! url->servlet) + (servlets:make-cached-url->servlet + (fsmap:filter-url->path + #rx"\\.(ss|scm)$" + (fsmap:make-url->valid-path + url->path)) + (servlets:make-default-path->servlet))]) + (sequencer:make + (path-procedure:make "/conf/refresh-servlets" + (lambda _ + (clear-cache!) + ((gen-servlets-refreshed servlet-refresh-file)))) + (servlets:make url->servlet + #:responders-servlet-loading (gen-servlet-responder servlet-error-file) + #:responders-servlet (gen-servlet-responder servlet-error-file)))) (files:make #:url->path url->path #:path->mime-type (make-path->mime-type (build-path (server-root-path) "mime.types")) #:indices (list "index.html" "index.htm")) diff --git a/collects/web-server/scribblings/dispatchers.scrbl b/collects/web-server/scribblings/dispatchers.scrbl index 3bb4c7e2ff..d18e351bc3 100644 --- a/collects/web-server/scribblings/dispatchers.scrbl +++ b/collects/web-server/scribblings/dispatchers.scrbl @@ -328,10 +328,10 @@ a URL that refreshes the password file, servlet cache, etc.} This dispatcher supports HTTP Range GET requests and HEAD requests.}} @; ------------------------------------------------------------ -@section[#:tag "dispatch-servlets.ss"]{Serving Scheme Servlets} +@section[#:tag "dispatch-servlets.ss"]{Serving Servlets} @a-dispatcher[web-server/dispatchers/dispatch-servlets @elem{defines a dispatcher constructor - that runs servlets written in Scheme.}]{ + that runs servlets.}]{ @defproc[(make-v1.servlet [directory path?] [timeout integer?] @@ -346,6 +346,12 @@ a URL that refreshes the password file, servlet cache, etc.} servlet?]{ Creates a version 2 servlet that uses @scheme[directory] as its current directory, a @scheme[manager] as the continuation manager, and @scheme[start] as the request handler. } + +@defproc[(make-stateless.servlet [directory path?] + [start (request? . -> . response?)]) + servlet?]{ + Creates a stateless servlet that uses @scheme[directory] as its current directory and @scheme[start] as the request handler. +} @defthing[default-module-specs (listof module-path?)]{ The modules that the Web Server needs to share with all servlets. @@ -398,32 +404,6 @@ Equivalent to @scheme[(path? . -> . servlet?)]. } -@; ------------------------------------------------------------ -@section[#:tag "dispatch-lang.ss"]{Serving Web Language Servlets} -@a-dispatcher[web-server/dispatchers/dispatch-lang - @elem{defines a dispatcher constructor - that runs servlets written in the Web Language.}]{ - -@defproc[(make [#:url->path url->path url->path/c] - [#:make-servlet-namespace make-servlet-namespace - make-servlet-namespace? - (make-make-servlet-namespace)] - [#:responders-servlet-loading responders-servlet-loading - ((url url?) (exn exn?) . -> . response?) - servlet-loading-responder] - [#:responders-servlet responders-servlet - ((url url?) (exn exn?) . -> . response?) - servlet-error-responder]) - dispatcher/c]{ - If the request URL contains a serialized continuation, then it is invoked with the - request. Otherwise, @scheme[url->path] is used to resolve the URL to a path. - The path is evaluated as a module, in a namespace constructed by @scheme[make-servlet-namespace]. - If this fails then @scheme[responders-servlet-loading] is used to format a response - with the exception. If it succeeds, then @scheme[start] export of the module is invoked. - If there is an error when a servlet is invoked, then @scheme[responders-servlet] is - used to format a response with the exception. -}} - @; ------------------------------------------------------------ @section[#:tag "dispatch-stat.ss"]{Statistics} @a-dispatcher[web-server/dispatchers/dispatch-stat diff --git a/collects/web-server/scribblings/lang.scrbl b/collects/web-server/scribblings/lang.scrbl index b4b039cff9..147ea263e5 100644 --- a/collects/web-server/scribblings/lang.scrbl +++ b/collects/web-server/scribblings/lang.scrbl @@ -2,36 +2,16 @@ @(require "web-server.ss") @title[#:tag "lang" - #:style 'toc]{Web Language Servlets} + #:style 'toc]{Web Language} +@defmodulelang[web-server] + The @web-server allows servlets to be written in a special Web language that is nearly identical to Scheme. Herein we discuss how it is different and what API is provided. @local-table-of-contents[] -@; ------------------------------------------------------------ -@section[#:tag "lang-servlets"]{Definition} -@(require (for-label "dummy-language-servlet.ss")) @; to give a binding context - -@defmodule*/no-declare[(web-server/lang)] - -@declare-exporting[#:use-sources (web-server/scribblings/dummy-language-servlet)] - -A @defterm{Web language servlet} is a module written in the -@schememodname[web-server/lang] language. The servlet module should -provide the following function: - -@defproc[(start [initial-request request?]) - response?]{ - Called when this servlet is invoked. - The argument is the HTTP request that initiated the servlet. -} - -The only way to run Web language servlets currently is to use the -functional interface to starting the server and create a dispatcher -that includes a @scheme[make-lang-dispatcher] dispatcher. - @; ------------------------------------------------------------ @section[#:tag "considerations"]{Usage Considerations} @@ -156,10 +136,15 @@ the future. @defproc[(stuff-url [v serializable?] [u url?]) url?]{ - Serializes @scheme[v] and computes the MD5 of the serialized - representation. The serialization of @scheme[v] is written to - @filepath{$HOME/.urls/M} where `M' is the MD5. `M' is then - placed in @scheme[u] as a URL param. + Returns a URL based on @scheme[u] with @scheme[v] serialized and "stuffed" into it. + The following steps are applied until the URL is short enough to be accepted by IE. + @itemize[ + @item{Put the plain-text serialization in the URL.} + @item{Compress the serialization with @schememodname[file/gzip] into the URL.} + @item{Compute the MD5 of the compressed seralization and write it to + @filepath{$HOME/.urls/M} where `M' is the MD5. `M' is then + placed in the URL} + ] } @defproc[(stuffed-url? [u url?]) diff --git a/collects/web-server/scribblings/servlet.scrbl b/collects/web-server/scribblings/servlet.scrbl index 1991d05ce3..b065603d4d 100644 --- a/collects/web-server/scribblings/servlet.scrbl +++ b/collects/web-server/scribblings/servlet.scrbl @@ -20,7 +20,7 @@ of these servlets. A @defterm{servlet} is a module that provides the following: -@defthing[interface-version (one-of/c 'v1 'v2)]{ +@defthing[interface-version (one-of/c 'v1 'v2 'stateless)]{ A symbol indicating the servlet interface the servlet conforms to. This influences the other provided identifiers. } @@ -74,6 +74,13 @@ An example version 2 module: (body (h1 "Hi Mom!")))) ] +An example @scheme['stateless] servlet module: +@schememod[ + web-server + (define interface-version 'stateless) + (define (start req) + `(html (body (h2 "Look ma, no state!")))) +] @; ------------------------------------------------------------ @section[#:tag "servlet-structs.ss"]{Contracts} diff --git a/collects/web-server/scribblings/web-server-unit.scrbl b/collects/web-server/scribblings/web-server-unit.scrbl index ac9315ef37..d830b52d59 100644 --- a/collects/web-server/scribblings/web-server-unit.scrbl +++ b/collects/web-server/scribblings/web-server-unit.scrbl @@ -43,7 +43,7 @@ operations: @item{Allows the @scheme["/conf/refresh-passwords"] URL to refresh the password file.} @item{Allows the @scheme["/conf/collect-garbage"] URL to call the garbage collector.} @item{Allows the @scheme["/conf/refresh-servlets"] URL to refresh the servlets cache.} - @item{Execute servlets in the mapping URLs to the given servlet root directory.} + @item{Execute servlets in the mapping URLs to the given servlet root directory under htdocs.} @item{Serves files under the @scheme["/"] URL in the given htdocs directory.} ]