From 66ef365aa43b63a4cb1dabc26da9d0d1744d2ead Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sun, 1 Jul 2012 01:28:32 -0400 Subject: [PATCH] Add a "favicon.ico" copy, and a 404 page. The 404 page doesn't work right yet -- it should always use absolute links. --- collects/meta/web/common/layout.rkt | 25 ++++++++++++------- collects/meta/web/common/resources.rkt | 34 ++++++++++++++++++++++---- collects/meta/web/stubs/git.rkt | 5 ++-- 3 files changed, 47 insertions(+), 17 deletions(-) diff --git a/collects/meta/web/common/layout.rkt b/collects/meta/web/common/layout.rkt index d899e516c4..9736679ce3 100644 --- a/collects/meta/web/common/layout.rkt +++ b/collects/meta/web/common/layout.rkt @@ -70,7 +70,7 @@ #:description [description #f] ; for a meta tag #:extra-headers [extra-headers #f] #:extra-body-attrs [body-attrs #f] - #:resources resources ; see below + #:resources resources0 ; see below #:referrer [referrer (λ (url . more) (a href: url (if (null? more) linktitle more)))] @@ -84,6 +84,7 @@ (if (and extra-headers desc) (list desc "\n" extra-headers) (or desc extra-headers))) + (define resources (force resources0)) (define head (resources 'head wintitle headers)) (define navbar (resources 'navbar (or part-of this))) (define content @@ -100,7 +101,7 @@ (body content)) @||}) (define this (and (not html-only?) - (resource/referrer (get-path 'plain id file "html" dir) + (resource/referrer (get-path 'page id file "html" dir) (file-writer output-xml page) referrer))) (when this (pages->part-of this (or part-of this))) @@ -213,8 +214,8 @@ (syntax-parse stx [(_ (~or (~optional dir:expr) (~optional (~seq #:resources resources)) - (~optional (~seq #:robots.txt robots.txt) - #:defaults ([robots.txt #'#t]))) + (~optional (~seq #:robots robots) #:defaults ([robots #'#t])) + (~optional (~seq #:htaccess htaccess) #:defaults ([htaccess #'#t]))) ...) (unless (attribute dir) (raise-syntax-error 'define-context "missing ")) @@ -223,13 +224,19 @@ [copyfile-id (datum->syntax stx 'copyfile)] [symlink-id (datum->syntax stx 'symlink)] [resources-id (datum->syntax stx 'the-resources)]) - (with-syntax ([resources (or (attribute resources) - #'(make-resources (make-resource-files - dir robots.txt)))] - [provides (if provide? + (with-syntax ([provides (if provide? #'(provide page-id plain-id copyfile-id symlink-id resources-id) - #'(begin))]) + #'(begin))] + [resources + (or (attribute resources) + #'(make-resources + (make-resource-files + (λ (id . content) + (page* #:id id #:dir dir + #:resources (lazy resources-id) + content)) + dir robots htaccess)))]) #'(begin (define resources-id resources) (define-syntax-rule (page-id . xs) (page #:resources resources-id #:dir dir . xs)) diff --git a/collects/meta/web/common/resources.rkt b/collects/meta/web/common/resources.rkt index 820cf877e9..20caeacd19 100644 --- a/collects/meta/web/common/resources.rkt +++ b/collects/meta/web/common/resources.rkt @@ -13,14 +13,20 @@ (provide make-resource-files navbar-style page-sizes font-family) ; needed for the blog template -(define (make-resource-files dir robots.txt) - (define (copyfile file) - (copyfile-resource (in-here file) (web-path dir file))) +;; robots is passed as #:robots in define-context, and htaccess as #:htaccess; +;; they can be #t (the default) for the standard ones, or some text that gets +;; added to the standard contents -- which is the user-agent line and the +;; ErrorDocument respectively. +(define (make-resource-files page dir robots htaccess) + (define (copyfile file [target file]) + (copyfile-resource (in-here file) (web-path dir target))) (define (writefile file . contents) (resource (web-path dir file) (file-writer output (list contents "\n")))) `([logo ,(copyfile "logo.png")] [icon ,(copyfile "plticon.ico")] [style ,(writefile "plt.css" racket-style)] + ;; the following resources are not used directly, so their names are + ;; irrelevant [verification:google @,writefile["google5b2dc47c0b1b15cb.html"]{ google-site-verification: google5b2dc47c0b1b15cb.html}] @@ -30,8 +36,26 @@ 140BE58EEC31CB97382E1016E21C405A}] [robots ;; #t (the default) => no-op file, good to avoid error-log lines - ,(let ([t (if (eq? #t robots.txt) "User-agent: *\nDisallow:" robots.txt)]) - (and t (writefile "robots.txt" t)))])) + ,(let* ([t (if (eq? #t robots) "Disallow:" robots)] + [t (and t (list "User-agent: *\n" t))]) + (and t (writefile "robots.txt" t)))] + ;; Seems like there are still some clients that look for a favicon.ico file + [favicon ,(copyfile "plticon.ico" "favicon.ico")] + [404 + @,page['page-not-found]{ + @h1[style: '("text-align: center; margin: 3em 0 1em 0;")]{ + Page not found} + @(λ xs (table align: 'center (tr (td (pre xs))))){ + > (@a[href: "/"]{uncaught-exception-handler} + (*(+(*)(*(+(*)(*)(*)(*)(*))(+(*)(*)(*)(*)(*))(+(*)(*)(*)(*))))@; + (+(*)(*)(*)(*)))) + uncaught exception: 404}}] + ;; set the 404 page in htaccess instead of in the conf file, so we get it + ;; only in sites that we generate here + [.htaccess + ,(let* ([t (and htaccess "ErrorDocument 404 /page-not-found.html")] + [t (if (boolean? htaccess) t (list htaccess "\n" t))]) + (and t (writefile ".htaccess" t)))])) (define page-sizes @list{ diff --git a/collects/meta/web/stubs/git.rkt b/collects/meta/web/stubs/git.rkt index 0e388eeecc..26c1fb6776 100644 --- a/collects/meta/web/stubs/git.rkt +++ b/collects/meta/web/stubs/git.rkt @@ -1,9 +1,8 @@ #lang meta/web (define-context "stubs/git" - #:robots.txt @list{User-agent: * - @(add-newlines (for/list ([d '(plt libs testing play)]) - @list{Disallow: /@|d|/}))}) + #:robots (add-newlines (for/list ([d '(plt libs testing play)]) + @list{Disallow: /@|d|/}))) (provide git) (define git