diff --git a/pollen/private/project-server.rkt b/pollen/private/project-server.rkt index a6b7394..0a140f6 100755 --- a/pollen/private/project-server.rkt +++ b/pollen/private/project-server.rkt @@ -1,7 +1,13 @@ -#lang web-server/base -(require racket/runtime-path - web-server/servlet-env +#lang racket/base +(require racket/runtime-path web-server/dispatch + web-server/web-server + web-server/servlet-dispatch + web-server/private/mime-types + (prefix-in files: web-server/dispatchers/dispatch-files) + (prefix-in sequencer: web-server/dispatchers/dispatch-sequencer) + web-server/dispatchers/filesystem-map + net/sendurl "project-server-routes.rkt" "log.rkt" "../setup.rkt" @@ -12,31 +18,53 @@ (define-runtime-path mime-types "server-extras/mime.types") -(define (start-server servlet-path [open-browser-window? #f]) - (define-values (pollen-servlet _) - (dispatch-rules - [((string-arg) ... (? (λ (x) (string=? "" x)))) route-index] ; last element of a "/"-terminated url is "" - [((string-arg) ... (? pagetree-source?)) route-dashboard] - [((string-arg) ... "in" (string-arg) ...) route-in] - [((string-arg) ... "out" (string-arg) ...) route-out] - [else route-default])) +(define (make-static-dispatcher-sequence . pths) + (apply sequencer:make + (for/list ([pth (in-list pths)]) + (files:make + #:path->mime-type (make-path->mime-type mime-types) + #:url->path (make-url->path (path->string pth)))))) + +(define-values (pollen-servlet _) + (dispatch-rules + ;; last element of a "/"-terminated url is "" + [((string-arg) ... "") route-index] + [((string-arg) ... (? pagetree-source?)) route-dashboard] + [((string-arg) ... "in" (string-arg) ...) route-in] + [((string-arg) ... "out" (string-arg) ...) route-out] + [else route-default])) + +(define (start-server servlet-path [open-browser-window? #false] #:return [return? #false]) + (define server-name (format "http://localhost:~a" (current-server-port))) + (message (format "welcome to Pollen ~a (Racket ~a)" pollen:version (version))) (message (format "project root is ~a" (current-project-root))) - - (define server-name (format "http://localhost:~a" (current-server-port))) (message (format "project server is ~a (Ctrl+C to exit)" server-name)) (message (format "project dashboard is ~a/~a" server-name (setup:main-pagetree))) + (message (let ([clsi (current-server-listen-ip)]) + (if clsi + (format "project server permitting access only to ~a" + (case clsi + [("127.0.0.1") "localhost"] + [else clsi])) + "project server permitting access to all clients"))) (message "ready to rock") - (parameterize ([error-print-width 1000]) - (serve/servlet pollen-servlet - #:launch-browser? open-browser-window? - #:servlet-path servlet-path - #:port (current-server-port) - #:listen-ip (current-server-listen-ip) - #:servlet-regexp #rx"" ; respond to top level - #:command-line? #true - #:file-not-found-responder route-404 - #:mime-types-path mime-types - #:extra-files-paths (list (current-project-root) (current-server-extras-path))))) \ No newline at end of file + (define stop-func + (parameterize ([error-print-width 1000]) + (serve + #:dispatch (sequencer:make + (dispatch/servlet pollen-servlet) + (make-static-dispatcher-sequence + (current-project-root) + (current-server-extras-path)) + (dispatch/servlet route-404)) + #:listen-ip (current-server-listen-ip) + #:port (current-server-port)))) + (when open-browser-window? + (send-url (string-append server-name servlet-path))) + (if return? + stop-func + (with-handlers ([exn:break? (λ (e) (stop-func) (message "project server stopped"))]) + (do-not-return)))) \ No newline at end of file diff --git a/pollen/private/ts.rktd b/pollen/private/ts.rktd index d064ade..9bd15bb 100644 --- a/pollen/private/ts.rktd +++ b/pollen/private/ts.rktd @@ -1 +1 @@ -1587667269 +1587667365