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

Expanding functionality of serve/servlet

Browse Source 
svn: r12346
This commit is contained in:
Jay McCarthy 2008-11-07 18:54:23 +00:00
parent 3187b4849d
commit 7479f59e13
5 changed files with 123 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/tests/web-server/servlet-env/env.ss Normal file
View File

@ -0,0 +1,28 @@
#lang scheme
(require web-server/servlet
web-server/servlet-env)
; request-number : str -> num
(define (request-number which-number)
(string->number
(extract-binding/single
'number
(request-bindings (send/suspend (build-request-page which-number))))))
; build-request-page : str -> str -> response
(define (build-request-page which-number)
(lambda (k-url)
`(html (head (title "Enter a Number to Add"))
(body ([bgcolor "white"])
(form ([action ,k-url] [method "post"])
"Enter the " ,which-number " number to add: "
(input ([type "text"] [name "number"] [value ""]))
(input ([type "submit"] [name "enter"] [value "Enter"])))))))
(define (start request)
`(html (head (title "Sum"))
(body ([bgcolor "white"])
(p "The sum is "
,(number->string (+ (request-number "first") (request-number "second")))))))
(serve/servlet start
#:servlet-path "/")

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

@ -62,15 +62,22 @@
directory
start))
(define default-module-specs
'(web-server/servlet
web-server/private/servlet
web-server/servlet/web
web-server/servlet/web-cells))
(provide/contract
[make-v1.servlet (path? integer? (request? . -> . response?) . -> . servlet?)]
[make-v2.servlet (path? manager? (request? . -> . response?) . -> . servlet?)]
[default-module-specs (listof module-path?)])
(define (make-default-path->servlet #:make-servlet-namespace [make-servlet-namespace (make-make-servlet-namespace)]
#:timeouts-default-servlet [timeouts-default-servlet 30])
(lambda (a-path)
(parameterize ([current-namespace (make-servlet-namespace
#:additional-specs
'(web-server/servlet
web-server/private/servlet
web-server/servlet/web
web-server/servlet/web-cells))]
default-module-specs)]
[current-custodian (make-servlet-custodian)])
(define s (load/use-compiled a-path))
(cond

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

@ -333,6 +333,24 @@ a URL that refreshes the password file, servlet cache, etc.}
@elem{defines a dispatcher constructor
that runs servlets written in Scheme.}]{
@defproc[(make-v1.servlet [directory path?]
[timeout integer?]
[start (request? . -> . response?)])
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?]
[manager manager?]
[start (request? . -> . response?)])
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.
}
@defthing[default-module-specs (listof module-path?)]{
The modules that the Web Server needs to share with all servlets.
}
@defthing[path->servlet/c contract?]{
Equivalent to @scheme[(path? . -> . servlet?)].
}

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

@ -32,9 +32,19 @@ By default the URL for your servlet is @filepath{http://localhost:8000/servlets/
suppose you wanted it to be @filepath{http://localhost:8000/hello.ss}:
@schemeblock[
(serve/servlet my-app
#:servlet-path (build-path "hello.ss"))
#:servlet-path "/hello.ss")
]
Suppose you wanted it to capture top-level requests:
@schemeblock[
(serve/servlet my-app
#:servlet-path "/")
]
Or, perhaps just some nice top-level name:
@schemeblock[
(serve/servlet my-app
#:servlet-path "/main")
]
For the time being, this path must end in @filepath{.ss} or @filepath{.scm}.
Suppose you wanted to use a style-sheet (@filepath{style.css}) found on your Desktop (@filepath{/Users/jay/Desktop/}):
@schemeblock[
@ -46,30 +56,32 @@ Suppose you wanted to use a style-sheet (@filepath{style.css}) found on your Des
These files are served @emph{in addition} to those from the @scheme[#:server-root-path] @filepath{htdocs} directory.
Notice that you may pass any number of extra paths.
@defproc[(serve/servlet [servlet (request? . -> . response?)]
@defproc[(serve/servlet [start (request? . -> . response?)]
[#:launch-browser? launch-browser? boolean? #t]
[#:quit? quit? boolean? #t]
[#:listen-ip listen-ip string? "127.0.0.1"]
[#:port port number? 8000]
[#:servlet-path servlet-path string?
"/servlets/standalone.ss"]
[#:servlet-regexp servlet-regexp regexp?
(regexp (format "^~a$" (regexp-quote servlet-path)))]
[#:manager manager manager? default-threshold-LRU-manager]
[#:servlet-namespace servlet-namespace (listof module-path?) empty]
[#:server-root-path server-root-path path? default-server-root-path]
[#:extra-files-paths extra-files-paths (listof path?) (list (build-path server-root-path "htdocs"))]
[#:servlets-root servlets-root path? (build-path server-root-path ".")]
[#:servlets-root servlets-root path? (build-path server-root-path "htdocs")]
[#:servlet-current-directory servlet-current-directory path? servlets-root]
[#:file-not-found-path file-not-found-path path?
(build-path server-root-path "conf" "not-found.html")]
[#:mime-types-path mime-types-path path?
(build-path server-root-path "mime.types")]
[#:servlet-path servlet-path path?
"servlets/standalone.ss"])
(build-path server-root-path "mime.types")])
void]{
This sets up and starts a fairly default server instance.
@scheme[servlet] is installed as a server at @scheme[servlet-path] with @scheme[manager]
as its continuation manager. (The default manager limits the amount of memory to 64 MB and
deals with memory pressure as discussed in the @scheme[make-threshold-LRU-manager] documentation.)
@scheme[start] is loaded as a servlet and responds to requests that match @scheme[servlet-regexp]. The current directory
of servlet execution is @scheme[servlet-current-directory].
If @scheme[launch-browser?] is true, then a web browser is opened to the servlet's start page.
If @scheme[launch-browser?] is true, then a web browser is opened to @filepath{http://localhost:<port><servlet-path>}.
If @scheme[quit?] is true, then the URL @filepath["/quit"] ends the server.
@ -77,12 +89,17 @@ Notice that you may pass any number of extra paths.
The server listens on @scheme[listen-ip] and port @scheme[port].
The servlet is loaded with @scheme[manager]
as its continuation manager. (The default manager limits the amount of memory to 64 MB and
deals with memory pressure as discussed in the @scheme[make-threshold-LRU-manager] documentation.)
The modules specified by @scheme[servlet-namespace] are shared with other servlets.
The server files are rooted at @scheme[server-root-path] (which is defaultly the distribution root.)
File paths, in addition to the @filepath["htdocs"] directory under @scheme[server-root-path] may be
provided with @scheme[extra-files-paths]. These paths are checked first, in the order they appear in the list.
The @filepath["servlets"] directory is expected at @scheme[servlets-root].
Other servlets are served from @scheme[servlets-root].
If a file cannot be found, @scheme[file-not-found-path] is used as an error response.

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

@ -52,10 +52,11 @@
#:servlets-root path?
#:file-not-found-path path?
#:mime-types-path path?
#:servlet-path path?)
#:servlet-path string?
#:servlet-regexp regexp?)
. ->* .
void)])
(define (serve/servlet new-servlet
(define (serve/servlet start
#:launch-browser?
[launch-browser? #t]
#:quit?
@ -74,6 +75,11 @@
(body (p "Sorry, this page has expired. Please go back."))))
(* 64 1024 1024))]
#:servlet-path
[servlet-path "/servlets/standalone.ss"]
#:servlet-regexp
[servlet-regexp (regexp (format "^~a$" (regexp-quote servlet-path)))]
#:servlet-namespace
[servlet-namespace empty]
#:server-root-path
@ -81,20 +87,27 @@
#:extra-files-paths
[extra-files-paths (list (build-path server-root-path "htdocs"))]
#:servlets-root
[servlets-root (build-path server-root-path ".")]
[servlets-root (build-path server-root-path "htdocs")]
#:servlet-current-directory
[servlet-current-directory servlets-root]
#:file-not-found-path
[file-not-found-path (build-path server-root-path "conf" "not-found.html")]
#:mime-types-path
[mime-types-path (build-path server-root-path "mime.types")]
#:servlet-path
[servlet-path "servlets/standalone.ss"])
[mime-types-path (build-path server-root-path "mime.types")])
(let*-values
([(standalone-url)
(format "http://localhost:~a/~a" the-port servlet-path)]
(format "http://localhost:~a~a" the-port servlet-path)]
[(make-servlet-namespace) (make-make-servlet-namespace
#:to-be-copied-module-specs servlet-namespace)]
[(the-scripts) (make-cache-table)]
[(sema) (make-semaphore 0)]
[(servlet)
(parameterize ([current-custodian (make-custodian)]
[current-namespace
(make-servlet-namespace
#:additional-specs
servlets:default-module-specs)])
(servlets:make-v2.servlet servlet-current-directory manager start))]
[(dispatcher)
(sequencer:make
(if quit?
@ -103,16 +116,18 @@
(quit-server sema))
(lambda _ (next-dispatcher)))
(filter:make
#rx"\\.ss"
servlet-regexp
(servlets:make (lambda (url) servlet)))
(let-values ([(clear-cache! url->servlet)
(servlets:make-cached-url->servlet
(box the-scripts)
(lambda _
(values (build-path servlets-root servlet-path)
empty))
(fsmap:filter-url->path
#rx"\\.(ss|scm)$"
(fsmap:make-url->valid-path
(fsmap:make-url->path servlets-root)))
(servlets:make-default-path->servlet
#:make-servlet-namespace make-servlet-namespace))])
(servlets:make url->servlet)))
(servlets:make url->servlet))
(apply sequencer:make
(map (lambda (extra-files-path)
(files:make
@ -131,16 +146,6 @@
(serve #:dispatch dispatcher
#:listen-ip listen-ip
#:port the-port)])
(cache-table-lookup! the-scripts
(string->symbol
(path->string
(build-path servlets-root servlet-path)))
(lambda ()
(make-servlet (make-custodian)
(make-servlet-namespace)
manager
servlets-root
new-servlet)))
(when launch-browser?
((send-url) standalone-url #t))
(printf "Your Web application is running at ~a.~n" standalone-url)