73 lines
3.2 KiB
Scheme
73 lines
3.2 KiB
Scheme
#lang scheme/base
|
|
; This file is intended to be copied and/or modified and used as a template.
|
|
(require mzlib/cmdline
|
|
(only-in mzlib/file
|
|
normalize-path)
|
|
web-server/web-server
|
|
web-server/configuration/responders
|
|
web-server/private/mime-types
|
|
(prefix-in path-procedure: "dispatchers/dispatch-pathprocedure.ss")
|
|
(prefix-in fsmap: web-server/dispatchers/filesystem-map)
|
|
(prefix-in timeout: web-server/dispatchers/dispatch-timeout)
|
|
(prefix-in files: web-server/dispatchers/dispatch-files)
|
|
(prefix-in filter: web-server/dispatchers/dispatch-filter)
|
|
(prefix-in lift: web-server/dispatchers/dispatch-lift)
|
|
(prefix-in sequencer: web-server/dispatchers/dispatch-sequencer)
|
|
(prefix-in servlets: web-server/dispatchers/dispatch-servlets)
|
|
(prefix-in stat: web-server/dispatchers/dispatch-stat))
|
|
|
|
(define server-root-path (make-parameter (collection-path "web-server" "default-web-root")))
|
|
(define port (make-parameter 8080))
|
|
|
|
(parse-command-line
|
|
"run" (current-command-line-arguments)
|
|
`((once-each
|
|
[("-p" "--port")
|
|
,(lambda (flag the-port) (port (string->number the-port)))
|
|
(,(format "Specify a different port (default: ~a)" (number->string (port)))
|
|
"number")]
|
|
[("-r" "--root")
|
|
,(lambda (flag path) (server-root-path (normalize-path (string->path path))))
|
|
(,(format "Specify a different server root path (default: ~a)" (path->string (server-root-path)))
|
|
"path")]))
|
|
(lambda (flag-accum) (void))
|
|
null)
|
|
|
|
(define default-host-path (build-path (server-root-path) "conf"))
|
|
(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-refresh-file (build-path default-host-path "servlet-refresh.html"))
|
|
|
|
(define url->path
|
|
(fsmap:make-url->path
|
|
(build-path (server-root-path) "htdocs")))
|
|
|
|
(define gc-thread (stat:make-gc-thread 30))
|
|
|
|
(serve #:port (port)
|
|
#:dispatch
|
|
(sequencer:make
|
|
(timeout:make (* 5 60))
|
|
(stat:make)
|
|
(let-values ([(clear-cache! url->servlet)
|
|
(servlets:make-cached-url->servlet
|
|
(fsmap:filter-url->path
|
|
#rx"\\.(ss|scm)$"
|
|
(fsmap:make-url->valid-path
|
|
url->path))
|
|
(servlets:make-default-path->servlet))])
|
|
(sequencer:make
|
|
(path-procedure:make "/conf/refresh-servlets"
|
|
(lambda _
|
|
(clear-cache!)
|
|
((gen-servlets-refreshed servlet-refresh-file))))
|
|
(servlets:make url->servlet
|
|
#:responders-servlet-loading (gen-servlet-responder servlet-error-file)
|
|
#:responders-servlet (gen-servlet-responder servlet-error-file))))
|
|
(files:make #:url->path url->path
|
|
#: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-file))))
|
|
|
|
(do-not-return)
|