From 1537b2da2cdaa01a94787c4498218c3ef4cbc7e2 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Mon, 26 Jan 2015 16:31:46 -0500
Subject: [PATCH] Steps toward sane static/dynamic URL split; better directory
handling
---
README.md | 10 ++++++----
configs/tonyg.rkt | 7 ++++---
src/bootstrap.rkt | 23 ++++++++++++++---------
src/entrypoint.rkt | 12 +++++++-----
src/main.rkt | 3 ++-
src/site.rkt | 33 +++++++++++++++++++++++++--------
6 files changed, 58 insertions(+), 30 deletions(-)
diff --git a/README.md b/README.md
index d92942d..34d61d5 100644
--- a/README.md
+++ b/README.md
@@ -37,12 +37,14 @@ Keys useful for development:
`http://pkgs.racket-lang.org/pkgs-all.json.gz`.
- *package-fetch-interval*; number, in seconds; default 300.
- *session-lifetime*: number, in seconds; default 604800.
- - *static-cached-directory*: string; names a directory relative to
+ - *static-generated-directory*: string; names a directory relative to
`src/` within which generated static HTML files are to be placed.
Must be writable by the user running the server.
- - *static-cached-urlprefix*: string; absolute or relative URL,
- prepended to relative URLs referring to generated static HTML files
- placed in `static-cached-directory`.
+ - *static-urlprefix*: string; absolute or relative URL, prepended to
+ relative URLs referring to static HTML files placed in
+ `static-generated-directory`.
+ - *dynamic-urlprefix*: string; absolute or relative URL, prepended to
+ URLs targetting dynamic content on the site.
- *disable-cache?*: boolean; default `#f`.
- *backend-baseurl*: string; default `https://pkgd.racket-lang.org`.
Must point to the backend package server API root, such that (for
diff --git a/configs/tonyg.rkt b/configs/tonyg.rkt
index f696ba8..dc563f8 100644
--- a/configs/tonyg.rkt
+++ b/configs/tonyg.rkt
@@ -4,8 +4,9 @@
(main (hash 'port 8444
'reloadable? #t
'package-index-url "http://localhost/~tonyg/pkg-catalog-static/pkgs-all.json.gz"
- 'static-cached-directory (build-path (find-system-path 'home-dir)
- "public_html/pkg-catalog-static")
- 'static-cached-urlprefix "http://localhost/~tonyg/pkg-catalog-static/"
+ 'static-generated-directory (build-path (find-system-path 'home-dir)
+ "public_html/pkg-catalog-static")
+ 'static-urlprefix "http://localhost/~tonyg/pkg-catalog-static"
+ 'dynamic-urlprefix "https://localhost:8444"
'backend-baseurl "https://localhost:8445"
))
diff --git a/src/bootstrap.rkt b/src/bootstrap.rkt
index a067085..c91267c 100644
--- a/src/bootstrap.rkt
+++ b/src/bootstrap.rkt
@@ -1,7 +1,8 @@
#lang racket/base
;; Utilities for working with Twitter Bootstrap, http://getbootstrap.com/2.3.2/
-(provide bootstrap-project-name
+(provide bootstrap-static-urlprefix
+ bootstrap-project-name
bootstrap-project-link
bootstrap-navbar-header
bootstrap-navigation
@@ -24,6 +25,7 @@
(require "html-utils.rkt")
(require "xexpr-utils.rkt")
+(define bootstrap-static-urlprefix (make-parameter ""))
(define bootstrap-project-name (make-parameter "Project"))
(define bootstrap-project-link (make-parameter "/"))
(define bootstrap-navbar-header (make-parameter #f))
@@ -34,6 +36,9 @@
(define bootstrap-page-scripts (make-parameter '()))
(define bootstrap-cookies (make-parameter '()))
+(define (static str)
+ (string-append (bootstrap-static-urlprefix) str))
+
;; String [#:title-element XExpr] [#:code Integer] [#:message Bytes] [XExpr ...] -> Response
(define (bootstrap-response title
#:title-element [title-element `(h1 ,title)]
@@ -52,9 +57,9 @@
(meta ((http-equiv "X-UA-Compatible") (content "IE=edge")))
(meta ((name "viewport") (content "width=device-width, initial-scale=1")))
(title ,title)
- (link ((rel "stylesheet") (href "/bootstrap/css/bootstrap.min.css") (type "text/css")))
- (link ((rel "stylesheet") (href "/jquery-ui.min.css") (type "text/css")))
- (link ((rel "stylesheet") (href "/style.css") (type "text/css")))
+ (link ((rel "stylesheet") (href ,(static "/bootstrap/css/bootstrap.min.css")) (type "text/css")))
+ (link ((rel "stylesheet") (href ,(static "/jquery-ui.min.css")) (type "text/css")))
+ (link ((rel "stylesheet") (href ,(static "/style.css")) (type "text/css")))
,@(for/list ((sheet (bootstrap-page-stylesheets)))
`(link ((rel "stylesheet") (href ,sheet) (type "text/css")))))
(body ,@(maybe-splice body-class `((class ,body-class)))
@@ -85,11 +90,11 @@
,title-element
,@body-contents)
- (script ((type "text/javascript") (src "/jquery.min.js")))
- (script ((type "text/javascript") (src "/jquery.tablesorter.min.js")))
- (script ((type "text/javascript") (src "/jquery-ui.min.js")))
- (script ((type "text/javascript") (src "/bootstrap/js/bootstrap.min.js")))
- (script ((type "text/javascript") (src "/site.js")))
+ (script ((type "text/javascript") (src ,(static "/jquery.min.js"))))
+ (script ((type "text/javascript") (src ,(static "/jquery.tablesorter.min.js"))))
+ (script ((type "text/javascript") (src ,(static "/jquery-ui.min.js"))))
+ (script ((type "text/javascript") (src ,(static "/bootstrap/js/bootstrap.min.js"))))
+ (script ((type "text/javascript") (src ,(static "/site.js"))))
,@(for/list ((script (bootstrap-page-scripts)))
`(script ((type "text/javascript") (src ,script))))))))
diff --git a/src/entrypoint.rkt b/src/entrypoint.rkt
index 5f1ca4d..2eccccb 100644
--- a/src/entrypoint.rkt
+++ b/src/entrypoint.rkt
@@ -13,7 +13,8 @@
(define (start-service* #:port [port 8443]
#:ssl? [ssl? #t]
request-handler-function
- on-continuation-expiry)
+ on-continuation-expiry
+ extra-files-paths)
(start-restart-signal-watcher)
((daemonize-thunk
'main-web-server-thread
@@ -27,8 +28,7 @@
on-continuation-expiry
;; This value is copied from web-server/servlet-env.rkt:
(* 128 1024 1024))
- #:extra-files-paths (list (build-path (current-directory)
- "../static"))
+ #:extra-files-paths (extra-files-paths)
#:ssl? ssl?
#:ssl-cert (and ssl? (build-path (current-directory) "../server-cert.pem"))
#:ssl-key (and ssl? (build-path (current-directory) "../private-key.pem"))
@@ -38,11 +38,13 @@
#:ssl? [ssl? #t]
#:reloadable? [reloadable? #t]
request-handler-entry-point
- on-continuation-expiry-entry-point)
+ on-continuation-expiry-entry-point
+ extra-files-paths-entry-point)
(when (not reloadable?)
(set-reload-poll-interval! #f))
(reload!)
(start-service* #:port port
#:ssl? ssl?
(reloadable-entry-point->procedure request-handler-entry-point)
- (reloadable-entry-point->procedure on-continuation-expiry-entry-point)))
+ (reloadable-entry-point->procedure on-continuation-expiry-entry-point)
+ (reloadable-entry-point->procedure extra-files-paths-entry-point)))
diff --git a/src/main.rkt b/src/main.rkt
index 5b5a9e6..aec2bbc 100644
--- a/src/main.rkt
+++ b/src/main.rkt
@@ -15,4 +15,5 @@
#:ssl? (hash-ref config 'ssl? (lambda () #t))
#:reloadable? (hash-ref config 'reloadable? (lambda () (getenv "SITE_RELOADABLE")))
(make-reloadable-entry-point 'request-handler "site.rkt")
- (make-reloadable-entry-point 'on-continuation-expiry "site.rkt")))
+ (make-reloadable-entry-point 'on-continuation-expiry "site.rkt")
+ (make-reloadable-entry-point 'extra-files-paths "site.rkt")))
diff --git a/src/site.rkt b/src/site.rkt
index a55340b..7f3b7b2 100644
--- a/src/site.rkt
+++ b/src/site.rkt
@@ -2,8 +2,10 @@
(provide request-handler
on-continuation-expiry
+ extra-files-paths
rerender-all!)
+(require racket/runtime-path)
(require racket/set)
(require racket/match)
(require racket/format)
@@ -25,18 +27,29 @@
(require "config.rkt")
(require "hash-utils.rkt")
-(define static-cached-directory
- (or (@ (config) static-cached-directory)
+(define static-generated-directory
+ (or (@ (config) static-generated-directory)
"../static/cached"))
-(define static-cached-urlprefix
- (or (@ (config) static-cached-urlprefix)
+(define static-urlprefix
+ (or (@ (config) static-urlprefix)
"/cached"))
+(define dynamic-urlprefix
+ (or (@ (config) dynamic-urlprefix)
+ ""))
+
(define disable-cache?
(or (@ (config) disable-cache?)
#f))
+(define-runtime-path here ".")
+(define (extra-files-paths)
+ (list (if (relative-path? static-generated-directory)
+ (build-path here static-generated-directory)
+ static-generated-directory)
+ (build-path here "../static")))
+
(define nav-index "Package Index")
(define nav-search "Search")
@@ -72,7 +85,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define-values (request-handler named-url)
+(define-values (request-handler relative-named-url)
(dispatch-rules
[("index") main-page]
[("") main-page]
@@ -96,6 +109,9 @@
(define static-render (make-parameter #f))
+(define (named-url . args)
+ (string-append dynamic-urlprefix (apply relative-named-url args)))
+
(define-syntax-rule (authentication-wrap #:request request body ...)
(authentication-wrap* #f request (lambda () body ...)))
@@ -105,6 +121,7 @@
(define-syntax-rule (with-site-config body ...)
(parameterize ((bootstrap-navbar-header navbar-header)
(bootstrap-navigation navigation)
+ (bootstrap-static-urlprefix static-urlprefix)
(jsonp-baseurl backend-baseurl))
body ...))
@@ -413,13 +430,13 @@
(define (main-page-url)
(if (use-cache?)
- (format "~a/index.html" static-cached-urlprefix)
+ (format "~a/index.html" static-urlprefix)
(named-url main-page)))
(define (view-package-url package-name)
(define package-name-str (~a package-name))
(if (use-cache?)
- (format "~a~a" static-cached-urlprefix (named-url package-page package-name-str))
+ (format "~a~a" static-urlprefix (named-url package-page package-name-str))
(named-url package-page package-name-str)))
(define (package-link package-name)
@@ -1289,7 +1306,7 @@
"127.0.0.1")
named-url-args))
servlet-prompt)))))
- (define filename (format "~a~a" static-cached-directory (or base-filename request-url)))
+ (define filename (format "~a~a" static-generated-directory (or base-filename request-url)))
(make-parent-directory* filename)
(call-with-output-file filename
(response-output response)