; This file is intended to be copied and/or modified and used as a template.
#lang scheme/base
(require (lib "cmdline.ss")
         (only-in (lib "file.ss")
                  normalize-path)
         (lib "web-server.ss" "web-server")
         (lib "responders.ss" "web-server" "configuration")
         (lib "mime-types.ss" "web-server" "private")
         (prefix-in fsmap: (lib "filesystem-map.ss" "web-server" "dispatchers"))
         (prefix-in timeout: (lib "dispatch-timeout.ss" "web-server" "dispatchers"))
         (prefix-in files: (lib "dispatch-files.ss" "web-server" "dispatchers"))
         (prefix-in filter: (lib "dispatch-filter.ss" "web-server" "dispatchers"))
         (prefix-in lift: (lib "dispatch-lift.ss" "web-server" "dispatchers"))
         (prefix-in sequencer: (lib "dispatch-sequencer.ss" "web-server" "dispatchers"))
         (prefix-in lang: (lib "dispatch-lang.ss" "web-server" "dispatchers"))
         (prefix-in stat: (lib "dispatch-stat.ss" "web-server" "dispatchers")))

(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 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)
        (filter:make
         #rx"\\.ss"
         (lang:make #:url->path (fsmap:make-url->valid-path url->path)
                    #: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)