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

Adding new options re Galler

Browse Source
This commit is contained in:
Jay McCarthy 2012-04-24 14:49:12 -06:00
parent 555f85ac3a
commit ae38ecc564
6 changed files with 88 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/tests/web-server/pr/galler2.rkt Normal file
View File

@ -0,0 +1,38 @@
#lang racket
(require net/url
web-server/http
web-server/http/request
web-server/servlet-env
rackunit)
(define (start req)
(error "Bad"))
(define-values (pipe-read-p pipe-write-p)
(make-pipe))
(define server-t
(thread
(λ ()
(parameterize ([current-output-port pipe-write-p])
(serve/servlet start
#:launch-browser? #f
#:quit? #f
#:listen-ip #f
#:port 0
#:servlet-responder
(λ (url exn)
(response/xexpr
"Good!"))
#:servlet-path "/")))))
;; Wait for server to start
(define port-embedded-line (read-line pipe-read-p))
(match-define (regexp #rx"Your Web application is running at http://localhost:([0-9]+)\\."
(list _ port-string))
port-embedded-line)
(define port (string->number port-string))
(void (read-line pipe-read-p))
(check-equal? "Good!"
(port->string (get-pure-port (string->url (format "http://localhost:~a/" port)))))

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

@ -53,8 +53,8 @@
dispatcher/c)])
(define (make url->servlet
#:responders-servlet-loading [responders-servlet-loading servlet-loading-responder]
#:responders-servlet [responders-servlet servlet-error-responder])
#:responders-servlet-loading [responders-servlet-loading servlet-loading-responder]
#:responders-servlet [responders-servlet servlet-error-responder])
(lambda (conn req)
(define uri (request-uri req))
(define instance-custodian (make-servlet-custodian))

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

@ -12,6 +12,7 @@
web-server/configuration/configuration-table
web-server/configuration/responders
web-server/dispatchers/dispatch-log
net/url
racket/serialize
web-server/stuffers
racket/list))
@ -26,7 +27,15 @@ These functions optimize the construction of dispatchers and launching of server
[#:stateless? stateless? boolean? #f]
[#:stuffer stuffer (stuffer/c serializable? bytes?) default-stuffer]
[#:manager manager manager? (make-threshold-LRU-manager #f (* 1024 1024 64))]
[#:current-directory servlet-current-directory path-string? (current-directory)])
[#:current-directory servlet-current-directory path-string? (current-directory)]
[#:responders-servlet-loading
responders-servlet-loading
(url? any/c . -> . can-be-response?)
servlet-loading-responder]
[#:responders-servlet
responders-servlet
(url? any/c . -> . can-be-response?)
servlet-error-responder])
dispatcher/c]{
@racket[serve/servlet] starts a server and uses a particular dispatching sequence. For some applications, this
nails down too much, but users are conflicted, because the interface is so convenient. For those users, @racket[dispatch/servlet]
@ -42,6 +51,8 @@ These functions optimize the construction of dispatchers and launching of server
deals with memory pressure as discussed in the @racket[make-threshold-LRU-manager] documentation.)
The servlet is run in the @racket[(current-namespace)].
If a servlet fails to load, @racket[responders-servlet-loading] is used. If a servlet errors during its operation, @racket[responders-servlet] is used.
}
@defproc[(serve/launch/wait

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

@ -12,6 +12,7 @@
web-server/configuration/configuration-table
web-server/configuration/responders
web-server/dispatchers/dispatch-log
net/url
racket/serialize
web-server/stuffers
web-server/servlet/servlet-structs
@ -159,6 +160,14 @@ Like always, you don't even need to save the file.
server-root-path
"conf"
"not-found.html"))]
[#:servlet-loading-responder
responders-servlet-loading
(url? any/c . -> . can-be-response?)
servlet-loading-responder]
[#:servlet-responder
responders-servlet
(url? any/c . -> . can-be-response?)
servlet-error-responder]
[#:mime-types-path mime-types-path path-string?
....]
[#:ssl? ssl? boolean? #f]
@ -201,8 +210,8 @@ Like always, you don't even need to save the file.
The modules specified by @racket[servlet-namespace] are shared between servlets found in @racket[servlets-root] and the current namespace (and therefore
the @racket[start] procedure.)
If a file cannot be found, @racket[file-not-found-responder] is used to generate an error response.
If a file cannot be found, @racket[file-not-found-responder] is used to generate an error response. If a servlet fails to load, @racket[responders-servlet-loading] is used. If a servlet errors during its operation, @racket[responders-servlet] is used.
If @racket[banner?] is true, then an informative banner is printed. You may want to use this when
running from the command line, in which case the @racket[command-line?] option controls similar options.

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

@ -9,12 +9,14 @@
racket/serialize
net/tcp-unit
net/tcp-sig
net/url
unstable/contract
net/ssl-tcp-unit)
(require web-server/web-server
web-server/managers/lru
web-server/managers/manager
web-server/configuration/namespace
web-server/configuration/responders
web-server/http
web-server/stuffers
web-server/servlet/setup
@ -31,7 +33,9 @@
#:current-directory path-string?
#:stateless? boolean?
#:stuffer (stuffer/c serializable? bytes?)
#:manager manager?)
#:manager manager?
#:responders-servlet-loading (url? any/c . -> . can-be-response?)
#:responders-servlet (url? any/c . -> . can-be-response?))
. ->* .
dispatcher/c)]
[serve/launch/wait (((semaphore? . -> . dispatcher/c))
@ -55,6 +59,10 @@
[stateless? #f]
#:stuffer
[stuffer default-stuffer]
#:responders-servlet-loading
[responders-servlet-loading servlet-loading-responder]
#:responders-servlet
[responders-servlet servlet-error-responder]
#:manager
[manager
(make-threshold-LRU-manager
@ -67,6 +75,8 @@
(filter:make
servlet-regexp
(servlets:make
#:responders-servlet-loading responders-servlet-loading
#:responders-servlet responders-servlet
(lambda (url)
(or (unbox servlet-box)
(let ([servlet

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

@ -5,7 +5,8 @@
racket/list
racket/serialize
racket/runtime-path)
(require web-server/managers/lru
(require net/url
web-server/managers/lru
web-server/managers/manager
web-server/configuration/namespace
web-server/http
@ -60,6 +61,8 @@
#:servlets-root path-string?
#:servlet-current-directory path-string?
#:file-not-found-responder (request? . -> . can-be-response?)
#:servlet-loading-responder (url? any/c . -> . can-be-response?)
#:servlet-responder (url? any/c . -> . can-be-response?)
#:mime-types-path path-string?
#:servlet-path string?
#:servlet-regexp regexp?
@ -126,6 +129,11 @@
[file-not-found-responder
(gen-file-not-found-responder
(build-path server-root-path "conf" "not-found.html"))]
#:servlet-loading-responder
[responders-servlet-loading servlet-loading-responder]
#:servlet-responder
[responders-servlet servlet-error-responder]
#:mime-types-path
[mime-types-path (let ([p (build-path server-root-path "mime.types")])
(if (file-exists? p)
@ -157,7 +165,11 @@
#:stateless? stateless?
#:stuffer stuffer
#:current-directory servlet-current-directory
#:manager manager)
#:manager manager
#:responders-servlet-loading
responders-servlet-loading
#:responders-servlet
responders-servlet)
(let-values ([(clear-cache! url->servlet)
(servlets:make-cached-url->servlet
(fsmap:filter-url->path