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