diff --git a/pollen/decode.rkt b/pollen/decode.rkt index ee88ed5..8270f1f 100644 --- a/pollen/decode.rkt +++ b/pollen/decode.rkt @@ -51,8 +51,8 @@ (let loop ([x tx-in]) (cond [(txexpr? x) (let-values([(tag attrs elements) (txexpr->values x)]) - (if (or (memq tag excluded-tags) (for/or ([attr (in-list attrs)]) - (memq attr excluded-attrs))) + (if (or (member tag excluded-tags) (for/or ([attr (in-list attrs)]) + (member attr excluded-attrs))) x ; because it's excluded ;; we apply processing here rather than do recursive descent on the pieces ;; because if we send them back through loop, certain element types are ambiguous diff --git a/pollen/private/project-server.rkt b/pollen/private/project-server.rkt index 946dc47..5a6366d 100755 --- a/pollen/private/project-server.rkt +++ b/pollen/private/project-server.rkt @@ -1,10 +1,22 @@ #lang web-server/base (require racket/list - web-server/servlet-env - web-server/dispatch) -(require "project-server-routes.rkt" - "debug.rkt" + racket/path + racket/match + setup/collection-search + web-server/dispatch + web-server/servlet/setup + web-server/servlet/servlet-structs + web-server/servlet-dispatch + web-server/configuration/namespace + web-server/private/mime-type + (prefix-in lift: web-server/dispatchers/dispatch-lift) + (prefix-in sequencer: web-server/dispatchers/dispatch-sequencer) + (prefix-in files: web-server/dispatchers/dispatch-files) + (prefix-in servlets: web-server/dispatchers/dispatch-servlets) + (prefix-in fsmap: web-server/dispatchers/filesystem-map)) +(require "project-server-routes.rkt" + "debug.rkt" "../setup.rkt" "../file.rkt" "../cache.rkt" @@ -12,6 +24,16 @@ (provide start-server) +(define (dispatcher-sequence . dispatchers) + (let loop ([ds dispatchers] [r '()]) + (cond [(null? ds) (apply sequencer:make (reverse r))] + [(not (car ds)) (loop (cdr ds) r)] + [(list? (car ds)) (loop (append (car ds) (cdr ds)) r)] + [else (loop (cdr ds) (cons (car ds) r))]))) + +(define default-web-root + (collection-search '(lib "web-server/default-web-root"))) + (define (start-server servlet-path [open-browser-window? #f]) (define-values (pollen-servlet _) (dispatch-rules @@ -20,22 +42,62 @@ [((string-arg) ... "in" (string-arg) ...) route-in] [((string-arg) ... "out" (string-arg) ...) route-out] [else route-default])) - + (message (format "Welcome to Pollen ~a" pollen:version) (format "(Racket ~a)" (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" server-name) "(Ctrl+C to exit)") (message (format "Project dashboard is ~a/~a" server-name (setup:main-pagetree))) (message "Ready to rock") - + + ; modified from servlet-env.rkt in web-server + + (define server-root-path default-web-root) + (define servlets-root (build-path server-root-path "htdocs")) + (define mime-types-path (let ([p (build-path server-root-path "mime.types")]) + (if (file-exists? p) + p + (build-path default-web-root "mime.types")))) + (define (dispatcher sema) + (dispatcher-sequence + (dispatch/servlet pollen-servlet) + + (let-values ([(clear-cache! url->servlet) + (servlets:make-cached-url->servlet + (fsmap:filter-url->path + #rx"\\.(ss|scm|rkt|rktd)$" + (fsmap:make-url->valid-path + (fsmap:make-url->path servlets-root))) + (make-default-path->servlet + #:make-servlet-namespace + (make-make-servlet-namespace #:to-be-copied-module-specs empty)))]) + (servlets:make url->servlet)) + + (files:make + #:url->path (fsmap:make-url->path (current-server-extras-path)) + #:path->mime-type (make-path->mime-type mime-types-path) + #:indices (list "index.html" "index.htm")) + + (files:make + #:url->path (fsmap:make-url->path (current-project-root)) + #:path->mime-type (lambda (path) + (match (path-get-extension path) + [#".txt" #"text/plain; charset=utf-8"] + [_ ((make-path->mime-type mime-types-path) path)])) + #:indices (list "index.html" "index.htm")) + + (files:make + #:url->path (fsmap:make-url->path (build-path server-root-path "htdocs")) + #:path->mime-type (make-path->mime-type mime-types-path) + #:indices (list "index.html" "index.htm")) + + (lift:make (compose any->response route-404)))) + (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? #t - #:file-not-found-responder route-404 - #:extra-files-paths (list (current-server-extras-path) (current-project-root))))) \ No newline at end of file + (serve/launch/wait + dispatcher + #:launch-path (and open-browser-window? servlet-path) + #:listen-ip (current-server-listen-ip) + #:port (current-server-port))) + ) diff --git a/pollen/private/ts.rktd b/pollen/private/ts.rktd index 961a438..996eb3b 100644 --- a/pollen/private/ts.rktd +++ b/pollen/private/ts.rktd @@ -1 +1 @@ -1515628033 +1515438158