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

Static 404 page for packages

Browse Source
This commit is contained in:
Tony Garnock-Jones 2015-09-25 16:57:29 -04:00
parent 23c2c93164
commit 357bf31220
2 changed files with 36 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
src/site.rkt
View File

@ -75,6 +75,7 @@
[("search") search-page]
[("package" (string-arg)) package-page]
[("package" (string-arg) "edit") edit-package-page]
[("package-not-found") package-not-found-page]
[("create") edit-package-page]
[("login") login-page]
[("register-or-reset") register-or-reset-page]
@ -644,17 +645,26 @@
#f]))
deps))
(define (package-page request package-name-str)
(define (package-not-found-page request [package-name-str #f])
(authentication-wrap
#:request request
(define package-name (string->symbol package-name-str))
(define pkg (package-detail package-name))
(define default-version (package-default-version pkg))
(if (not pkg)
(bootstrap-response #:code 404
#:message #"No such package"
"Package not found"
`(div "The package " (code ,package-name-str) " does not exist."))
(bootstrap-response #:code 404
#:message #"No such package"
"Package not found"
(if package-name-str
`(div "The package " (code ,package-name-str) " does not exist.")
`(div "The requested package does not exist."))
`(ul (li (a ((href ,(named-url main-page)))
"Return to the package index"))))))
(define (package-page request package-name-str)
(define package-name (string->symbol package-name-str))
(define pkg (package-detail package-name))
(if (not pkg)
(package-not-found-page request package-name-str)
(authentication-wrap
#:request request
(define default-version (package-default-version pkg))
(bootstrap-response (~a package-name)
#:title-element ""
`(div ((class "jumbotron"))
@ -1291,6 +1301,18 @@
(define (rerender-all!)
(thread-send (package-change-handler-thread) 'rerender-all!))
(define (internal:rerender-package-not-found!)
(static-render! relative-named-url package-not-found-page #:ignore-response-code? #t)
(log-info "Generating package/.htaccess")
(call-with-output-file
(format "~a/package/.htaccess" static-generated-directory)
(lambda (p)
(fprintf p "ErrorDocument 404 ~a~a\n"
static-urlprefix
(relative-named-url package-not-found-page)))
#:exists 'replace)
(finish-static-update!))
(define (package-change-handler index-rerender-needed? pending-completions)
(sync/timeout (and index-rerender-needed?
(lambda ()
@ -1302,7 +1324,8 @@
(handle-evt (thread-receive-evt)
(lambda (_)
(match (thread-receive)
['upgrade
['upgrade ;; Happens every time site.rkt is reloaded
(internal:rerender-package-not-found!)
(package-change-handler index-rerender-needed?
pending-completions)]
['rerender-all!

4
src/static.rkt
View File

@ -34,6 +34,7 @@
(define rendering-static-page? (make-parameter #f))
(define (static-render! #:filename [base-filename #f]
#:ignore-response-code? [ignore-response-code? #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"
@ -60,7 +61,8 @@
servlet-prompt)))))
(define filename (format "~a~a" static-generated-directory (or base-filename request-url)))
(cond
[(<= 200 (response-code response) 299) ;; "OKish" range
[(or (<= 200 (response-code response) 299) ;; "OKish" range
ignore-response-code?)
(make-parent-directory* filename)
(call-with-output-file filename
(response-output response)