Merging the web language dispatcher into the standard one
svn: r12378
This commit is contained in:
Jay McCarthy
parent
f7481b0c08
commit
4f8dfc7514
|
|
@ -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"]
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
#lang web-server
|
||||
(provide start)
|
||||
(define interface-version 'stateless)
|
||||
(provide start interface-version)
|
||||
|
||||
(define msg (make-parameter "unknown"))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
#lang web-server
|
||||
(provide start)
|
||||
(define interface-version 'stateless)
|
||||
(provide start interface-version)
|
||||
|
||||
(define msg (make-web-parameter "unknown"))
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
#lang web-server
|
||||
(provide start)
|
||||
(define interface-version 'stateless)
|
||||
(provide start interface-version)
|
||||
|
||||
(define (directory-page n)
|
||||
(send/suspend/url
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
#lang web-server
|
||||
(provide start)
|
||||
(define interface-version 'stateless)
|
||||
(provide start interface-version)
|
||||
|
||||
(define (gn which)
|
||||
(cadr
|
||||
|
|
|
|||
|
|
@ -1,5 +1,7 @@
|
|||
#lang web-server
|
||||
(provide start)
|
||||
(define interface-version 'stateless)
|
||||
(provide start interface-version)
|
||||
|
||||
(define (gn which)
|
||||
(cadr
|
||||
(send/suspend
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
#lang web-server
|
||||
(provide start)
|
||||
(define interface-version 'stateless)
|
||||
(provide start interface-version)
|
||||
|
||||
(define (start initial-request)
|
||||
(define counter1 0)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))))))))
|
||||
|
|
@ -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))))
|
||||
|
|
@ -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"))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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?])
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
|
|
|
|||
|
|
@ -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.}
|
||||
]
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user