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

Mostly reformatting

Browse Source 
svn: r12524
This commit is contained in:
Eli Barzilay 2008-11-20 02:55:28 +00:00
parent 7c0db197ec
commit 788b94e28b
2 changed files with 107 additions and 110 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -30,12 +30,9 @@
(lift:make
(lambda (request)
(thread (lambda () (sleep 2) (semaphore-post sema)))
`(html
(head
(title "Server Stopped")
`(html (head (title "Server Stopped")
(link ([rel "stylesheet"] [href "/error.css"])))
(body
(div ([class "section"])
(body (div ([class "section"])
(div ([class "title"]) "Server Stopped")
(p "Return to DrScheme.")))))))
@ -59,7 +56,8 @@
#:servlet-regexp regexp?)
. ->* .
void)])
(define (serve/servlet start
(define (serve/servlet
start
#:command-line?
[command-line? #f]
#:launch-browser?
@ -100,22 +98,20 @@
#:servlet-current-directory
[servlet-current-directory servlets-root]
#:file-not-found-responder
[file-not-found-responder (gen-file-not-found-responder (build-path server-root-path "conf" "not-found.html"))]
[file-not-found-responder
(gen-file-not-found-responder
(build-path server-root-path "conf" "not-found.html"))]
#:mime-types-path
[mime-types-path (build-path server-root-path "mime.types")])
(define standalone-url
(format "http://localhost:~a~a" the-port servlet-path))
(define standalone-url (format "http://localhost:~a~a" the-port servlet-path))
(define make-servlet-namespace
(make-make-servlet-namespace
#:to-be-copied-module-specs servlet-namespace))
(make-make-servlet-namespace #:to-be-copied-module-specs servlet-namespace))
(define sema (make-semaphore 0))
(define servlet-box (box #f))
(define dispatcher
(sequencer:make
(if quit?
(filter:make
#rx"^/quit$"
(quit-server sema))
(filter:make #rx"^/quit$" (quit-server sema))
(lambda _ (next-dispatcher)))
(filter:make
servlet-regexp
@ -145,32 +141,33 @@
(apply sequencer:make
(map (lambda (extra-files-path)
(files:make
#:url->path (fsmap:make-url->path
extra-files-path)
#: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")))
extra-files-paths))
(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"))
#: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 file-not-found-responder)))
(define shutdown-server
(serve #:dispatch dispatcher
#:listen-ip listen-ip
#:port the-port))
(define welcome
(if banner?
(lambda ()
(printf "Your Web application is running at ~a.\n" standalone-url)
(printf "Click 'Stop' at any time to terminate the Web Server.\n"))
(void)))
(define (bye)
(when banner? (printf "\nWeb Server stopped.\n"))
(shutdown-server))
(when launch-browser?
((send-url) standalone-url #t))
(when banner?
(printf "Your Web application is running at ~a.~n" standalone-url)
(printf "Click 'Stop' at any time to terminate the Web Server.~n"))
(with-handlers
([exn:break?
(lambda (exn)
(when banner?
(printf "~nWeb Server stopped.~n"))
(shutdown-server))])
(welcome)
(with-handlers ([exn:break? (lambda (exn) (bye))])
(semaphore-wait/enable-break sema))
; We shouldn't get here, because nothing posts to the semaphore. But just in case...
(shutdown-server))
;; We can get here if a /quit url is visited
(bye))