Steps toward proper management of static resources

.gitignore

@@ -8,4 +8,4 @@ compiled/
 *.[0-9]*
 server-cert.pem
 private-key.pem
-static/cached/
+var/

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-generated-directory (build-path (find-system-path 'home-dir)
+            'static-content-target-type 'directory
-                                                    "public_html/pkg-catalog-static")
+            'static-content-target-location (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"

src/config.rkt

@@ -1,9 +1,24 @@
 #lang racket/base
 
-(provide config)
+(provide config
+         config-path
+         var-path)
 
 (require reloadable)
+(require racket/runtime-path)
+(require "hash-utils.rkt")
 
 (define *config* (make-persistent-state '*config* (lambda () (hash))))
 
 (define (config) (*config*))
+
+(define-runtime-path here ".")
+(define (config-path str)
+  (define p (if (relative-path? str)
+                (build-path here str)
+                str))
+  (if (path? p) (path->string p) p))
+
+(define (var-path)
+  (config-path (or (@ (config) var-path)
+                   "../var")))

src/main.rkt

@@ -16,4 +16,4 @@
                  #: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 'extra-files-paths "site.rkt")))
+                 (make-reloadable-entry-point 'extra-files-paths "static.rkt")))

src/site.rkt

@@ -2,7 +2,6 @@
 
 (provide request-handler
          on-continuation-expiry
-         extra-files-paths
          rerender-all!)
 
 (require racket/runtime-path)
@@ -26,14 +25,11 @@
 (require "daemon.rkt")
 (require "config.rkt")
 (require "hash-utils.rkt")
-
+(require "static.rkt")
-(define static-generated-directory
-  (or (@ (config) static-generated-directory)
-      "../static/cached"))
 
 (define static-urlprefix
   (or (@ (config) static-urlprefix)
-      "/cached"))
+      ""))
 
 (define dynamic-urlprefix
   (or (@ (config) dynamic-urlprefix)
@@ -43,13 +39,6 @@
   (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")
 
@@ -107,8 +96,6 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define static-render (make-parameter #f))
-
 (define (named-url . args)
   (string-append dynamic-urlprefix (apply relative-named-url args)))
 
@@ -600,7 +587,7 @@
     (authentication-wrap
      #:request request
      (cond
-      [(and (use-cache?) (not (static-render)))
+      [(and (use-cache?) (not (rendering-static-page?)))
        ;; Redirect to static version
        (bootstrap-redirect (main-page-url))]
       [else
@@ -647,7 +634,7 @@
    (define pkg (package-detail package-name))
    (define default-version (package-default-version pkg))
    (cond
-    [(and (use-cache?) (not (static-render)))
+    [(and (use-cache?) (not (rendering-static-page?)))
      ;; Redirect to static version
      (bootstrap-redirect (view-package-url package-name))]
     [(not pkg)
@@ -1277,41 +1264,6 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (static-render! #:filename [base-filename #f]
-                        handler . named-url-args)
-  (local-require racket/promise)
-  (local-require racket/file)
-  (local-require web-server/private/servlet)
-  (local-require web-server/http/request-structs)
-  (define request-url (apply named-url handler named-url-args))
-  (log-info "Rendering static version of ~a~a"
-            request-url
-            (if base-filename
-                (format " to ~a" base-filename)
-                ""))
-  (define response
-    (parameterize ((static-render #t))
-      (call-with-continuation-barrier
-       (lambda ()
-         (call-with-continuation-prompt
-          (lambda ()
-            (apply handler
-                   (request #"GET"
-                            (string->url request-url)
-                            '()
-                            (delay '())
-                            #f
-                            "127.0.0.1"
-                            0
-                            "127.0.0.1")
-                   named-url-args))
-          servlet-prompt)))))
-  (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)
-    #:exists 'replace))
-
 ;; TODO: fold the collection of this information into the package
 ;; database itself.
 (define (update-external-package-information! package-name)
@@ -1342,7 +1294,7 @@
 (define (package-change-handler index-rerender-needed? pending-completions)
   (sync/timeout (and index-rerender-needed?
                      (lambda ()
-                       (static-render! main-page #:filename "/index.html")
+                       (static-render! relative-named-url main-page #:filename "/index.html")
                        ;; TODO: copy static files to target
                        (for ((completion-ch pending-completions))
                          (channel-put completion-ch (void)))
@@ -1357,12 +1309,16 @@
                                  (log-info "rerender-all!")
                                  (for ((p (all-package-names)))
                                    (update-external-package-information! p)
-                                   (static-render! package-page (symbol->string p)))
+                                   (static-render! relative-named-url
+                                                   package-page
+                                                   (symbol->string p)))
                                  (package-change-handler #t
                                                          pending-completions)]
                                 [(list 'package-changed completion-ch package-name)
                                  (update-external-package-information! package-name)
-                                 (static-render! package-page (symbol->string package-name))
+                                 (static-render! relative-named-url
+                                                 package-page
+                                                 (symbol->string package-name))
                                  (package-change-handler
                                   #t
                                   (if completion-ch

src/static.rkt

@@ -0,0 +1,65 @@
+#lang racket/base
+
+(provide static-generated-directory
+         rendering-static-page?
+         static-render!
+         extra-files-paths)
+
+(require racket/promise)
+(require racket/file)
+(require web-server/private/servlet)
+(require web-server/http/request-structs)
+(require web-server/http/response-structs)
+(require net/url)
+(require "config.rkt")
+(require "hash-utils.rkt")
+
+(define static-generated-directory
+  (config-path (or (@ (config) static-generated-directory)
+                   (build-path (var-path) "generated-htdocs"))))
+
+(define rendering-static-page? (make-parameter #f))
+
+(define (static-render! #:filename [base-filename #f]
+                        named-url handler . named-url-args)
+  (define request-url (apply named-url handler named-url-args))
+  (log-info "Rendering static version of ~a~a"
+            request-url
+            (if base-filename
+                (format " to ~a" base-filename)
+                ""))
+  (define response
+    (parameterize ((rendering-static-page? #t))
+      (call-with-continuation-barrier
+       (lambda ()
+         (call-with-continuation-prompt
+          (lambda ()
+            (apply handler
+                   (request #"GET"
+                            (string->url request-url)
+                            '()
+                            (delay '())
+                            #f
+                            "127.0.0.1"
+                            0
+                            "127.0.0.1")
+                   named-url-args))
+          servlet-prompt)))))
+  (define filename (format "~a~a" static-generated-directory (or base-filename request-url)))
+  (cond
+   [(<= 200 (response-code response) 299) ;; "OKish" range
+    (make-parent-directory* filename)
+    (call-with-output-file filename
+      (response-output response)
+      #:exists 'replace)]
+   [(= (response-code response) 404) ;; Not found -> delete the file
+    (when (file-exists? filename)
+      (delete-file filename))]
+   [else
+    (log-warning "Unexpected response code ~v when static-rendering ~v"
+                 (response-code response)
+                 (cons handler named-url-args))]))
+
+(define (extra-files-paths)
+  (list (config-path static-generated-directory)
+        (config-path "../static")))