Steps toward sane static/dynamic URL split; better directory handling

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,
+ - *static-urlprefix*: string; absolute or relative URL, prepended to
-   prepended to relative URLs referring to generated static HTML files
+   relative URLs referring to static HTML files placed in
-   placed in `static-cached-directory`.
+   `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

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)
+            'static-generated-directory (build-path (find-system-path 'home-dir)
-                                                 "public_html/pkg-catalog-static")
+                                                    "public_html/pkg-catalog-static")
-            'static-cached-urlprefix "http://localhost/~tonyg/pkg-catalog-static/"
+            'static-urlprefix "http://localhost/~tonyg/pkg-catalog-static"
+            'dynamic-urlprefix "https://localhost:8444"
             'backend-baseurl "https://localhost:8445"
             ))

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 ,(static "/bootstrap/css/bootstrap.min.css")) (type "text/css")))
-	   (link ((rel "stylesheet") (href "/jquery-ui.min.css") (type "text/css")))
+	   (link ((rel "stylesheet") (href ,(static "/jquery-ui.min.css")) (type "text/css")))
-           (link ((rel "stylesheet") (href "/style.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 ,(static "/jquery.min.js"))))
-      (script ((type "text/javascript") (src "/jquery.tablesorter.min.js")))
+      (script ((type "text/javascript") (src ,(static "/jquery.tablesorter.min.js"))))
-      (script ((type "text/javascript") (src "/jquery-ui.min.js")))
+      (script ((type "text/javascript") (src ,(static "/jquery-ui.min.js"))))
-      (script ((type "text/javascript") (src "/bootstrap/js/bootstrap.min.js")))
+      (script ((type "text/javascript") (src ,(static "/bootstrap/js/bootstrap.min.js"))))
-      (script ((type "text/javascript") (src "/site.js")))
+      (script ((type "text/javascript") (src ,(static "/site.js"))))
       ,@(for/list ((script (bootstrap-page-scripts)))
           `(script ((type "text/javascript") (src ,script))))))))
 

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)
+                     #:extra-files-paths (extra-files-paths)
-                                                           "../static"))
                      #: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)))

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")))

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
+(define static-generated-directory
-  (or (@ (config) static-cached-directory)
+  (or (@ (config) static-generated-directory)
       "../static/cached"))
 
-(define static-cached-urlprefix
+(define static-urlprefix
-  (or (@ (config) static-cached-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)