From 9e66e3547f07edd9b9358174e588638845024232 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 17 Aug 2016 07:17:39 -0700 Subject: [PATCH] allow project server to use default index page (closes #123) --- pollen/private/project-server-routes.rkt | 24 +++++++++++++++++++----- pollen/private/project-server.rkt | 1 + pollen/private/ts.rktd | 2 +- pollen/scribblings/setup.scrbl | 3 +++ pollen/setup.rkt | 10 ++++++---- 5 files changed, 30 insertions(+), 10 deletions(-) diff --git a/pollen/private/project-server-routes.rkt b/pollen/private/project-server-routes.rkt index 10a7395..613a27c 100644 --- a/pollen/private/project-server-routes.rkt +++ b/pollen/private/project-server-routes.rkt @@ -4,6 +4,7 @@ (require net/url) (require web-server/http/request-structs) (require web-server/http/response-structs) +(require web-server/http/redirect) (require 2htdp/image) (require "../setup.rkt" "../render.rkt" sugar sugar/unstable/string sugar/unstable/misc sugar/unstable/container txexpr/base "file-utils.rkt" "debug.rkt" "../pagetree.rkt" "../cache.rkt") @@ -13,7 +14,7 @@ ;;; separated out for ease of testing ;;; because it's tedious to start the server just to check a route. -(provide route-dashboard route-default route-404 route-in route-out) +(provide route-dashboard route-default route-404 route-in route-out route-index) (define (response/xexpr+doctype xexpr) (response/xexpr #:preamble #"" xexpr)) @@ -35,6 +36,7 @@ (make-request #"GET" (string->url u) empty (delay empty) #f "1.2.3.4" 80 "4.3.2.1")) + ;; print message to console about a request (define/contract (logger req) (request? . -> . void?) @@ -42,7 +44,9 @@ (define localhost-client "::1") (define url-string (url->string (request-uri req))) (when (not (ends-with? url-string "favicon.ico")) - (message "request:" (string-replace url-string (setup:main-pagetree) " dashboard") + (message "request:" (if (regexp-match #rx"/$" url-string) + (string-append url-string " directory default page") + (string-replace url-string (setup:main-pagetree) " dashboard")) (if (not (equal? client localhost-client)) (format "from ~a" client) "")))) ;; pass string args to route, then @@ -268,13 +272,23 @@ (render-from-source-or-output-path (req->path req)) (next-dispatcher)) +;; index route +(define (route-index req . string-args) + (logger req) + (or (for*/first ([index-dir (in-value (simplify-path (req->path req)))] + [possible-idx-page (in-list (setup:index-pages index-dir))] + [possible-idx-path (in-value (build-path index-dir possible-idx-page))] + [_ (in-value (render-from-source-or-output-path possible-idx-path))] + #:when (file-exists? possible-idx-path)) + (redirect-to (path->string (find-relative-path index-dir possible-idx-path)) temporarily)) + (route-404 req))) ;; 404 route (define/contract (route-404 req) (request? . -> . response?) - (define missing-path (->string (req->path req))) - (message (format "route-404: Can't find ~a" missing-path)) + (define missing-path-string (path->string (simplify-path (req->path req)))) + (message (format "route-404: Can't find ~a" missing-path-string)) (response/xexpr+doctype `(html (head (title "404 error") (link ((href "/error.css") (rel "stylesheet")))) - (body (div ((class "section")) (div ((class "title")) "404 error") (p ,(format "~v" missing-path) " was not found")))))) + (body (div ((class "section")) (div ((class "title")) "404 error") (p ,(format "~v" missing-path-string) " was not found")))))) diff --git a/pollen/private/project-server.rkt b/pollen/private/project-server.rkt index 60b6652..a7a1f67 100755 --- a/pollen/private/project-server.rkt +++ b/pollen/private/project-server.rkt @@ -15,6 +15,7 @@ (define (start-server) (define-values (pollen-servlet _) (dispatch-rules + [((string-arg) ... (? (λ(x) (equal? "" x)))) route-index] ; last element of a "/"-terminated url is "" [((string-arg) ... (? pagetree-source?)) route-dashboard] [("in" (string-arg) ...) route-in] [("out" (string-arg) ...) route-out] diff --git a/pollen/private/ts.rktd b/pollen/private/ts.rktd index b419709..3c22c59 100644 --- a/pollen/private/ts.rktd +++ b/pollen/private/ts.rktd @@ -1 +1 @@ -1470764178 +1471443458 diff --git a/pollen/scribblings/setup.scrbl b/pollen/scribblings/setup.scrbl index 8acf16e..ee0c05e 100644 --- a/pollen/scribblings/setup.scrbl +++ b/pollen/scribblings/setup.scrbl @@ -136,6 +136,9 @@ Default separators used in decoding. The first two are initialized to @racket["\ @defoverridable[poly-targets (listof symbol?)]{List of symbols that denotes the possible targets of a @racket['poly] source file. Default is @racket['(html)].} +@defoverridable[index-pages (listof string?)]{List of strings that the project server will use as directory default pages, in order of priority. Has no effect on command-line rendering operations. Also has no effect on your live web server (usually that's a setting you need to make in an @tt{.htaccess} configuration file). Default is @racket['("index.html")].} + + @section{Parameters} I mean @italic{parameters} in the Racket sense, i.e. values that can be fed to @racket[parameterize]. diff --git a/pollen/setup.rkt b/pollen/setup.rkt index 9581c91..9915205 100644 --- a/pollen/setup.rkt +++ b/pollen/setup.rkt @@ -20,9 +20,9 @@ (define starting-dir (if (directory-exists? file-or-dir) file-or-dir (dirname file-or-dir))) (let loop ([dir starting-dir][path file-with-config-submodule]) (and dir ; dir is #f when it hits the top of the filesystem - (let ([completed-path (path->complete-path path starting-dir)]) - (if (file-exists? completed-path) - (simplify-path completed-path) + (let ([simplified-path (simplify-path (path->complete-path path starting-dir))]) + (if (file-exists? simplified-path) + simplified-path (loop (dirname dir) (build-path 'up path))))))) @@ -123,4 +123,6 @@ (define-settable poly-source-ext 'poly) ; extension that signals source can be used for multiple output targets (define-settable poly-targets '(html)) ; current target applied to multi-output source files -(define+provide current-poly-target (make-parameter (car (poly-targets)))) \ No newline at end of file +(define+provide current-poly-target (make-parameter (car (poly-targets)))) + +(define-settable index-pages '("index.html")) \ No newline at end of file