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

response/c

Browse Source 
svn: r13317
This commit is contained in:
Jay McCarthy 2009-01-29 16:34:57 +00:00
parent 9f48c1a4d2
commit 56c111ecce
31 changed files with 152 additions and 157 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/web-server/configuration/configuration-table-structs.ss
View File

@ -49,14 +49,14 @@
[timeouts timeouts?]
[paths paths?])]
[struct responders
([servlet (url? any/c . -> . response?)]
[servlet-loading (url? any/c . -> . response?)]
[authentication (url? header? . -> . response?)]
[servlets-refreshed (-> response?)]
[passwords-refreshed (-> response?)]
[file-not-found (request? . -> . response?)]
[protocol (url? . -> . response?)]
[collect-garbage (-> response?)])]
([servlet (url? any/c . -> . response/c)]
[servlet-loading (url? any/c . -> . response/c)]
[authentication (url? header? . -> . response/c)]
[servlets-refreshed (-> response/c)]
[passwords-refreshed (-> response/c)]
[file-not-found (request? . -> . response/c)]
[protocol (url? . -> . response/c)]
[collect-garbage (-> response/c)])]
[struct messages
([servlet string?]
[authentication string?]

22
collects/web-server/configuration/responders.ss
View File

@ -110,14 +110,14 @@
(lambda (in) (read-string (file-size path) in))))
(provide/contract
[file-response ((natural-number/c string? path-string?) (listof header?) . ->* . (response?))]
[servlet-loading-responder (url? exn? . -> . response?)]
[gen-servlet-not-found (path-string? . -> . (url? . -> . response?))]
[servlet-error-responder (url? exn? . -> . response?)]
[gen-servlet-responder (path-string? . -> . (url? exn? . -> . response?))]
[gen-servlets-refreshed (path-string? . -> . (-> response?))]
[gen-passwords-refreshed (path-string? . -> . (-> response?))]
[gen-authentication-responder (path-string? . -> . (url? header? . -> . response?))]
[gen-protocol-responder (path-string? . -> . (url? . -> . response?))]
[gen-file-not-found-responder (path-string? . -> . (request? . -> . response?))]
[gen-collect-garbage-responder (path-string? . -> . (-> response?))])
[file-response ((natural-number/c string? path-string?) (listof header?) . ->* . (response/c))]
[servlet-loading-responder (url? exn? . -> . response/c)]
[gen-servlet-not-found (path-string? . -> . (url? . -> . response/c))]
[servlet-error-responder (url? exn? . -> . response/c)]
[gen-servlet-responder (path-string? . -> . (url? exn? . -> . response/c))]
[gen-servlets-refreshed (path-string? . -> . (-> response/c))]
[gen-passwords-refreshed (path-string? . -> . (-> response/c))]
[gen-authentication-responder (path-string? . -> . (url? header? . -> . response/c))]
[gen-protocol-responder (path-string? . -> . (url? . -> . response/c))]
[gen-file-not-found-responder (path-string? . -> . (request? . -> . response/c))]
[gen-collect-garbage-responder (path-string? . -> . (-> response/c))])

3
collects/web-server/default-web-root/htdocs/servlets/examples/response.ss Normal file
View File

@ -0,0 +1,3 @@
`(html (head (title "Hello"))
(body ([bgcolor "white"])
(p #f "Hello")))

2
collects/web-server/dispatchers/dispatch-lift.ss
View File

@ -5,7 +5,7 @@
web-server/http/response)
(provide/contract
[interface-version dispatcher-interface-version/c]
[make ((request? . -> . response?) . -> . dispatcher/c)])
[make ((request? . -> . response/c) . -> . dispatcher/c)])
(define interface-version 'v1)
(define ((make procedure) conn req)

2
collects/web-server/dispatchers/dispatch-passwords.ss
View File

@ -16,7 +16,7 @@
[denied?/c contract?]
[make (->* (denied?/c)
(#:authentication-responder
(url? header? . -> . response?))
(url? header? . -> . response/c))
dispatcher/c)]
[authorized?/c contract?]
[make-basic-denied?/path

2
collects/web-server/dispatchers/dispatch-pathprocedure.ss
View File

@ -7,7 +7,7 @@
web-server/http/response)
(provide/contract
[interface-version dispatcher-interface-version/c]
[make (string? (request? . -> . response?) . -> . dispatcher/c)])
[make (string? (request? . -> . response/c) . -> . dispatcher/c)])
(define interface-version 'v1)
(define ((make the-path procedure) conn req)

4
collects/web-server/dispatchers/dispatch-servlets.ss
View File

@ -47,8 +47,8 @@
; -----
(provide/contract
[make (->* (url->servlet/c)
(#:responders-servlet-loading (url? any/c . -> . response?)
#:responders-servlet (url? any/c . -> . response?))
(#:responders-servlet-loading (url? any/c . -> . response/c)
#:responders-servlet (url? any/c . -> . response/c))
dispatcher/c)])
(define (make url->servlet

2
collects/web-server/formlets/servlet.ss
View File

@ -5,7 +5,7 @@
(provide/contract
[send/formlet (((formlet/c any/c))
(#:wrap (xexpr/c . -> . response?))
(#:wrap (xexpr/c . -> . response/c))
. ->* . any/c)])
(define (send/formlet f

4
collects/web-server/http/response-structs.ss
View File

@ -12,7 +12,7 @@
; response = (cons string (listof string)), where the first string is a mime-type
; | x-expression
; | response/basic
(define response?
(define response/c
(or/c response/basic?
(listof (or/c string? bytes?))
xexpr/c))
@ -39,5 +39,5 @@
[mime bytes?]
[headers (listof header?)]
[generator ((() (listof (or/c bytes? string?)) . ->* . any) . -> . any)])]
[response? contract?]
[response/c contract?]
[TEXT/HTML-MIME-TYPE bytes?])

4
collects/web-server/http/response.ss
View File

@ -13,8 +13,8 @@
web-server/private/util)
(provide/contract
[rename ext:output-response output-response (connection? response? . -> . void)]
[rename ext:output-response/method output-response/method (connection? response? symbol? . -> . void)]
[rename ext:output-response output-response (connection? response/c . -> . void)]
[rename ext:output-response/method output-response/method (connection? response/c symbol? . -> . void)]
[rename ext:output-file output-file (connection? path-string? symbol? bytes? (or/c pair? false/c) . -> . void)])
;; Table 1. head responses:

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

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

2
collects/web-server/lang/abort-resume.ss
View File

@ -154,7 +154,7 @@
;; **********************************************************************
;; **********************************************************************
; These should really be from web-server/private, but it interferes with testing
; XXX These should really be from web-server/private, but it interferes with testing
(define request? any/c)
(define response? any/c)

10
collects/web-server/lang/web.ss
View File

@ -21,15 +21,15 @@
; These contracts interfere with the continuation safety marks
#;(provide/contract
;; Server Interface
[initialize-servlet ((request? . -> . response?) . -> . (request? . -> . response?))]
[initialize-servlet ((request? . -> . response/c) . -> . (request? . -> . response/c))]
;; Servlet Interface
[send/suspend/hidden ((url? list? . -> . response?) . -> . request?)]
[send/suspend/url ((url? . -> . response?) . -> . request?)]
[send/suspend/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response?)
[send/suspend/hidden ((url? list? . -> . response/c) . -> . request?)]
[send/suspend/url ((url? . -> . response/c) . -> . request?)]
[send/suspend/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response/c)
. -> . any/c)])
;; initial-servlet : (request -> response) -> (request -> response?)
;; initial-servlet : (request -> response) -> (request -> response/c)
(define (initialize-servlet start)
(let ([params (current-parameterization)])
(lambda (req0)

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

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

38
collects/web-server/scribblings/configuration.scrbl
View File

@ -48,14 +48,14 @@ the configuration table S-expression file format described in
[paths paths?])]
@defstruct[responders
([servlet (url? any/c . -> . response?)]
[servlet-loading (url? any/c . -> . response?)]
[authentication (url? (cons/c symbol? string?) . -> . response?)]
[servlets-refreshed (-> response?)]
[passwords-refreshed (-> response?)]
[file-not-found (request? . -> . response?)]
[protocol (url? . -> . response?)]
[collect-garbage (-> response?)])]
([servlet (url? any/c . -> . response/c)]
[servlet-loading (url? any/c . -> . response/c)]
[authentication (url? (cons/c symbol? string?) . -> . response/c)]
[servlets-refreshed (-> response/c)]
[passwords-refreshed (-> response/c)]
[file-not-found (request? . -> . response/c)]
[protocol (url? . -> . response/c)]
[collect-garbage (-> response/c)])]
@defstruct[messages
([servlet string?]
@ -230,60 +230,60 @@ These functions are used by the default dispatcher constructor (see @secref["web
turn the paths given in the @scheme[configuration-table] into responders for the associated circumstance.
@defproc[(file-response (http-code natural-number/c) (short-version string?) (text-file string?) (header header?) ...)
response?]{
response/c]{
Generates a @scheme[response/full] with the given @scheme[http-code] and @scheme[short-version]
as the corresponding fields; with the content of the @scheme[text-file] as the body; and, with
the @scheme[header]s as, you guessed it, headers.
}
@defproc[(servlet-loading-responder (url url?) (exn exn?))
response?]{
response/c]{
Gives @scheme[exn] to the @scheme[current-error-handler] and response with a stack trace and a "Servlet didn't load" message.
}
@defproc[(gen-servlet-not-found (file path-string?))
((url url?) . -> . response?)]{
((url url?) . -> . response/c)]{
Returns a function that generates a standard "Servlet not found." error with content from @scheme[file].
}
@defproc[(servlet-error-responder (url url?) (exn exn?))
response?]{
response/c]{
Gives @scheme[exn] to the @scheme[current-error-handler] and response with a stack trace and a "Servlet error" message.
}
@defproc[(gen-servlet-responder (file path-string?))
((url url?) (exn any/c) . -> . response?)]{
((url url?) (exn any/c) . -> . response/c)]{
Prints the @scheme[exn] to standard output and responds with a "Servlet error." message with content from @scheme[file].
}
@defproc[(gen-servlets-refreshed (file path-string?))
(-> response?)]{
(-> response/c)]{
Returns a function that generates a standard "Servlet cache refreshed." message with content from @scheme[file].
}
@defproc[(gen-passwords-refreshed (file path-string?))
(-> response?)]{
(-> response/c)]{
Returns a function that generates a standard "Passwords refreshed." message with content from @scheme[file].
}
@defproc[(gen-authentication-responder (file path-string?))
((url url?) (header header?) . -> . response?)]{
((url url?) (header header?) . -> . response/c)]{
Returns a function that generates an authentication failure error with content from @scheme[file] and
@scheme[header] as the HTTP header.
}
@defproc[(gen-protocol-responder (file path-string?))
((url url?) . -> . response?)]{
((url url?) . -> . response/c)]{
Returns a function that generates a "Malformed request" error with content from @scheme[file].
}
@defproc[(gen-file-not-found-responder (file path-string?))
((req request?) . -> . response?)]{
((req request?) . -> . response/c)]{
Returns a function that generates a standard "File not found" error with content from @scheme[file].
}
@defproc[(gen-collect-garbage-responder (file path-string?))
(-> response?)]{
(-> response/c)]{
Returns a function that generates a standard "Garbage collection run" message with content from @scheme[file].
}

10
collects/web-server/scribblings/dispatchers.scrbl
View File

@ -158,7 +158,7 @@ URLs to paths on the filesystem.
@a-dispatcher[web-server/dispatchers/dispatch-lift
@elem{defines a dispatcher constructor.}]{
@defproc[(make (proc (request? . -> . response?)))
@defproc[(make (proc (request? . -> . response/c)))
dispatcher/c]{
Constructs a dispatcher that calls @scheme[proc] on the request
object, and outputs the response to the connection.
@ -184,7 +184,7 @@ URLs to paths on the filesystem.
for invoking a particular procedure when a request is given to a particular
URL path.}]{
@defproc[(make (path string?) (proc (request? . -> . response?)))
@defproc[(make (path string?) (proc (request? . -> . response/c)))
dispatcher/c]{
Checks if the request URL path as a string is equal to @scheme[path]
and if so, calls @scheme[proc] for a response.
@ -274,7 +274,7 @@ a URL that refreshes the password file, servlet cache, etc.}
@defproc[(make [denied? denied?/c]
[#:authentication-responder
authentication-responder
(url? header? . -> . response?)
(url? header? . -> . response/c)
(gen-authentication-responder "forbidden.html")])
dispatcher/c]{
A dispatcher that checks if the request is denied based on @scheme[denied?]. If so, then
@ -363,11 +363,11 @@ a URL that refreshes the password file, servlet cache, etc.}
@defproc[(make [url->servlet url->servlet/c]
[#:responders-servlet-loading
responders-servlet-loading
(url? exn? . -> . response?)
(url? exn? . -> . response/c)
servlet-loading-responder]
[#:responders-servlet
responders-servlet
(url? exn? . -> . response?)
(url? exn? . -> . response/c)
servlet-error-responder])
dispatcher/c]{
This dispatcher runs Scheme servlets, using @scheme[url->servlet] to resolve URLs to the underlying servlets.

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

@ -228,7 +228,7 @@ A few utilities are provided for using @tech{formlet}s in Web applications.
@defproc[(send/formlet [f (formlet/c any/c)]
[#:wrap wrapper
(xexpr/c . -> . response?)
(xexpr/c . -> . response/c)
(lambda (form-xexpr)
`(html (head (title "Form Entry"))
(body ,form-xexpr)))])

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

@ -218,14 +218,10 @@ Here is an example typical of what you will find in many applications:
]
}
@defproc[(response? [v any/c])
boolean?]{
Checks if @scheme[v] is a valid response. A response is either:
@itemize[
@item{A @scheme[response/basic] structure.}
@item{A value matching the contract @scheme[(cons/c (or/c bytes? string?) (listof (or/c bytes? string?)))].}
@item{A value matching @scheme[xexpr?].}
]
@defthing[response/c contract?]{
Equivalent to @scheme[(or/c response/basic?
(listof (or/c string? bytes?))
xexpr/c)].
}
@defthing[TEXT/HTML-MIME-TYPE bytes?]{Equivalent to @scheme[#"text/html; charset=utf-8"].}
@ -244,7 +240,7 @@ transmission that the server @bold{will not catch}.}
@defproc[(redirect-to [uri string?]
[perm/temp redirection-status? temporarily]
[#:headers headers (listof header?) (list)])
response?]{
response/c]{
Generates an HTTP response that redirects the browser to @scheme[uri],
while including the @scheme[headers] in the response.

6
collects/web-server/scribblings/lang.scrbl
View File

@ -26,7 +26,7 @@
@(require (for-label web-server/lang/web))
@defmodule[web-server/lang/web]{
@defproc[(send/suspend/url [response-generator (url? . -> . response?)])
@defproc[(send/suspend/url [response-generator (url? . -> . response/c)])
request?]{
Captures the current continuation. Serializes it and stuffs it into
a URL. Calls @scheme[response-generator] with this URL and delivers
@ -34,7 +34,7 @@
the request is returned to this continuation.
}
@defproc[(send/suspend/hidden [response-generator (url? xexpr/c . -> . response?)])
@defproc[(send/suspend/hidden [response-generator (url? xexpr/c . -> . response/c)])
request?]{
Captures the current continuation. Serializes it and generates an INPUT
form that includes the serialization as a hidden form.
@ -46,7 +46,7 @@
Note: The continuation is NOT stuffed.
}
@defproc[(send/suspend/dispatch [make-response (embed/url/c . -> . response?)])
@defproc[(send/suspend/dispatch [make-response (embed/url/c . -> . response/c)])
any/c]{
Calls @scheme[make-response] with a function that, when called with a procedure from
@scheme[request?] to @scheme[any/c] will generate a URL, that when invoked will call

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

@ -80,7 +80,7 @@ If you want to use @scheme[serve/servlet] in a start up script for a Web server,
#:command-line? #t)
]
@defproc[(serve/servlet [start (request? . -> . response?)]
@defproc[(serve/servlet [start (request? . -> . response/c)]
[#:command-line? command-line? boolean? #f]
[#:launch-browser? launch-browser? boolean? (not command-line?)]
[#:quit? quit? boolean? (not command-line?)]
@ -103,7 +103,7 @@ If you want to use @scheme[serve/servlet] in a start up script for a Web server,
[#: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?)
(request? . -> . response/c)
(gen-file-not-found-responder
(build-path
server-root-path

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

@ -14,20 +14,20 @@ 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?)])
[start (request? . -> . response/c)])
servlet?]{
Creates a version 1 servlet that uses @scheme[directory] as its current directory, a timeout manager with a @scheme[timeout] timeout, and @scheme[start] as the request handler.
}
@defproc[(make-v2.servlet [directory path-string?]
[manager manager?]
[start (request? . -> . response?)])
[start (request? . -> . response/c)])
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-string?]
[start (request? . -> . response?)])
[start (request? . -> . response/c)])
servlet?]{
Creates a stateless @schememodname[web-server] servlet that uses @scheme[directory] as its current directory and @scheme[start] as the request handler.
}
@ -63,7 +63,7 @@ Equivalent to @scheme[(path? . -> . servlet?)].
[namespace namespace?]
[manager manager?]
[directory path-string?]
[handler (request? . -> . response?)])
[handler (request? . -> . response/c)])
#:mutable]{
Instances of this structure hold the necessary parts of a servlet:
the @scheme[custodian] responsible for the servlet's resources,

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

@ -12,7 +12,7 @@
}
@defproc[(start [initial-request request?])
response?]{
response/c]{
This function is called when an instance of this servlet is started.
The argument is the HTTP request that initiated the instance.
}

2
collects/web-server/scribblings/tutorial/continue.scrbl
View File

@ -1140,7 +1140,7 @@ to
scheme
(require web-server/servlet)
(provide/contract (start (request? . -> . response?)))
(provide/contract (start (request? . -> . response/c)))
]
Second, add the following at the bottom of your application:

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

@ -18,7 +18,7 @@
}
@defproc[(start [initial-request request?])
response?]{
response/c]{
This function is called when an instance of this servlet is started.
The argument is the HTTP request that initiated the instance.
}

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

@ -16,7 +16,7 @@
}
@defproc[(start [initial-request request?])
response?]{
response/c]{
This function is called when an instance of this servlet is started.
The argument is the HTTP request that initiated the instance.
}

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

@ -10,7 +10,7 @@
@schememodname[web-server/servlet/web] library provides the primary
functions of interest for the servlet developer.
@defproc[(send/back [response response?])
@defproc[(send/back [response response/c])
void?]{
Sends @scheme[response] to the client. No continuation is captured, so the servlet is done.
@ -30,7 +30,7 @@ functions of interest for the servlet developer.
request?]{
Captures the current continuation, stores it with @scheme[exp] as the expiration
handler, and binds it to a URL. @scheme[make-response] is called with this URL and
is expected to generate a @scheme[response?], which is sent to the client. If the
is expected to generate a @scheme[response/c], 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 @scheme[send/suspend].
@ -50,7 +50,7 @@ functions of interest for the servlet developer.
Thus, the request will be ``returned'' from @scheme[send/suspend] to the continuation of this call.
}
@defproc[(send/suspend/dispatch [make-response (embed/url/c . -> . response?)])
@defproc[(send/suspend/dispatch [make-response (embed/url/c . -> . response/c)])
any/c]{
Calls @scheme[make-response] with a function (@scheme[embed/url]) that, when called with a procedure from
@scheme[request?] to @scheme[any/c] will generate a URL, that when invoked will call
@ -119,7 +119,7 @@ functions of interest for the servlet developer.
Use this if the user can logically go `forward' in your application, but cannot go backward.
}
@defproc[(send/finish [response response?])
@defproc[(send/finish [response response/c])
void?]{
Calls @scheme[clear-continuation-table!], then @scheme[send/back].
@ -166,7 +166,7 @@ functions of interest for the servlet developer.
captured continuations.
}
@defproc[(with-errors-to-browser [send/finish-or-back (response? . -> . request?)]
@defproc[(with-errors-to-browser [send/finish-or-back (response/c . -> . request?)]
[thunk (-> any)])
any]{
Calls @scheme[thunk] with an exception handler that generates an HTML error page

4
collects/web-server/scribblings/writing.scrbl
View File

@ -56,7 +56,7 @@ Equivalent to @scheme[string?].
Example: @scheme["http://localhost:8080/servlets;1*1*20131636/examples/add.ss"]}
@defthing[response-generator/c contract?]{
Equivalent to @scheme[(k-url? . -> . response?)].
Equivalent to @scheme[(k-url? . -> . response/c)].
Example: @schemeblock[(lambda (k-url)
`(html
@ -66,7 +66,7 @@ Example: @schemeblock[(lambda (k-url)
}
@defthing[expiration-handler/c contract?]{
Equivalent to @scheme[(or/c false/c (request? . -> . response?))].
Equivalent to @scheme[(or/c false/c (request? . -> . response/c))].
Example: @schemeblock[(lambda (req)
`(html (head (title "Expired"))

4
collects/web-server/servlet-env.ss
View File

@ -42,7 +42,7 @@
(p "Return to DrScheme.")))))))
(provide/contract
[serve/servlet (((request? . -> . response?))
[serve/servlet (((request? . -> . response/c))
(#:command-line? boolean?
#:launch-browser? boolean?
#:quit? boolean?
@ -57,7 +57,7 @@
#:extra-files-paths (listof path-string?)
#:servlets-root path-string?
#:servlet-current-directory path-string?
#:file-not-found-responder (request? . -> . response?)
#:file-not-found-responder (request? . -> . response/c)
#:mime-types-path path-string?
#:servlet-path string?
#:servlet-regexp regexp?

4
collects/web-server/servlet/servlet-structs.ss
View File

@ -6,11 +6,11 @@
string?)
(define response-generator/c
(k-url? . -> . response?))
(k-url? . -> . response/c))
(define expiration-handler/c
(or/c false/c
(request? . -> . response?)))
(request? . -> . response/c)))
(define embed/url/c
(((request? . -> . any/c)) (expiration-handler/c) . ->* . string?))

110
collects/web-server/servlet/setup.ss
View File

@ -23,13 +23,8 @@
path->servlet/c)])
(define (v0.response->v1.lambda response response-path)
(define go
(box
(lambda ()
(set-box! go (lambda () (load/use-compiled response-path)))
response)))
(lambda (initial-request)
((unbox go))))
response))
(define (make-v1.servlet directory timeout start)
(make-v2.servlet
@ -97,9 +92,9 @@
servlet-module-specs
lang-module-specs))
(provide/contract
[make-v1.servlet (path-string? integer? (request? . -> . response?) . -> . servlet?)]
[make-v2.servlet (path-string? manager? (request? . -> . response?) . -> . servlet?)]
[make-stateless.servlet (path-string? (request? . -> . response?) . -> . servlet?)]
[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? (request? . -> . response/c) . -> . servlet?)]
[default-module-specs (listof module-path?)])
(define (make-default-path->servlet #:make-servlet-namespace [make-servlet-namespace (make-make-servlet-namespace)]
@ -109,53 +104,54 @@
#:additional-specs
default-module-specs)]
[current-custodian (make-servlet-custodian)])
(define s (load/use-compiled a-path))
(cond
[(void? s)
(let* ([path-string (path->string a-path)]
[path-sym (string->symbol path-string)]
[neg-blame 'web-server]
[pos-blame path-sym]
[module-name `(file ,path-string)]
[mk-loc
(lambda (name)
(list (make-srcloc a-path #f #f #f #f)
name))]
[version
(contract (symbols 'v1 'v2 'stateless)
(dynamic-require module-name 'interface-version)
pos-blame neg-blame
(mk-loc "interface-version"))])
(case version
[(v1)
(let ([timeout (contract number?
(dynamic-require module-name 'timeout)
(let* ([path-string (path->string a-path)]
[path-sym (string->symbol path-string)]
[neg-blame 'web-server]
[pos-blame path-sym]
[module-name `(file ,path-string)]
[mk-loc
(lambda (name)
(list (make-srcloc a-path #f #f #f #f)
name))]
[s (load/use-compiled a-path)])
(cond
[(void? s)
(let ([version
(contract (symbols 'v1 'v2 'stateless)
(dynamic-require module-name 'interface-version)
pos-blame neg-blame
(mk-loc "interface-version"))])
(case version
[(v1)
(let ([timeout (contract number?
(dynamic-require module-name 'timeout)
pos-blame neg-blame
(mk-loc "timeout"))]
[start (contract (request? . -> . response/c)
(dynamic-require module-name 'start)
pos-blame neg-blame
(mk-loc "timeout"))]
[start (contract (request? . -> . response?)
(dynamic-require module-name 'start)
pos-blame neg-blame
(mk-loc "start"))])
(make-v1.servlet (directory-part a-path) timeout start))]
[(v2)
(let ([start (contract (request? . -> . response?)
(dynamic-require module-name 'start)
pos-blame neg-blame
(mk-loc "start"))]
[manager (contract manager?
(dynamic-require module-name 'manager)
(mk-loc "start"))])
(make-v1.servlet (directory-part a-path) timeout start))]
[(v2)
(let ([start (contract (request? . -> . response/c)
(dynamic-require module-name 'start)
pos-blame neg-blame
(mk-loc "manager"))])
(make-v2.servlet (directory-part a-path) manager start))]
[(stateless)
(let ([start (contract (request? . -> . response?)
(dynamic-require module-name 'start)
pos-blame neg-blame
(mk-loc "start"))])
(make-stateless.servlet (directory-part a-path) start))]))]
[(response? s)
(make-v1.servlet (directory-part a-path) timeouts-default-servlet
(v0.response->v1.lambda s a-path))]
[else
(error 'path->servlet
"Loading ~e produced ~n~e~n instead of either (1) a response or (2) nothing and exports 'interface-version" a-path s)]))))
(mk-loc "start"))]
[manager (contract manager?
(dynamic-require module-name 'manager)
pos-blame neg-blame
(mk-loc "manager"))])
(make-v2.servlet (directory-part a-path) manager start))]
[(stateless)
(let ([start (contract (request? . -> . response/c)
(dynamic-require module-name 'start)
pos-blame neg-blame
(mk-loc "start"))])
(make-stateless.servlet (directory-part a-path) start))]))]
[else
(make-v1.servlet (directory-part a-path) timeouts-default-servlet
(v0.response->v1.lambda
(contract response/c s
pos-blame neg-blame
(mk-loc path-string))
a-path))])))))

8
collects/web-server/servlet/web.ss
View File

@ -40,11 +40,11 @@
[redirect/get/forget (-> request?)]
[adjust-timeout! (number? . -> . void?)]
[clear-continuation-table! (-> void?)]
[send/back (response? . -> . void?)]
[send/finish (response? . -> . void?)]
[send/back (response/c . -> . void?)]
[send/finish (response/c . -> . void?)]
[send/suspend ((response-generator/c) (expiration-handler/c) . ->* . request?)]
[send/forward ((response-generator/c) (expiration-handler/c) . ->* . request?)]
[send/suspend/dispatch ((embed/url/c . -> . response?) . -> . any/c)])
[send/suspend/dispatch ((embed/url/c . -> . response/c) . -> . any/c)])
;; ************************************************************
;; EXPORTS
@ -146,7 +146,7 @@
(provide/contract
[with-errors-to-browser
((response? . -> . request?)
((response/c . -> . request?)
(-> any)
. -> .
any)])