suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Big bang coercion

Browse Source
This commit is contained in:
Jay McCarthy 2010-12-07 14:00:47 -07:00
parent c011d611ca
commit 58494c125b
28 changed files with 169 additions and 147 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/tests/web-server/pr/compat0.rkt
View File

@ -3,4 +3,6 @@
web-server/http/response-structs
web-server/compat/0/http/response-structs
web-server/http/cookie
web-server/compat/0/http/cookie)
web-server/compat/0/http/cookie
web-server/servlet/servlet-structs
web-server/compat/0/servlet/servlet-structs)

27
collects/web-server/compat/0/README
View File

@ -1,19 +1,22 @@
In Racket 5.0.99.4 and before, the Web Server supported implicit
conversion of X-expressions and lists with the format (cons/c bytes? (listof (or/c string? bytes?))) into response data structures for output.
After 5.0.99.4, this implicit conversion has been generalized into current-response/c and response/c. In the process, implicit conversion has been completely removed from some internal plumbing AND the response structures have been streamlined---primarily for efficiency.
After 5.0.99.4, this implicit conversion has been generalized into any->response. In the process, implicit conversion has been completely removed from some internal plumbing AND the response structures have been streamlined---primarily for efficiency.
This document describes the incompatible changes and how to restore the old behavior when that is possible.
--- Coercion behavior ---
The old coercion behavior will be dynamically introduced by requiring
web-server/compat/0/coerce or parameterizing current-response/c to
(coerce/c normalize-response) after requiring
web-server/compat/0/http/response-structs.
web-server/compat/0/coerce or running:
Since Xexpr conversion is so convenient, xexpr-response/c is now
provided by http/xexpr for use with current-response/c.
(require web-server/compat/0/http/response-structs)
(set-any->response! normalize-response)
Users may want to allow implicit X-expression conversion by
running
(set-any->response! response/xexpr)
--- New response structures ---
@ -71,9 +74,19 @@ that the wrapper returns an Xexpr. This changes is justified in that
formlets already bake in support for Xexpr as a fundamental part of
their syntax.
--- Removed contracts ---
web-server/compat/0/servlet/servlet-structs
is a replacement for the old
web-server/servlet/servlet-structs
because
k-url?
response-generator/c
expiration-handler/c
are now removed. (This change is to ensure that internal uses of these
have can-be-response? close to where they are used so any->response can be called appropriately.)

6
collects/web-server/compat/0/coerce.rkt
View File

@ -1,6 +1,4 @@
#lang racket/base
(require unstable/contract
"http/response-structs.rkt"
(require "http/response-structs.rkt"
web-server/servlet/servlet-structs)
(current-response/c (coerce/c normalize-response))
(set-any->response! normalize-response)

12
collects/web-server/compat/0/servlet/servlet-structs.rkt
View File

@ -1,29 +1,21 @@
#lang racket/base
(require racket/contract
unstable/contract
web-server/http)
(define current-response/c
(make-parameter any/c))
(define response/c
(dynamic/c any/c current-response/c response?))
(define k-url?
string?)
(define response-generator/c
(k-url? . -> . response/c))
(k-url? . -> . can-be-response?))
(define expiration-handler/c
(or/c false/c
(request? . -> . response/c)))
(request? . -> . can-be-response?)))
(define embed/url/c
((request? . -> . any) . -> . string?))
(provide/contract
[current-response/c (parameter/c contract?)]
[response/c contract?]
[response-generator/c contract?]
[k-url? contract?]
[expiration-handler/c contract?]

2
collects/web-server/dispatch/serve.rkt
View File

@ -9,4 +9,4 @@
#:servlet-regexp #rx""))
(provide/contract
[serve/dispatch ((request? . -> . response/c) . -> . void)])
[serve/dispatch ((request? . -> . can-be-response?) . -> . void)])

8
collects/web-server/dispatchers/dispatch-servlets.rkt
View File

@ -48,8 +48,8 @@
; -----
(provide/contract
[make (->* (url->servlet/c)
(#:responders-servlet-loading (url? any/c . -> . response/c)
#:responders-servlet (url? any/c . -> . response/c))
(#:responders-servlet-loading (url? any/c . -> . can-be-response?)
#:responders-servlet (url? any/c . -> . can-be-response?))
dispatcher/c)])
(define (make url->servlet
@ -64,7 +64,7 @@
(lambda _
(kill-connection! conn)
(custodian-shutdown-all instance-custodian))])
(define response
(define maybe-response
(with-handlers ([exn:fail:filesystem:exists?
(lambda (the-exn) (next-dispatcher))]
[exn:dispatcher? raise]
@ -85,4 +85,4 @@
((servlet-handler the-servlet) req))
servlet-prompt)))))))
(output-response conn response))))
(output-response conn (any->response maybe-response)))))

13
collects/web-server/http/xexpr.rkt
View File

@ -3,22 +3,10 @@
racket/list
xml
web-server/private/xexpr
unstable/contract
"request-structs.rkt"
"cookie.rkt"
"response-structs.rkt")
(define xexpr-response/c
(coerce/c
(λ (x)
(cond
[(response? x)
x]
[(xexpr? x)
(response/xexpr x)]
[else
#f]))))
(define (response/xexpr
xexpr
#:code [code 200]
@ -37,7 +25,6 @@
(write-xexpr xexpr out))))
(provide/contract
[xexpr-response/c contract?]
[response/xexpr
((pretty-xexpr/c)
(#:code number? #:message bytes? #:seconds number? #:mime-type bytes? #:headers (listof header?) #:preamble bytes?)

4
collects/web-server/insta/insta.rkt
View File

@ -58,8 +58,8 @@
#'(body ...))])
(quasisyntax/loc stx
(#,@expanded
(provide/contract (#,start (request? . -> . response/c)))
(serve/servlet (contract (request? . -> . response/c) #,start
(provide/contract (#,start (request? . -> . can-be-response?)))
(serve/servlet (contract (request? . -> . can-be-response?) #,start
'you 'web-server
"start"
#f)

16
collects/web-server/lang/web.rkt
View File

@ -27,25 +27,25 @@
(provide/contract
[make-stateless-servlet
(custodian? namespace? manager? path-string? (request? . -> . response/c)
(custodian? namespace? manager? path-string? (request? . -> . can-be-response?)
(stuffer/c serializable? bytes?) . -> . stateless-servlet?)])
; These contracts interfere with the continuation safety marks
#;(provide/contract
;; Server Interface
[initialize-servlet ((request? . -> . response/c) . -> . (request? . -> . response/c))]
[initialize-servlet ((request? . -> . can-be-response?) . -> . (request? . -> . can-be-response?))]
;; Servlet Interface
[send/suspend ((string? . -> . response/c) . -> . request?)]
[send/suspend/dispatch ((((request? . -> . any/c) . -> . string?) . -> . response/c)
[send/suspend ((string? . -> . can-be-response?) . -> . request?)]
[send/suspend/dispatch ((((request? . -> . any/c) . -> . string?) . -> . can-be-response?)
. -> . any/c)]
[send/suspend/hidden ((url? list? . -> . response/c) . -> . request?)]
[send/suspend/url ((url? . -> . response/c) . -> . request?)]
[send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response/c)
[send/suspend/hidden ((url? list? . -> . can-be-response?) . -> . request?)]
[send/suspend/url ((url? . -> . can-be-response?) . -> . request?)]
[send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . can-be-response?)
. -> . any/c)]
[redirect/get (-> request?)])
;; initial-servlet : (request -> response) -> (request -> response/c)
;; initial-servlet : (request -> response) -> (request -> can-be-response?)
(define (initialize-servlet start)
(let ([params (current-parameterization)])
(lambda (req0)

4
collects/web-server/managers/lru.rkt
View File

@ -7,7 +7,7 @@
[create-LRU-manager
(->
(or/c false/c
(request? . -> . response/c))
(request? . -> . can-be-response?))
number? number? (-> boolean?)
#:initial-count number?
#:inform-p (number? . -> . void)
@ -15,7 +15,7 @@
[make-threshold-LRU-manager
(->
(or/c false/c
(request? . -> . response/c))
(request? . -> . can-be-response?))
number?
manager?)])

11
collects/web-server/managers/manager.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require racket/contract)
(require web-server/servlet/servlet-structs)
(require racket/contract
web-server/http
web-server/servlet/servlet-structs)
(define-struct manager (create-instance
adjust-timeout!
@ -20,7 +21,7 @@
(->
number? any/c
(or/c false/c
(request? . -> . response/c))
(request? . -> . can-be-response?))
(list/c number? number?))]
[continuation-lookup (number? number? number? . -> . any/c)]
[continuation-peek (number? number? number? . -> . any/c)])]
@ -29,10 +30,10 @@
[continuation-marks continuation-mark-set?]
[expiration-handler
(or/c false/c
(request? . -> . response/c))])]
(request? . -> . can-be-response?))])]
[struct (exn:fail:servlet-manager:no-continuation exn:fail)
([message string?]
[continuation-marks continuation-mark-set?]
[expiration-handler
(or/c false/c
(request? . -> . response/c))])])
(request? . -> . can-be-response?))])])

2
collects/web-server/managers/none.rkt
View File

@ -6,7 +6,7 @@
[create-none-manager
(->
(or/c false/c
(request? . -> . response/c))
(request? . -> . can-be-response?))
manager?)])
(define-struct (none-manager manager) (instance-expiration-handler))

2
collects/web-server/managers/timeouts.rkt
View File

@ -8,7 +8,7 @@
[create-timeout-manager
(->
(or/c false/c
(request? . -> . response/c))
(request? . -> . can-be-response?))
number? number?
manager?)])

2
collects/web-server/private/servlet.rkt
View File

@ -22,7 +22,7 @@
[namespace namespace?]
[manager manager?]
[directory path-string?]
[handler (request? . -> . response/c)])]
[handler (request? . -> . can-be-response?)])]
[struct execution-context
([request request?])]
[current-servlet (parameter/c (or/c false/c servlet?))]

41
collects/web-server/scribblings/contracts.scrbl
View File

@ -1,25 +1,42 @@
#lang scribble/doc
@(require "web-server.rkt")
@title[#:tag "servlet-structs"]{Common Contracts}
@title[#:tag "servlet-structs"]{Responses}
@(require (for-label web-server/servlet/servlet-structs
web-server/http
web-server/servlet))
@defmodule[web-server/servlet/servlet-structs]{
Servlets communicate to the Web Server by returning HTTP responses. In order to
accomodate lightweight programs (and backwards compatibility), the Web Server
provides an indirection from application-specific response formats and the internal
HTTP response format, @racket[response].
This module provides a number of contracts
for use in servlets.
@deftogether[[
@defthing[(can-be-response? [x any/c])
boolean?]
@defproc[(any->response [x any/c])
(or/c false/c response?)]
@defproc[(set-any->response! [new-any->response (-> any/c (or/c false/c response?))])
void]
]]{
@defparam[current-response/c ctc contract?]{
The contract used by @racket[response/c] dynamically. Defaults to @racket[any/c].
@racket[any->response] coerces any value into a response or returns @racket[#f] if coercion is not possible.
@racket[any->response] guarantees that any @racket[response?] input must always be returned exactly (i.e. @racket[eq?].)
@racket[can-be-response?] returns @racket[#t] if @racket[x] is a response or can be turned into a response by calling
@racket[any->response].
Users of @racket[any->response] should protect themselves by using @racket[can-be-response?] as a contract.
If they do so, they can safely ignore the @racket[#f] return case of @racket[any->response].
@racket[set-any->response!] replaces the global @racket[any->response] with the supplied argument. This
function should return the same value for @racket[eq?] inputs to ensure that @racket[can-be-response?] is
any accurate predicate. Similarly, this function should be cheap to call multiple times on the same input,
since it will be used in contract checking as well as coercion before transmission. You may want to use a
weak @racket[eq?]-based hash-table to cache the results for this purpose. (See @racket[make-weak-hasheq].)
}
@defthing[response/c contract?]{
A contract corresponding to @racket[(dynamic/c any/c current-response/c response?)].
This allows Web applications to customize the Web Server's handling of responses, while ensuring that the Web Server
always receives @racket[response?] structures.
}
}

6
collects/web-server/scribblings/dispatch-servlets.scrbl
View File

@ -28,11 +28,11 @@
@defproc[(make [url->servlet url->servlet/c]
[#:responders-servlet-loading
responders-servlet-loading
(url? exn? . -> . response/c)
(url? exn? . -> . can-be-response?)
servlet-loading-responder]
[#:responders-servlet
responders-servlet
(url? exn? . -> . response/c)
(url? exn? . -> . can-be-response?)
servlet-error-responder])
dispatcher/c]{
This dispatcher runs racket servlets, using @racket[url->servlet] to resolve URLs to the underlying servlets.
@ -53,7 +53,7 @@
[namespace namespace?]
[manager manager?]
[directory path-string?]
[handler (request? . -> . response/c)])
[handler (request? . -> . can-be-response?)])
#:mutable]{
Instances of this structure hold the necessary parts of a servlet:
the @racket[custodian] responsible for the servlet's resources,

18
collects/web-server/scribblings/dispatch.scrbl
View File

@ -105,9 +105,9 @@ After mastering the world of blogging software, you decide to put the ubiquitous
[dispatch-pattern dispatch-fun]
...)]
#:contracts
([else-fun (request? . -> . response/c)]
[dispatch-fun (request? any/c ... . -> . response/c)])]{
Returns two values: the first is a dispatching function with the contract @racket[(request? . -> . response/c)]
([else-fun (request? . -> . any)]
[dispatch-fun (request? any/c ... . -> . any)])]{
Returns two values: the first is a dispatching function with the contract @racket[(request? . -> . any)]
that calls the appropriate @racket[dispatch-fun] based on the first @racket[dispatch-pattern] that matches the
request's URL; the second is a URL-generating function with the contract @racket[(procedure? any/c ... . -> . string?)]
that generates a URL using @racket[dispatch-pattern] for the @racket[dispatch-fun] given as its first argument.
@ -131,8 +131,8 @@ After mastering the world of blogging software, you decide to put the ubiquitous
[dispatch-pattern dispatch-fun]
...)]
#:contracts
([else-fun (request? . -> . response/c)]
[dispatch-fun (request? any/c ... . -> . response/c)])]{
([else-fun (request? . -> . any)]
[dispatch-fun (request? any/c ... . -> . any)])]{
Like @racket[dispatch-rules], except returns a third value with the contract @racket[(request? . -> . boolean?)] that returns
@racket[#t] if the dispatching rules apply to the request and @racket[#f] otherwise.
}
@ -146,8 +146,8 @@ After mastering the world of blogging software, you decide to put the ubiquitous
[dispatch-pattern dispatch-fun]
...)]
#:contracts
([else-fun (request? . -> . response/c)]
[dispatch-fun (request? any/c ... . -> . response/c)])]{
([else-fun (request? . -> . any)]
[dispatch-fun (request? any/c ... . -> . any)])]{
Returns a dispatching function as described by @racket[dispatch-rules].
}
@ -156,11 +156,11 @@ After mastering the world of blogging software, you decide to put the ubiquitous
[dispatch-pattern dispatch-fun]
...)
#:contracts
([dispatch-fun (request? any/c ... . -> . response/c)])]{
([dispatch-fun (request? any/c ... . -> . any)])]{
Returns a URL-generating function as described by @racket[dispatch-rules].
}
@defproc[(serve/dispatch [dispatch (request? . -> . response/c)])
@defproc[(serve/dispatch [dispatch (request? . -> . can-be-response?)])
void]{
Calls @racket[serve/servlet] with a @racket[#:servlet-regexp] argument (@racket[#rx""]) so that every request is handled by @racket[dispatch].
}

12
collects/web-server/scribblings/http.scrbl
View File

@ -323,7 +323,7 @@ transmission that the server @bold{will not catch}.}
@defproc[(redirect-to [uri non-empty-string/c]
[perm/temp redirection-status? temporarily]
[#:headers headers (listof header?) (list)])
response/c]{
response?]{
Generates an HTTP response that redirects the browser to @racket[uri],
while including the @racket[headers] in the response.
@ -472,11 +472,6 @@ web-server/insta
@defmodule[web-server/http/xexpr]{
@defthing[xexpr-response/c contract?]{
A contract for use with @racket[current-response/c] that coerces
X-expressions into @racket[response?] structures using @racket[response/xexpr]
and passes @racket[response?] structures untouched.}
@defproc[(response/xexpr [xexpr xexpr/c]
[#:code code number? 200]
[#:message message bytes? #"Okay"]
@ -492,6 +487,9 @@ and passes @racket[response?] structures untouched.}
code message seconds mime-type
(append headers (map cookie->header cookies))
(list preamble (string->bytes/utf-8 (xexpr->string xexpr))))
]}
]
This is a viable function to pass to @racket[set-any->response!].
}
}

14
collects/web-server/scribblings/managers.scrbl
View File

@ -25,7 +25,7 @@ the users and implementers of managers.
[clear-continuations! (number? . -> . void)]
[continuation-store! (number? any/c
(or/c false/c
(request? . -> . response/c))
(request? . -> . can-be-response?))
. -> . (list/c number? number?))]
[continuation-lookup (number? number? number? . -> . any/c)]
[continuation-peek (number? number? number? . -> . any/c)])]{
@ -56,7 +56,7 @@ the users and implementers of managers.
@defstruct[(exn:fail:servlet-manager:no-instance exn:fail)
([expiration-handler
(or/c false/c
(request? . -> . response/c))])]{
(request? . -> . can-be-response?))])]{
This exception should be thrown by a manager when an instance is looked
up that does not exist.
}
@ -64,7 +64,7 @@ the users and implementers of managers.
@defstruct[(exn:fail:servlet-manager:no-continuation exn:fail)
([expiration-handler
(or/c false/c
(request? . -> . response/c))])]{
(request? . -> . can-be-response?))])]{
This exception should be thrown by a manager when a continuation is
looked up that does not exist.
}
@ -82,7 +82,7 @@ This module defines a manager constructor:
@defproc[(create-none-manager
(instance-expiration-handler
(or/c false/c
(request? . -> . response/c))))
(request? . -> . can-be-response?))))
manager?]{
This manager does not actually store any continuation or instance data.
You could use it if you know your servlet does not use the continuation
@ -110,7 +110,7 @@ This module defines a manager constructor:
@defproc[(create-timeout-manager
[instance-exp-handler
(or/c false/c
(request? . -> . response/c))]
(request? . -> . can-be-response?))]
[instance-timeout number?]
[continuation-timeout number?])
manager?]{
@ -145,7 +145,7 @@ This module defines a manager constructor:
@defproc[(create-LRU-manager
[instance-expiration-handler
(or/c false/c
(request? . -> . response/c))]
(request? . -> . can-be-response?))]
[check-interval integer?]
[collect-interval integer?]
[collect? (-> boolean?)]
@ -180,7 +180,7 @@ The recommended usage of this manager is codified as the following function:
@defproc[(make-threshold-LRU-manager
[instance-expiration-handler
(or/c false/c
(request? . -> . response/c))]
(request? . -> . can-be-response?))]
[memory-threshold number?])
manager?]{
This creates an LRU manager with the following behavior:

4
collects/web-server/scribblings/servlet-env.scrbl
View File

@ -128,7 +128,7 @@ Like always, you don't even need to save the file.
@section{Full API}
@defproc[(serve/servlet [start (request? . -> . response/c)]
@defproc[(serve/servlet [start (request? . -> . can-be-response?)]
[#:command-line? command-line? boolean? #f]
[#:connection-close? connection-close? boolean? #f]
[#:launch-browser? launch-browser? boolean? (not command-line?)]
@ -152,7 +152,7 @@ Like always, you don't even need to save the file.
[#:servlets-root servlets-root path-string? (build-path server-root-path "htdocs")]
[#:servlet-current-directory servlet-current-directory path-string? servlets-root]
[#:file-not-found-responder file-not-found-responder
(request? . -> . response/c)
(request? . -> . can-be-response?)
(gen-file-not-found-responder
(build-path
server-root-path

6
collects/web-server/scribblings/servlet-setup.scrbl
View File

@ -16,14 +16,14 @@ This module is used internally to build and load servlets. It may be useful to t
@defproc[(make-v1.servlet [directory path-string?]
[timeout integer?]
[start (request? . -> . response/c)])
[start (request? . -> . can-be-response?)])
servlet?]{
Creates a version 1 servlet that uses @racket[directory] as its current directory, a timeout manager with a @racket[timeout] timeout, and @racket[start] as the request handler.
}
@defproc[(make-v2.servlet [directory path-string?]
[manager manager?]
[start (request? . -> . response/c)])
[start (request? . -> . can-be-response?)])
servlet?]{
Creates a version 2 servlet that uses @racket[directory] as its current directory, a @racket[manager] as the continuation manager, and @racket[start] as the request handler.
}
@ -31,7 +31,7 @@ This module is used internally to build and load servlets. It may be useful to t
@defproc[(make-stateless.servlet [directory path-string?]
[stuffer (stuffer/c serializable? bytes?)]
[manager manager?]
[start (request? . -> . response/c)])
[start (request? . -> . can-be-response?)])
servlet?]{
Creates a stateless @racketmodname[web-server] servlet that uses @racket[directory] as its current directory, @racket[stuffer] as its stuffer, and @racket[manager] as the continuation manager, and @racket[start] as the request handler.
}

2
collects/web-server/scribblings/servlet.scrbl
View File

@ -23,7 +23,7 @@ A stateful servlet should @racket[provide] the following exports:
}
@defproc[(start [initial-request request?])
response/c]{
can-be-response?]{
This function is called when an instance of this servlet is started.
The argument is the HTTP request that initiated the instance.
}

20
collects/web-server/scribblings/web.scrbl
View File

@ -12,7 +12,7 @@
@racketmodname[web-server/servlet/web] library provides the primary
functions of interest for the servlet developer.
@defproc[(send/back [response response/c])
@defproc[(send/back [response can-be-response?])
void?]{
Sends @racket[response] to the client. No continuation is captured, so the servlet is done.
@ -28,11 +28,11 @@ functions of interest for the servlet developer.
]
}
@defproc[(send/suspend [make-response (string? . -> . response/c)])
@defproc[(send/suspend [make-response (string? . -> . can-be-response?)])
request?]{
Captures the current continuation, stores it with @racket[exp] as the expiration
handler, and binds it to a URL. @racket[make-response] is called with this URL and
is expected to generate a @racket[response/c], which is sent to the client. If the
is expected to generate a @racket[can-be-response?], which is sent to the client. If the
continuation URL is invoked, the captured continuation is invoked and the request is
returned from this call to @racket[send/suspend].
@ -53,12 +53,12 @@ functions of interest for the servlet developer.
Thus, the request will be ``returned'' from @racket[send/suspend] to the continuation of this call.
}
@defproc[(send/suspend/url [make-response (url? . -> . response/c)])
@defproc[(send/suspend/url [make-response (url? . -> . can-be-response?)])
request?]{
Like @racket[send/suspend] but with a URL struct.
}
@defproc[(send/suspend/dispatch [make-response (((request? . -> . any) . -> . string?) . -> . response/c)])
@defproc[(send/suspend/dispatch [make-response (((request? . -> . any) . -> . string?) . -> . can-be-response?)])
any]{
Calls @racket[make-response] with a function (@racket[embed/url]) that, when called with a procedure from
@racket[request?] to @racket[any/c] will generate a URL, that when invoked will call
@ -121,19 +121,19 @@ functions of interest for the servlet developer.
]
}
@defproc[(send/suspend/url/dispatch [make-response (((request? . -> . any) . -> . url?) . -> . response/c)])
@defproc[(send/suspend/url/dispatch [make-response (((request? . -> . any) . -> . url?) . -> . can-be-response?)])
any]{
Like @racket[send/suspend/dispatch], but with a URL struct.
}
@defproc[(send/forward [make-response (string? . -> . response/c)])
@defproc[(send/forward [make-response (string? . -> . can-be-response?)])
request?]{
Calls @racket[clear-continuation-table!], then @racket[send/suspend].
Use this if the user can logically go `forward' in your application, but cannot go backward.
}
@defproc[(send/finish [response response/c])
@defproc[(send/finish [response can-be-response?])
void?]{
Calls @racket[clear-continuation-table!], then @racket[send/back].
@ -162,7 +162,7 @@ functions of interest for the servlet developer.
@defthing[current-servlet-continuation-expiration-handler
(parameter/c (or/c false/c
(request? . -> . response/c)))]{
(request? . -> . can-be-response?)))]{
Holds the expiration handler to be used when a continuation
captured in this context is expired, then looked up.
@ -184,7 +184,7 @@ functions of interest for the servlet developer.
captured continuations.
}
@defproc[(with-errors-to-browser [send/finish-or-back (response/c . -> . request?)]
@defproc[(with-errors-to-browser [send/finish-or-back (can-be-response? . -> . request?)]
[thunk (-> any)])
any]{
Calls @racket[thunk] with an exception handler that generates an HTML error page

2
collects/web-server/servlet-dispatch.rkt
View File

@ -26,7 +26,7 @@
(define send-url (make-parameter net:send-url))
(provide/contract
[dispatch/servlet (((request? . -> . response/c))
[dispatch/servlet (((request? . -> . can-be-response?))
(#:regexp regexp?
#:current-directory path-string?
#:stateless? boolean?

6
collects/web-server/servlet-env.rkt
View File

@ -39,7 +39,7 @@
"web-server/default-web-root"))
(provide/contract
[serve/servlet (((request? . -> . response/c))
[serve/servlet (((request? . -> . can-be-response?))
(#:connection-close? boolean?
#:command-line? boolean?
#:launch-browser? boolean?
@ -58,7 +58,7 @@
#:extra-files-paths (listof path-string?)
#:servlets-root path-string?
#:servlet-current-directory path-string?
#:file-not-found-responder (request? . -> . response/c)
#:file-not-found-responder (request? . -> . can-be-response?)
#:mime-types-path path-string?
#:servlet-path string?
#:servlet-regexp regexp?
@ -173,7 +173,7 @@
#:url->path (fsmap:make-url->path (build-path server-root-path "htdocs"))
#:path->mime-type (make-path->mime-type mime-types-path)
#:indices (list "index.html" "index.htm"))
(lift:make file-not-found-responder)))
(lift:make (compose any->response file-not-found-responder))))
(serve/launch/wait
dispatcher
#:connection-close? connection-close?

25
collects/web-server/servlet/servlet-structs.rkt
View File

@ -1,13 +1,24 @@
#lang racket/base
(require racket/contract
unstable/contract
web-server/http)
(define current-response/c
(make-parameter any/c))
(define response/c
(dynamic/c any/c current-response/c response?))
(define (real-any->response x)
#f)
(define (any->response x)
(if (response? x)
x
(real-any->response x)))
(define (set-any->response! f)
(set! real-any->response f))
(define (can-be-response? x)
(or (response? x)
(and (any->response x)
#t)))
(provide/contract
[current-response/c (parameter/c contract?)]
[response/c contract?])
[any->response (-> any/c (or/c false/c response?))]
[set-any->response! (-> (-> any/c (or/c false/c response?)) void)]
[can-be-response? (-> any/c boolean?)])

14
collects/web-server/servlet/setup.rkt
View File

@ -112,9 +112,9 @@
servlet-module-specs
lang-module-specs))
(provide/contract
[make-v1.servlet (path-string? integer? (request? . -> . response/c) . -> . servlet?)]
[make-v2.servlet (path-string? manager? (request? . -> . response/c) . -> . servlet?)]
[make-stateless.servlet (path-string? (stuffer/c serializable? bytes?) manager? (request? . -> . response/c) . -> . servlet?)]
[make-v1.servlet (path-string? integer? (request? . -> . can-be-response?) . -> . servlet?)]
[make-v2.servlet (path-string? manager? (request? . -> . can-be-response?) . -> . servlet?)]
[make-stateless.servlet (path-string? (stuffer/c serializable? bytes?) manager? (request? . -> . can-be-response?) . -> . servlet?)]
[default-module-specs (listof (or/c resolved-module-path? module-path?))])
(define (make-default-path->servlet #:make-servlet-namespace [make-servlet-namespace (make-make-servlet-namespace)]
@ -144,13 +144,13 @@
(dynamic-require module-name 'timeout)
pos-blame neg-blame
"timeout" loc)]
[start (contract (request? . -> . response/c)
[start (contract (request? . -> . can-be-response?)
(dynamic-require module-name 'start)
pos-blame neg-blame
"start" loc)])
(make-v1.servlet (directory-part a-path) timeout start))]
[(v2)
(let ([start (contract (request? . -> . response/c)
(let ([start (contract (request? . -> . can-be-response?)
(dynamic-require module-name 'start)
pos-blame neg-blame
"start" loc)]
@ -160,7 +160,7 @@
"manager" loc)])
(make-v2.servlet (directory-part a-path) manager start))]
[(stateless)
(let ([start (contract (request? . -> . response/c)
(let ([start (contract (request? . -> . can-be-response?)
(dynamic-require module-name 'start)
pos-blame neg-blame
"start" loc)]
@ -177,7 +177,7 @@
[else
(make-v1.servlet (directory-part a-path) timeouts-default-servlet
(v0.response->v1.lambda
(contract response/c (response/xexpr s)
(contract response? (response/xexpr s)
pos-blame neg-blame
path-string loc)
a-path))])))))

33
collects/web-server/servlet/web.rkt
View File

@ -39,18 +39,18 @@
[current-servlet-continuation-expiration-handler
(parameter/c
(or/c false/c
(request? . -> . response/c)))]
(request? . -> . can-be-response?)))]
[redirect/get (() (#:headers (listof header?)) . ->* . request?)]
[redirect/get/forget (() (#:headers (listof header?)) . ->* . request?)]
[adjust-timeout! (number? . -> . void?)]
[clear-continuation-table! (-> void?)]
[send/back (response/c . -> . void?)]
[send/finish (response/c . -> . void?)]
[send/forward ((string? . -> . response/c) . -> . request?)]
[send/suspend ((string? . -> . response/c) . -> . request?)]
[send/suspend/dispatch ((((request? . -> . any) . -> . string?) . -> . response/c) . -> . any/c)]
[send/suspend/url ((url? . -> . response/c) . -> . request?)]
[send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response/c) . -> . any/c)])
[send/back (can-be-response? . -> . void?)]
[send/finish (can-be-response? . -> . void?)]
[send/forward ((string? . -> . can-be-response?) . -> . request?)]
[send/suspend ((string? . -> . can-be-response?) . -> . request?)]
[send/suspend/dispatch ((((request? . -> . any) . -> . string?) . -> . can-be-response?) . -> . any/c)]
[send/suspend/url ((url? . -> . can-be-response?) . -> . request?)]
[send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . can-be-response?) . -> . any/c)])
;; ************************************************************
;; EXPORTS
@ -151,17 +151,20 @@
(define redirect/get/forget (make-redirect/get send/forward))
(define (with-errors-to-browser send/finish-or-back thunk)
(with-handlers ([exn:fail? (lambda (exn)
(send/finish-or-back
`(html (head (title "Servlet Error"))
(body ([bgcolor "white"])
(p "The following error occured: "
(pre ,(exn->string exn)))))))])
(with-handlers
([exn:fail?
(lambda (exn)
(send/finish-or-back
(response/xexpr
`(html (head (title "Servlet Error"))
(body ([bgcolor "white"])
(p "The following error occured: "
(pre ,(exn->string exn))))))))])
(thunk)))
(provide/contract
[with-errors-to-browser
((response/c . -> . request?)
((can-be-response? . -> . request?)
(-> any)
. -> .
any)])