From ae38ecc564976986cc151382f2dc6beefd1bca3d Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Tue, 24 Apr 2012 14:49:12 -0600 Subject: [PATCH] Adding new options re Galler --- collects/tests/web-server/pr/galler2.rkt | 38 +++++++++++++++++++ .../dispatchers/dispatch-servlets.rkt | 4 +- .../scribblings/servlet-env-int.scrbl | 13 ++++++- .../web-server/scribblings/servlet-env.scrbl | 13 ++++++- collects/web-server/servlet-dispatch.rkt | 12 +++++- collects/web-server/servlet-env.rkt | 16 +++++++- 6 files changed, 88 insertions(+), 8 deletions(-) create mode 100644 collects/tests/web-server/pr/galler2.rkt diff --git a/collects/tests/web-server/pr/galler2.rkt b/collects/tests/web-server/pr/galler2.rkt new file mode 100644 index 0000000000..40709cba15 --- /dev/null +++ b/collects/tests/web-server/pr/galler2.rkt @@ -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))))) diff --git a/collects/web-server/dispatchers/dispatch-servlets.rkt b/collects/web-server/dispatchers/dispatch-servlets.rkt index 8d3b02eb8d..5b370746f7 100644 --- a/collects/web-server/dispatchers/dispatch-servlets.rkt +++ b/collects/web-server/dispatchers/dispatch-servlets.rkt @@ -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)) diff --git a/collects/web-server/scribblings/servlet-env-int.scrbl b/collects/web-server/scribblings/servlet-env-int.scrbl index 352d57018f..4cdb396801 100644 --- a/collects/web-server/scribblings/servlet-env-int.scrbl +++ b/collects/web-server/scribblings/servlet-env-int.scrbl @@ -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 diff --git a/collects/web-server/scribblings/servlet-env.scrbl b/collects/web-server/scribblings/servlet-env.scrbl index 2710b99a3b..99e6223729 100644 --- a/collects/web-server/scribblings/servlet-env.scrbl +++ b/collects/web-server/scribblings/servlet-env.scrbl @@ -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. diff --git a/collects/web-server/servlet-dispatch.rkt b/collects/web-server/servlet-dispatch.rkt index ba959fc788..e138c0e500 100644 --- a/collects/web-server/servlet-dispatch.rkt +++ b/collects/web-server/servlet-dispatch.rkt @@ -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 diff --git a/collects/web-server/servlet-env.rkt b/collects/web-server/servlet-env.rkt index 4d85a894a8..120fb8b70b 100644 --- a/collects/web-server/servlet-env.rkt +++ b/collects/web-server/servlet-env.rkt @@ -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