From 15ec64b82936aba6e478b5b077cd792260c66c2d Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Mon, 26 Jan 2015 17:03:51 -0500 Subject: [PATCH] Steps toward proper management of static resources --- .gitignore | 2 +- configs/tonyg.rkt | 5 ++-- src/config.rkt | 17 +++++++++++- src/main.rkt | 2 +- src/site.rkt | 66 ++++++++--------------------------------------- src/static.rkt | 65 ++++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 97 insertions(+), 60 deletions(-) create mode 100644 src/static.rkt diff --git a/.gitignore b/.gitignore index d4eb274..e85b6a6 100644 --- a/.gitignore +++ b/.gitignore @@ -8,4 +8,4 @@ compiled/ *.[0-9]* server-cert.pem private-key.pem -static/cached/ +var/ diff --git a/configs/tonyg.rkt b/configs/tonyg.rkt index dc563f8..e7e9b0c 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-generated-directory (build-path (find-system-path 'home-dir) - "public_html/pkg-catalog-static") + 'static-content-target-type 'directory + '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" diff --git a/src/config.rkt b/src/config.rkt index 7f4664c..4894b95 100644 --- a/src/config.rkt +++ b/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"))) diff --git a/src/main.rkt b/src/main.rkt index aec2bbc..d577fbf 100644 --- a/src/main.rkt +++ b/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"))) diff --git a/src/site.rkt b/src/site.rkt index 7f3b7b2..e0671c8 100644 --- a/src/site.rkt +++ b/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") - -(define static-generated-directory - (or (@ (config) static-generated-directory) - "../static/cached")) +(require "static.rkt") (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 diff --git a/src/static.rkt b/src/static.rkt new file mode 100644 index 0000000..57e6d18 --- /dev/null +++ b/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")))