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

Making server starting easier

Browse Source 
svn: r6394
This commit is contained in:
Jay McCarthy 2007-05-29 22:31:49 +00:00
parent 8916fa9652
commit 31f90418ca
2 changed files with 14 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/web-server/private/configuration.ss
View File

@ -237,11 +237,11 @@
[error-response ((natural-number/c string? string?) (listof (cons/c symbol? string?)) . ->* . (response?))]
; XXX contract
[servlet-loading-responder (string? any/c . -> . response?)]
[gen-servlet-not-found (string? . -> . (string? . -> . response?))]
[gen-servlet-responder (string? . -> . (string? any/c . -> . response?))]
[gen-servlets-refreshed (string? . -> . (-> response?))]
[gen-passwords-refreshed (string? . -> . (-> response?))]
[gen-authentication-responder (string? . -> . (string? (cons/c symbol? string?) . -> . response?))]
[gen-protocol-responder (string? . -> . (string? . -> . response?))]
[gen-file-not-found-responder (string? . -> . (string? . -> . response?))]
[gen-collect-garbage-responder (string? . -> . (-> response?))]))
[gen-servlet-not-found (path-string? . -> . (string? . -> . response?))]
[gen-servlet-responder (path-string? . -> . (string? any/c . -> . response?))]
[gen-servlets-refreshed (path-string? . -> . (-> response?))]
[gen-passwords-refreshed (path-string? . -> . (-> response?))]
[gen-authentication-responder (path-string? . -> . (string? (cons/c symbol? string?) . -> . response?))]
[gen-protocol-responder (path-string? . -> . (string? . -> . response?))]
[gen-file-not-found-responder (path-string? . -> . (string? . -> . response?))]
[gen-collect-garbage-responder (path-string? . -> . (-> response?))]))

46
collects/web-server/prototype-web-server/run.ss
View File

@ -1,51 +1,17 @@
(module run mzscheme
(require (lib "web-server.ss" "web-server")
(lib "response.ss" "web-server")
(lib "util.ss" "web-server" "private")
(lib "configuration.ss" "web-server" "private")
(prefix files: (lib "dispatch-files.ss" "web-server" "dispatchers"))
(prefix filter: (lib "dispatch-filter.ss" "web-server" "dispatchers"))
(prefix sequencer: (lib "dispatch-sequencer.ss" "web-server" "dispatchers"))
(prefix servlets2: "dispatch-servlets2.ss"))
; error-response : nat str str [(cons sym str) ...] -> response
(define (error-response code short text-file . extra-headers)
(make-response/full code short
(current-seconds) TEXT/HTML-MIME-TYPE
extra-headers
(list (read-file text-file))))
; read-file : str -> str
(define (read-file path)
(call-with-input-file path
(lambda (in) (read-string (file-size path) in))))
(define server-root-path (build-path "~" "Development" "plt" "default-web-root"))
(define default-host-path (build-path server-root-path "conf"))
(define htdocs-path (build-path server-root-path "htdocs"))
(define file-not-found-file (build-path default-host-path "not-found.html"))
(define servlet-error-file (build-path default-host-path "servlet-error.html"))
(define responders-file-not-found
(lambda (url)
(error-response 404 "File not found" file-not-found-file)))
(define responders-servlet
(lambda (url exn)
((error-display-handler)
(format "Servlet exception:\n~a\n" (exn-message exn))
exn)
(error-response 500 "Servlet error" servlet-error-file)))
(define responders-servlet-loading
(lambda (url exn)
((error-display-handler)
(format "Servlet loading exception:\n~a\n" (exn-message exn))
exn)
(make-response/full 500 "Servlet didn't load"
(current-seconds)
#"text/plain"
'()
(list "Servlet didn't load.\n"
(exn->string exn)))))
(serve
#:port 8080
#:dispatch (sequencer:make
@ -53,12 +19,12 @@
#rx"\\.ss"
(servlets2:make #:htdocs-path htdocs-path
#:timeouts-servlet-connection 86400
#:responders-servlet-loading responders-servlet-loading
#:responders-servlet responders-servlet
#:responders-file-not-found responders-file-not-found))
#:responders-servlet-loading (gen-servlet-responder servlet-error-file)
#:responders-servlet (gen-servlet-responder servlet-error-file)
#:responders-file-not-found (gen-file-not-found-responder file-not-found-file)))
(files:make #:htdocs-path htdocs-path
#:mime-types-path (build-path server-root-path "mime.types")
#:indices (list "index.html" "index.htm")
#:file-not-found-responder responders-file-not-found)))
#:file-not-found-responder (gen-file-not-found-responder file-not-found-file))))
(do-not-return))