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

* Move namespace specs back to main code, and pass them through a

Browse Source 
`#:namespace' keyword
* More robust error handler -- use the url that initiated the
  interaction

svn: r17428
This commit is contained in:
Eli Barzilay 2009-12-29 16:02:59 +00:00
parent 9660490922
commit 8aa62e22b2
2 changed files with 35 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
collects/handin-server/run-servlet.ss
View File

@ -14,41 +14,47 @@
(prefix-in sequencer: web-server/dispatchers/dispatch-sequencer) (prefix-in sequencer: web-server/dispatchers/dispatch-sequencer)
(prefix-in files: web-server/dispatchers/dispatch-files) (prefix-in files: web-server/dispatchers/dispatch-files)
(prefix-in log: web-server/dispatchers/dispatch-log) (prefix-in log: web-server/dispatchers/dispatch-log)
web-server/http/request-structs
net/url
net/tcp-sig net/tcp-sig
net/ssl-tcp-unit) net/ssl-tcp-unit)
(define ((send-error msg) req)
`(html (head (meta [(http-equiv "refresh") (content "3;URL=/")])
(title ,msg))
(body ,msg "; " (a ([href "/"]) "restarting") " in 3 seconds.")))
(provide run-servlet) (provide run-servlet)
(define (run-servlet dispatcher port server-dir (define (run-servlet dispatcher port server-dir
#:namespace [namespace '()]
#:log-file [log-file #f]) #:log-file [log-file #f])
(define ((send-error msg to) req)
(let ([to (to)])
`(html (head (meta ([http-equiv "refresh"]
[content ,(format "3;URL=~a" to)]))
(title ,msg))
(body ,msg "; " (a ([href ,to]) "restarting") " in 3 seconds."))))
(define tcp@
(let ()
(define-unit-binding ssl-tcp@
(make-ssl-tcp@ (build-path server-dir "server-cert.pem")
(build-path server-dir "private-key.pem")
#f #f #f #f #f)
(import) (export tcp^))
ssl-tcp@))
(serve (serve
#:port port #:listen-ip #f #:port port #:listen-ip #f
#:tcp@ (let () #:tcp@ tcp@
(define-unit-binding ssl-tcp@
(make-ssl-tcp@ (build-path server-dir "server-cert.pem")
(build-path server-dir "private-key.pem")
#f #f #f #f #f)
(import) (export tcp^))
ssl-tcp@)
#:dispatch #:dispatch
(sequencer:make (sequencer:make
(and log-file (log:make #:format (log:log-format->format 'apache-default) (and log-file (log:make #:format (log:log-format->format 'apache-default)
#:log-path log-file)) #:log-path log-file))
(dispatch/servlet (let ([init-path (make-parameter "/")])
dispatcher (dispatch/servlet
#:regexp #rx"" (lambda (req)
#:namespace '(handin-server/private/md5 (init-path (url->string (request-uri req)))
handin-server/private/logger (dispatcher req))
handin-server/private/config #:regexp #rx"^/(?:/|$)"
handin-server/private/hooker #:namespace namespace
handin-server/private/reloadable) #:current-directory server-dir
#:current-directory server-dir #:manager (make-threshold-LRU-manager
#:manager (make-threshold-LRU-manager (send-error "Your session has expired" init-path)
(send-error "Your session has expired") (* 12 1024 1024))) (* 12 1024 1024))))
(files:make (files:make
#:url->path (fsmap:make-url->path (build-path server-dir "htdocs"))) #:url->path (fsmap:make-url->path (build-path server-dir "htdocs")))
(lift:make (send-error "File not found"))))) (lift:make (send-error "File not found" (lambda () "/"))))))

5
collects/handin-server/web-status-server.ss
View File

@ -259,5 +259,10 @@
(log-line "*** starting web server") (log-line "*** starting web server")
(parameterize ([error-print-context-length 0]) (parameterize ([error-print-context-length 0])
(run-servlet dispatcher p server-dir (run-servlet dispatcher p server-dir
#:namespace '(handin-server/private/md5
handin-server/private/logger
handin-server/private/config
handin-server/private/hooker
handin-server/private/reloadable)
#:log-file (get-conf 'web-log-file))))] #:log-file (get-conf 'web-log-file))))]
[else void])) [else void]))