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

In response to the tutorial thread, I've merge in plai/web and instaservlet into the main repository. web-server/servlet-env can now provide most of the instaservlet functionality. web-server/insta provides the functionality of plai/web, inconcert with web-server/servlet-env. managers/lru is more useful with a default threshold-based manager. The default error handling is that of plai/web.

Browse Source 
svn: r11246
This commit is contained in:
Jay McCarthy 2008-08-14 19:45:35 +00:00
parent 5ebff2fd07
commit 9e20ad7c46
18 changed files with 381 additions and 136 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5,6 +5,37 @@
(require "../private/response-structs.ss"
"../private/request-structs.ss")
(define (format-stack-trace trace)
`(pre
,@(for/list ([item (in-list trace)])
(format "~a at:~n ~a~n"
(if (car item)
(car item)
"<unknown procedure>")
(if (cdr item)
(format "line ~a, column ~a, in file ~a"
(srcloc-line (cdr item))
(srcloc-column (cdr item))
(srcloc-source (cdr item)))
"<unknown location>")))))
(define (pretty-exception-response url exn)
`(html
(head
(title "Servlet Error")
(link ([rel "stylesheet"] [href "/error.css"])))
(body
(div ([class "section"])
(div ([class "title"]) "Exception")
(p
"The application raised an exception with the message:"
(pre ,(exn-message exn)))
(p
"Stack trace:"
,(format-stack-trace
(continuation-mark-set->context (exn-continuation-marks exn))))))))
; file-response : nat str str [(cons sym str) ...] -> response
; The server should still start without the files there, so the
; configuration tool still runs. (Alternatively, find an work around.)
@ -18,19 +49,22 @@
; This is slightly tricky since the (interesting) content comes from the exception.
(define (servlet-loading-responder url exn)
((error-display-handler)
(format "Servlet didn't load:\n~a\n" (exn-message exn))
(format "Servlet (@ ~a) didn't load:\n~a\n" (url->string url) (exn-message exn))
exn)
(make-response/full 500 "Servlet didn't load"
(current-seconds)
TEXT/HTML-MIME-TYPE
empty
(list "Servlet didn't load.\n")))
(pretty-exception-response url exn))
; gen-servlet-not-found : str -> url -> response
(define (gen-servlet-not-found file-not-found-file)
(lambda (url)
(file-response 404 "Servlet not found" file-not-found-file)))
; servlet-error-response : url exn -> response
(define (servlet-error-responder url exn)
((error-display-handler)
(format "Servlet (@ ~a) exception:\n~a\n" (url->string url) (exn-message exn))
exn)
(pretty-exception-response url exn))
; gen-servlet-responder : str -> url tst -> response
(define (gen-servlet-responder servlet-error-file)
(lambda (url exn)
@ -77,9 +111,10 @@
(provide/contract
[file-response ((natural-number/c string? path-string?) (listof header?) . ->* . (response?))]
[servlet-loading-responder (url? any/c . -> . response?)]
[servlet-loading-responder (url? exn? . -> . response?)]
[gen-servlet-not-found (path-string? . -> . (url? . -> . response?))]
[gen-servlet-responder (path-string? . -> . (url? any/c . -> . 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?))]

25
collects/web-server/default-web-root/htdocs/error.css Normal file
View File

@ -0,0 +1,25 @@
.section {
margin: 25px;
font-family: sans-serif;
border: 1px solid black;
}
.title {
background-color: #663366;
font-size: large;
padding: 5px;
color: #FFFFFF;
}
.section > p {
margin-left: 5px;
margin-right: 5px;
}
.section > pre {
background-color: #ffccff;
margin-left: 5px;
margin-right: 5px;
padding: 5px;
border: 1px solid #ff99ff;
}

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

@ -31,7 +31,7 @@
(define (make #:url->path url->path
#:make-servlet-namespace [make-servlet-namespace (make-make-servlet-namespace)]
#:responders-servlet-loading [responders-servlet-loading servlet-loading-responder]
#:responders-servlet [responders-servlet (gen-servlet-responder "servlet-error.html")])
#:responders-servlet [responders-servlet servlet-error-responder])
;; dispatch : connection request -> void
(define (dispatch conn req)

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

@ -34,7 +34,7 @@
#:url->path url->path
#:make-servlet-namespace [make-servlet-namespace (make-make-servlet-namespace)]
#:responders-servlet-loading [responders-servlet-loading servlet-loading-responder]
#:responders-servlet [responders-servlet (gen-servlet-responder "servlet-error.html")]
#:responders-servlet [responders-servlet servlet-error-responder]
#:timeouts-default-servlet [timeouts-default-servlet 30])
;; servlet-content-producer: connection request -> void

38
collects/web-server/insta/insta.ss Normal file
View File

@ -0,0 +1,38 @@
#lang scheme
(require web-server/servlet
web-server/servlet-env)
(provide
(all-from-out web-server/servlet)
(except-out (all-from-out scheme) #%module-begin)
(rename-out [web-module-begin #%module-begin]))
(define extra-files-path #f)
(define launch-browser? #t)
(provide/contract
(static-files-path ((or/c string? path?) . -> . void?)))
(define (static-files-path path)
(set! extra-files-path
(if (path? path)
path
(string->path path))))
(provide no-web-browser)
(define (no-web-browser)
(set! launch-browser? false))
(define-syntax (web-module-begin stx)
(syntax-case stx ()
[(_ body ...)
(with-syntax ([start (datum->syntax stx 'start)])
#`(#%module-begin
body ...
(provide/contract (start (request? . -> . response?)))
(if extra-files-path
(serve/servlet start
#:extra-files-path extra-files-path
#:launch-browser? launch-browser?)
(serve/servlet start
#:launch-browser? launch-browser?))
))]))

2
collects/web-server/insta/lang/reader.ss Normal file
View File

@ -0,0 +1,2 @@
(module reader syntax/module-reader
web-server/insta/insta)

26
collects/web-server/managers/lru.ss
View File

@ -7,7 +7,8 @@
[create-LRU-manager (expiration-handler? number? number? (-> boolean?)
#:initial-count number?
#:inform-p (number? . -> . void)
. -> . manager?)])
. -> . manager?)]
[make-threshold-LRU-manager (expiration-handler? number? . -> . manager?)])
;; Utility
(define (make-counter)
@ -16,6 +17,29 @@
(set! i (add1 i))
i))
; Copied from InstaServlet, which copied from Continue (I believe?)
(define (make-threshold-LRU-manager instance-expiration-handler
memory-threshold)
(create-LRU-manager
;; Called when an instance has expired.
instance-expiration-handler
;; The condition below is checked every 5 seconds
5
;; One 'life point' is deducted every 10 minutes
(* 10 60)
;; If this condition is true a 'life point' is deducted
;; from the continuation
(lambda ()
(define memory-use (current-memory-use))
(define collect? (or (>= memory-use memory-threshold)
(< memory-use 0)))
collect?)
;; The number of 'life points' an continuation starts with
#:initial-count 24
;; Logging done whenever an continuation is collected
#:inform-p (lambda args
(void))))
(define-struct (LRU-manager manager) (instance-expiration-handler
; Private
instances

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

@ -212,10 +212,9 @@ as the corresponding fields; with the content of the @scheme[text-file] as the b
the @scheme[header]s as, you guessed it, headers.
}
@defproc[(servlet-loading-responder (url url?) (exn any/c))
@defproc[(servlet-loading-responder (url url?) (exn exn?))
response?]{
Prints the @scheme[exn] to standard output and responds with a "Servlet didn't load."
message.
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?))
@ -223,6 +222,11 @@ message.
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?]{
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?)]{
Prints the @scheme[exn] to standard output and responds with a "Servlet error." message with content from @scheme[file].

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

@ -311,12 +311,12 @@ a URL that refreshes the password file, servlet cache, etc.}
(make-make-servlet-namespace)]
[#:responders-servlet-loading
responders-servlet-loading
((url url?) (exn any/c) . -> . response?)
((url url?) (exn exn?) . -> . response?)
servlet-loading-responder]
[#:responders-servlet
responders-servlet
((url url?) (exn any/c) . -> . response?)
(gen-servlet-responder "servlet-error.html")]
((url url?) (exn exn?) . -> . response?)
servlet-error-responder]
[#:timeouts-default-servlet
timeouts-default-servlet
integer?
@ -348,8 +348,12 @@ a URL that refreshes the password file, servlet cache, etc.}
[#:make-servlet-namespace make-servlet-namespace
make-servlet-namespace?
(make-make-servlet-namespace)]
[#:responders-servlet-loading responders-servlet-loading servlet-loading-responder]
[#:responders-servlet responders-servlet (gen-servlet-responder "servlet-error.html")])
[#:responders-servlet-loading responders-servlet-loading
((url url?) (exn exn?) . -> . response?)
servlet-loading-responder]
[#:responders-servlet responders-servlet
((url url?) (exn exn?) . -> . response?)
servlet-error-responder])
dispatcher?]{
If the request URL contains a serialized continuation, then it is invoked with the
request. Otherwise, @scheme[url->path] is used to resolve the URL to a path.

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

@ -28,6 +28,10 @@ provide the following function:
The argument is the HTTP request that initiated the servlet.
}
The only way to run Web language servlets currently is to use the
functional interface to starting the server and create a dispatcher
that includes a @scheme[make-lang-dispatcher] dispatcher.
@; ------------------------------------------------------------
@section[#:tag "considerations"]{Usage Considerations}

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

@ -147,14 +147,20 @@ deployments of the @web-server .
continuations expired.
}
The recommended use of this manager is to pass, as @scheme[collect?], a
function that checks the memory usage of the system, through
@scheme[current-memory-use]. Then, @scheme[collect-interval] should be sufficiently
large compared to @scheme[check-interval]. This way, if the load on the server
spikes---as indicated by memory usage---the server will quickly expire
continuations, until the memory is back under control. If the load
stays low, it will still efficiently expire old continuations.
The recommended usage of this manager is codified as the following function:
@defproc[(create-threshold-LRU-manager
[instance-expiration-handler expiration-handler?]
[memory-threshold number?])
manager?]{
This creates an LRU manager with the following behavior:
The memory limit is set to @scheme[memory-threshold]. Continuations start with @scheme[24]
life points. Life points are deducted at the rate of one every @scheme[10] minutes, or one
every @scheme[5] seconds when the memory limit is exceeded. Hence the maximum life time for
a continuation is @scheme[4] hours, and the minimum is @scheme[2] minutes.
If the load on the server spikes---as indicated by memory usage---the server will quickly expire
continuations, until the memory is back under control. If the load
stays low, it will still efficiently expire old continuations.
}
With @href-link["http://continue.cs.brown.edu/" "Continue"], we went from needing to restart the server a few times
a week and having many complaints under load, to not having these complaints
and not needing to restart the server for performance reasons.

44
collects/web-server/scribblings/running.scrbl
View File

@ -4,11 +4,51 @@
@title[#:tag "run.ss"
#:style 'toc]{Running the Web Server}
There are a number of ways to run the Web Server. The two primary ways
are through a command-line tool or through a function call.
There are a number of ways to run the Web Server. They are given in order of simplest to most advanced.
@local-table-of-contents[]
@; ------------------------------------------------------------
@section[#:tag "insta"]{Instant Servlets}
@(require (for-label (only-in web-server/insta/insta
no-web-browser static-files-path)))
@defmodulelang[web-server/insta]
The fastest way to get a servlet running in the Web server is to use the
"Insta" language in DrScheme. Enter the following into DrScheme:
@schememod[
web-server/insta
(define (start request)
`(html (head (title "Hello world!"))
(body (p "Hey out there!"))))
]
And press @onscreen["Run"]. A Web browser will open up showing your new servlet.
Behind the scenes, DrScheme has used @scheme[serve/servlet] to start a new server
that uses your @scheme[start] function as the servlet.
You are given the entire @schememodname[web-server/servlet] API.
@subsection{Customization API}
@defmodule[web-server/insta/insta]
The following API is provided to customize the server instance:
@defproc[(no-web-browser) void]{
Calling this will instruct DrScheme to @emph{not} start a Web browser when you press
@onscreen["Run"].
}
@defproc[(static-files-path [path path?]) void]{
This instructs the Web server to serve static files, such as stylesheet and images, from @scheme[path].
}
@; ------------------------------------------------------------
@include-section["servlet-env.scrbl"]
@; ------------------------------------------------------------
@section[#:tag "command-line-tools"]{Command-line Tools}

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

@ -2,30 +2,52 @@
@(require "web-server.ss")
@title[#:tag "servlet-env.ss"
#:style 'toc]{Environment}
#:style 'toc]{Simple Single Servlet Servers}
@(require (for-label web-server/servlet-env))
@defmodule[web-server/servlet-env]
The @web-server provides a means of running Scheme servlets
from within DrScheme, or any other REPL.
The @web-server provides a way to quickly configure and start a server instance.
@filepath{servlet-env.ss} provides the servlet API from @filepath{servlet.ss}
as well as the following:
@defproc[(serve/servlet [servlet (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]
[#:manager manager manager? default-threshold-LRU-manager]
[#:servlet-namespace servlet-namespace (listof require-spec?) empty]
[#:server-root-path server-root-path path? default-server-root-path]
[#:extra-files-path extra-files-path path? (build-path server-root-path "htdocs")]
[#:servlets-root servlets-root path? (build-path server-root-path ".")]
[#: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"])
void]{
This sets up and starts a fairly default server instance.
@defthing[send-url (parameter/c ([url string?] [separate-window? boolean?] . -> . void))]{
Should open @scheme[url]. In another window if @scheme[separate-window?] is true.
By default this is from @scheme[net/sendurl].
}
@defform*[[(on-web servlet-expr)
(on-web port servlet-expr)]]{
The first form expands to @scheme[(on-web 8000 servlet-expr)].
Constructs a small servlet, where the body of the @scheme[start] procedure is
@scheme[servlet-expr], runs the @web-server on port @scheme[port], and calls
@scheme[send-url] with a URL for the constructed servlet. The call blocks until the
servlet finishes its computation, i.e. @scheme[servlet-expr] is evaluated, and
returns its result. @scheme[servlet-expr] may use the entire Scheme servlet API.
@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.)
If @scheme[launch-browser?] is true, then a web browser is opened to the servlet's start page.
If @scheme[quit?] is true, then the URL @filepath["/quit"] ends the server.
Advanced users may need the following options:
The server listens on @scheme[listen-ip] and port @scheme[port].
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.)
A file path, in addition to the @filepath["htdocs"] directory under @scheme[server-root-path] may be
provided with @scheme[extra-files-path]. These files are checked first.
The @filepath["servlets"] directory is expected at @scheme[servlets-root].
If a file cannot be found, @scheme[file-not-found-path] is used as an error response.
MIME types are looked up at @scheme[mime-types-path].
}

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

@ -4,9 +4,11 @@
@title[#:tag "servlet"
#:style 'toc]{Scheme Servlets}
@defmodule[web-server/servlet]
The @web-server allows servlets to be written in Scheme. It
provides the supporting API, described below, for the construction
of these servlets. This API is provided by @filepath{servlet.ss}.
of these servlets.
@local-table-of-contents[]
@ -425,5 +427,3 @@ generated. For more information on their semantics, consult the paper
Binds @scheme[wc] to @scheme[v] in the current frame, shadowing any
other bindings to @scheme[wc] in the current frame.
}
@include-section["servlet-env.scrbl"]

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

@ -2,7 +2,8 @@
@(require "web-server.ss")
@title[#:tag "web-server-ref"]{@bold{Web Server}: PLT HTTP Server}
@author{Jay McCarthy (jay@"@"plt-scheme.org)}
By Jay McCarthy (jay@"@"plt-scheme.org)
The @web-server collection provides libraries that can be used to
develop Web applications in Scheme.
@ -31,8 +32,8 @@ We thank Matthew Flatt for his superlative work on MzScheme.
We thank the previous maintainers of the @web-server : Paul T. Graunke, Mike Burns, and Greg Pettyjohn
Numerous people have
provided invaluable feedback on the server, including Eli Barzilay, Ryan Culpepper, Robby
Findler, Dan Licata, Matt Jadud, Jacob Matthews, Matthias Radestock, Andrey Skylar,
Michael Sperber, Dave Tucker, Anton van Straaten, and Noel Welsh. We also thank the
Findler, Dave Gurnell, Matt Jadud, Dan Licata, Jacob Matthews, Matthias Radestock, Andrey Skylar,
Michael Sperber, Anton van Straaten, Dave Tucker, and Noel Welsh. We also thank the
many other PLT Scheme users who have exercised the server and offered critiques.
@index-section[]

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

@ -1,87 +1,125 @@
; Derived from plai/web/server, which was based on an older version of this
; Also derived from planet/untyped/instaservlet
#lang scheme/base
(require (prefix-in net: net/sendurl)
(for-syntax scheme/base)
mzlib/list)
(require "web-server.ss"
"configuration/configuration-table.ss"
"private/util.ss"
"managers/timeouts.ss"
"private/servlet.ss"
"configuration/namespace.ss"
"private/cache-table.ss"
(prefix-in servlets: "dispatchers/dispatch-servlets.ss"))
(require "servlet.ss")
(provide (rename-out [on-web:syntax on-web])
send-url
(all-from-out "servlet.ss"))
scheme/list)
(require web-server/web-server
web-server/managers/lru
web-server/private/servlet
web-server/configuration/namespace
web-server/private/cache-table
web-server/private/util
web-server/configuration/responders
web-server/dispatchers/dispatch
web-server/private/mime-types
web-server/configuration/configuration-table
(prefix-in lift: web-server/dispatchers/dispatch-lift)
(prefix-in fsmap: web-server/dispatchers/filesystem-map)
(prefix-in sequencer: web-server/dispatchers/dispatch-sequencer)
(prefix-in files: web-server/dispatchers/dispatch-files)
(prefix-in filter: web-server/dispatchers/dispatch-filter)
(prefix-in servlets: web-server/dispatchers/dispatch-servlets))
(define send-url (make-parameter net:send-url))
; XXX Change to setup temporary file and special dispatcher
(define-syntax (on-web:syntax stx)
(syntax-case stx ()
[(on-web:syntax servlet-expr)
(syntax
(on-web:syntax 8000 servlet-expr))]
[(on-web:syntax port servlet-expr)
(with-syntax ([initial-request (datum->syntax (syntax servlet-expr) 'initial-request)])
(syntax
(on-web (lambda (initial-request) servlet-expr)
port
"servlets/standalone.ss")))]))
(define (quit-server sema)
(lift:make
(lambda (request)
(thread (lambda () (sleep 2) (semaphore-post sema)))
`(html
(head
(title "Server Stopped")
(link ([rel "stylesheet"] [href "/error.css"])))
(body
(div ([class "section"])
(div ([class "title"]) "Server Stopped")
(p "Return to DrScheme.")))))))
(define (on-web servlet-expr the-port the-path)
(provide serve/servlet)
(define (serve/servlet new-servlet
#:launch-browser?
[launch-browser? #t]
#:quit?
[quit? #t]
#:listen-ip
[listen-ip "127.0.0.1"]
#:port
[the-port 8000]
#:manager
[manager
(make-threshold-LRU-manager
(lambda (request)
`(html (head (title "Page Has Expired."))
(body (p "Sorry, this page has expired. Please go back."))))
(* 64 1024 1024))]
#:servlet-namespace
[servlet-namespace empty]
#:server-root-path
[server-root-path (directory-part default-configuration-table-path)]
#:extra-files-path
[extra-files-path (build-path server-root-path "htdocs")]
#:servlets-root
[servlets-root (build-path server-root-path ".")]
#: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"])
(let*-values
([(standalone-url)
(format "http://localhost:~a/~a" the-port the-path)]
[(final-value)
(void)]
[(final-conn)
(void)]
[(sema)
(make-semaphore 0)]
[(make-servlet-namespace) (make-make-servlet-namespace)]
[(new-servlet)
(lambda (initial-request)
(let ([v (servlet-expr initial-request)])
(set! final-value v)
(semaphore-post sema)
(if (response? v)
v
`(html (head (title "Servlet has ended."))
(body (p "This servlet has ended, please return to the interaction window."))))))]
(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)]
[(clear-cache! servlet-dispatch)
[(sema) (make-semaphore 0)]
[(dispatcher)
(sequencer:make
(if quit?
(filter:make
#rx"^/quit$"
(quit-server sema))
(lambda _ (next-dispatcher)))
(filter:make
#rx"\\.ss"
(let-values ([(clear-cache! servlet-dispatch)
(servlets:make (box the-scripts)
#:make-servlet-namespace make-servlet-namespace
#:url->path
(lambda _
(values (build-path (directory-part default-configuration-table-path)
"default-web-root" "."
the-path)
empty)))]
(values (build-path servlets-root servlet-path)
empty)))])
servlet-dispatch))
(files:make
#:url->path (fsmap:make-url->path
extra-files-path)
#:path->mime-type (make-path->mime-type mime-types-path)
#:indices (list "index.html" "index.htm"))
(files:make
#:url->path (fsmap:make-url->path
(build-path server-root-path "htdocs"))
#:path->mime-type (make-path->mime-type (build-path server-root-path "mime.types"))
#:indices (list "index.html" "index.htm"))
(lift:make (gen-file-not-found-responder file-not-found-path)))]
[(shutdown-server)
(serve #:dispatch servlet-dispatch
(serve #:dispatch dispatcher
#:listen-ip listen-ip
#:port the-port)])
(cache-table-lookup! the-scripts
(string->symbol
(path->string
(build-path (directory-part default-configuration-table-path)
"default-web-root" "."
the-path)))
(build-path servlets-root servlet-path)))
(lambda ()
(make-servlet (make-custodian)
(make-servlet-namespace)
(create-timeout-manager
(lambda (request)
`(html (head "Return to the interaction window.")
(body (p "Return to the interaction window."))))
30 30)
manager
new-servlet)))
((send-url) standalone-url #t)
; Wait for final call
(when launch-browser?
((send-url) standalone-url #t))
(printf "Your web application is running at ~a.~n" standalone-url)
(printf "Click 'Stop' at any time to terminate the web server.~n")
(semaphore-wait sema)
; XXX: Find a way to wait for final HTML to be sent
; Shutdown the server
(shutdown-server)
final-value))
(shutdown-server)))

10
collects/web-server/tests/servlet-env-test.ss
View File

@ -7,7 +7,8 @@
mzlib/list
mzlib/pretty
net/url
web-server/servlet-env)
web-server/servlet-env
web-server/servlet)
(provide servlet-env-tests)
#;(define (call u bs)
@ -51,9 +52,10 @@
(input ([type "text"] [name "number"] [value ""]))
(input ([type "submit"] [name "enter"] [value "Enter"])))))))
(define (example)
(on-web
9999
(serve/servlet
(lambda (request)
`(html (head (title "Sum"))
(body ([bgcolor "white"])
(p "The sum is "
,(number->string (+ (request-number "first") (request-number "second"))))))))
,(number->string (+ (request-number "first") (request-number "second")))))))
#:port 9999))

2
collects/web-server/web-config-unit.ss
View File

@ -103,7 +103,7 @@
(let ([m (host-table-messages host-table)]
[conf (paths-conf paths)])
(make-responders
(gen-servlet-responder (build-path-unless-absolute conf (messages-servlet m)))
servlet-error-responder
servlet-loading-responder
(gen-authentication-responder (build-path-unless-absolute conf (messages-authentication m)))
(gen-servlets-refreshed (build-path-unless-absolute conf (messages-servlets-refreshed m)))