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

@@ -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)
+             (~optional (~seq #:robots robots) #:defaults ([robots #'#t]))
-                        #:defaults ([robots.txt #'#t])))
+             (~optional (~seq #:htaccess htaccess) #:defaults ([htaccess #'#t])))
         ...)
      (unless (attribute dir)
        (raise-syntax-error 'define-context "missing <dir>"))
@@ -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)
+       (with-syntax ([provides   (if provide?
-                                     #'(make-resources (make-resource-files
-                                                        dir robots.txt)))]
-                     [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))

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)
+;; robots is passed as #:robots in define-context, and htaccess as #:htaccess;
-  (define (copyfile file)
+;; they can be #t (the default) for the standard ones, or some text that gets
-    (copyfile-resource (in-here file) (web-path dir file)))
+;; 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 @@
        <users><user>140BE58EEC31CB97382E1016E21C405A</user></users>}]
     [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)])
+     ,(let* ([t (if (eq? #t robots) "Disallow:" robots)]
-        (and t (writefile "robots.txt" t)))]))
+             [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{

collects/meta/web/stubs/git.rkt

@@ -1,9 +1,8 @@
 #lang meta/web
 
 (define-context "stubs/git"
-  #:robots.txt @list{User-agent: *
+  #:robots (add-newlines (for/list ([d '(plt libs testing play)])
-                     @(add-newlines (for/list ([d '(plt libs testing play)])
+                           @list{Disallow: /@|d|/})))
-                                      @list{Disallow: /@|d|/}))})
 
 (provide git)
 (define git