suzanne.soy/racket-pkg-website
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Steps toward proper management of static resources

Browse Source
This commit is contained in:
Tony Garnock-Jones 2015-01-26 17:03:51 -05:00
parent 1537b2da2c
commit 15ec64b829
6 changed files with 97 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

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

5
configs/tonyg.rkt
View File

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

17
src/config.rkt
View File

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

2
src/main.rkt
View File

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

66
src/site.rkt
View File

@ -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

65
src/static.rkt Normal file
View File

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