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?))] [error-response ((natural-number/c string? string?) (listof (cons/c symbol? string?)) . ->* . (response?))]
; XXX contract ; XXX contract
[servlet-loading-responder (string? any/c . -> . response?)] [servlet-loading-responder (string? any/c . -> . response?)]
[gen-servlet-not-found (string? . -> . (string? . -> . response?))] [gen-servlet-not-found (path-string? . -> . (string? . -> . response?))]
[gen-servlet-responder (string? . -> . (string? any/c . -> . response?))] [gen-servlet-responder (path-string? . -> . (string? any/c . -> . response?))]
[gen-servlets-refreshed (string? . -> . (-> response?))] [gen-servlets-refreshed (path-string? . -> . (-> response?))]
[gen-passwords-refreshed (string? . -> . (-> response?))] [gen-passwords-refreshed (path-string? . -> . (-> response?))]
[gen-authentication-responder (string? . -> . (string? (cons/c symbol? string?) . -> . response?))] [gen-authentication-responder (path-string? . -> . (string? (cons/c symbol? string?) . -> . response?))]
[gen-protocol-responder (string? . -> . (string? . -> . response?))] [gen-protocol-responder (path-string? . -> . (string? . -> . response?))]
[gen-file-not-found-responder (string? . -> . (string? . -> . response?))] [gen-file-not-found-responder (path-string? . -> . (string? . -> . response?))]
[gen-collect-garbage-responder (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 (module run mzscheme
(require (lib "web-server.ss" "web-server") (require (lib "web-server.ss" "web-server")
(lib "response.ss" "web-server") (lib "configuration.ss" "web-server" "private")
(lib "util.ss" "web-server" "private")
(prefix files: (lib "dispatch-files.ss" "web-server" "dispatchers")) (prefix files: (lib "dispatch-files.ss" "web-server" "dispatchers"))
(prefix filter: (lib "dispatch-filter.ss" "web-server" "dispatchers")) (prefix filter: (lib "dispatch-filter.ss" "web-server" "dispatchers"))
(prefix sequencer: (lib "dispatch-sequencer.ss" "web-server" "dispatchers")) (prefix sequencer: (lib "dispatch-sequencer.ss" "web-server" "dispatchers"))
(prefix servlets2: "dispatch-servlets2.ss")) (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 server-root-path (build-path "~" "Development" "plt" "default-web-root"))
(define default-host-path (build-path server-root-path "conf")) (define default-host-path (build-path server-root-path "conf"))
(define htdocs-path (build-path server-root-path "htdocs")) (define htdocs-path (build-path server-root-path "htdocs"))
(define file-not-found-file (build-path default-host-path "not-found.html")) (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 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 (serve
#:port 8080 #:port 8080
#:dispatch (sequencer:make #:dispatch (sequencer:make
@ -53,12 +19,12 @@
#rx"\\.ss" #rx"\\.ss"
(servlets2:make #:htdocs-path htdocs-path (servlets2:make #:htdocs-path htdocs-path
#:timeouts-servlet-connection 86400 #:timeouts-servlet-connection 86400
#:responders-servlet-loading responders-servlet-loading #:responders-servlet-loading (gen-servlet-responder servlet-error-file)
#:responders-servlet responders-servlet #:responders-servlet (gen-servlet-responder servlet-error-file)
#:responders-file-not-found responders-file-not-found)) #:responders-file-not-found (gen-file-not-found-responder file-not-found-file)))
(files:make #:htdocs-path htdocs-path (files:make #:htdocs-path htdocs-path
#:mime-types-path (build-path server-root-path "mime.types") #:mime-types-path (build-path server-root-path "mime.types")
#:indices (list "index.html" "index.htm") #: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)) (do-not-return))