mbutterick
/
pollen
3
3
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

allow project server to use default index page (closes #123)

Browse Source
pull/127/head
Matthew Butterick 8 years ago
parent 5ff7f1cb6d
commit 9e66e3547f
5 changed files with 30 additions and 10 deletions
Show Stats Download Patch File Download Diff File

24
pollen/private/project-server-routes.rkt
Unescape Escape View File

@ -4,6 +4,7 @@
(require net/url) (require net/url)
(require web-server/http/request-structs) (require web-server/http/request-structs)
(require web-server/http/response-structs) (require web-server/http/response-structs)
(require web-server/http/redirect)
(require 2htdp/image) (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") (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 ;;; separated out for ease of testing
;;; because it's tedious to start the server just to check a route. ;;; 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) (define (response/xexpr+doctype xexpr)
(response/xexpr #:preamble #"<!DOCTYPE html>" xexpr)) (response/xexpr #:preamble #"<!DOCTYPE html>" xexpr))
@ -35,6 +36,7 @@
(make-request #"GET" (string->url u) empty (make-request #"GET" (string->url u) empty
(delay empty) #f "1.2.3.4" 80 "4.3.2.1")) (delay empty) #f "1.2.3.4" 80 "4.3.2.1"))
;; print message to console about a request ;; print message to console about a request
(define/contract (logger req) (define/contract (logger req)
(request? . -> . void?) (request? . -> . void?)
@ -42,7 +44,9 @@
(define localhost-client "::1") (define localhost-client "::1")
(define url-string (url->string (request-uri req))) (define url-string (url->string (request-uri req)))
(when (not (ends-with? url-string "favicon.ico")) (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) "")))) (if (not (equal? client localhost-client)) (format "from ~a" client) ""))))
;; pass string args to route, then ;; pass string args to route, then
@ -268,13 +272,23 @@
(render-from-source-or-output-path (req->path req)) (render-from-source-or-output-path (req->path req))
(next-dispatcher)) (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 ;; 404 route
(define/contract (route-404 req) (define/contract (route-404 req)
(request? . -> . response?) (request? . -> . response?)
(define missing-path (->string (req->path req))) (define missing-path-string (path->string (simplify-path (req->path req))))
(message (format "route-404: Can't find ~a" missing-path)) (message (format "route-404: Can't find ~a" missing-path-string))
(response/xexpr+doctype (response/xexpr+doctype
`(html `(html
(head (title "404 error") (link ((href "/error.css") (rel "stylesheet")))) (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"))))))

1
pollen/private/project-server.rkt
Unescape Escape View File

@ -15,6 +15,7 @@
(define (start-server) (define (start-server)
(define-values (pollen-servlet _) (define-values (pollen-servlet _)
(dispatch-rules (dispatch-rules
[((string-arg) ... (? (λ(x) (equal? "" x)))) route-index] ; last element of a "/"-terminated url is ""
[((string-arg) ... (? pagetree-source?)) route-dashboard] [((string-arg) ... (? pagetree-source?)) route-dashboard]
[("in" (string-arg) ...) route-in] [("in" (string-arg) ...) route-in]
[("out" (string-arg) ...) route-out] [("out" (string-arg) ...) route-out]

2
pollen/private/ts.rktd
Unescape Escape View File

@ -1 +1 @@
1470764178 1471443458

3
pollen/scribblings/setup.scrbl
Unescape Escape View File

@ -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[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} @section{Parameters}
I mean @italic{parameters} in the Racket sense, i.e. values that can be fed to @racket[parameterize]. I mean @italic{parameters} in the Racket sense, i.e. values that can be fed to @racket[parameterize].

8
pollen/setup.rkt
Unescape Escape View File

@ -20,9 +20,9 @@
(define starting-dir (if (directory-exists? file-or-dir) file-or-dir (dirname file-or-dir))) (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]) (let loop ([dir starting-dir][path file-with-config-submodule])
(and dir ; dir is #f when it hits the top of the filesystem (and dir ; dir is #f when it hits the top of the filesystem
(let ([completed-path (path->complete-path path starting-dir)]) (let ([simplified-path (simplify-path (path->complete-path path starting-dir))])
(if (file-exists? completed-path) (if (file-exists? simplified-path)
(simplify-path completed-path) simplified-path
(loop (dirname dir) (build-path 'up path))))))) (loop (dirname dir) (build-path 'up path)))))))
@ -124,3 +124,5 @@
(define-settable poly-source-ext 'poly) ; extension that signals source can be used for multiple output targets (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-settable poly-targets '(html)) ; current target applied to multi-output source files
(define+provide current-poly-target (make-parameter (car (poly-targets)))) (define+provide current-poly-target (make-parameter (car (poly-targets))))
(define-settable index-pages '("index.html"))
Write Preview
Loading…
Cancel
Save