add `site' makefile target

Also, adjust stamp handling to ensure that it doesn't change
during the build process.

Makefile

@@ -169,8 +169,16 @@ win32-pkg-links:
 
 server:
 	$(MAKE) core
+	$(MAKE) stamp
 	$(MAKE) server-from-core
 
+stamp:
+	if [ -d ".git" ] ; then $(MAKE) stamp-from-git ; else $(MAKE) stamp-from-date ; fi
+stamp-from-git:
+	echo `date +"%Y%m%d"`-`git log -1 --pretty=format:%h` > build/stamp.txt
+stamp-from-date:
+	date +"%Y%m%d" > build/stamp.txt
+
 server-from-core:
 	if [ "$(EEAPP)" = '' ] ; then $(MAKE) build-from-local ; else $(MAKE) build-from-catalog ; fi
 	$(MAKE) origin-collects
@@ -357,3 +365,22 @@ installers-from-built:
 # Just the clients, assuming server is already running:
 drive-clients:
 	$(DRIVE_CMD)
+
+# ------------------------------------------------------------
+# Create installers, then assemble as a web site:
+
+site:
+	$(MAKE) installers
+	$(MAKE) site-from-installers
+
+site-from-installers:
+	$(RACKET) -l- distro-build/assemble-site $(CONFIG_MODE_q)
+
+# Make an extra installers page:
+PAGE_DEST = build/index.html
+INSTALLERS_URL = site/
+DOWNLOAD_PAGE_ARGS = --dest $(PAGE_DEST) \
+                     --at "$(INSTALLERS_URL)" \
+                     build/installers/table.rktd
+site-page:
+	$(RACKET) -l- distro-build/download-page $(DOWNLOAD_PAGE_ARGS)

pkgs/distro-build/assemble-site.rkt

@@ -6,7 +6,6 @@
          (only-in "config.rkt" extract-options))
 
 (define build-dir (build-path "build"))
-(define dest-dir (build-path build-dir "site"))
 
 (define built-dir (build-path build-dir "built"))
 (define native-dir (build-path build-dir "native"))
@@ -23,6 +22,12 @@
 
 (define config (extract-options config-file config-mode))
 
+(define dest-dir (hash-ref config
+                           '#:site-dest
+                           (build-path build-dir "site")))
+
+(printf "Assembling site as ~a\n" dest-dir)
+
 (define (copy dir [build-dir build-dir])
   (make-directory* dest-dir)
   (printf "Copying ~a\n" (build-path build-dir dir))

pkgs/distro-build/config.rkt

@@ -164,6 +164,8 @@
 ;;                         machine starts by a `git pull' in <dir>; set
 ;;                         to #f, for example, for a repo checkout that is
 ;;                         shared with server; the default is #t
+;;   #:site-dest <path-string> --- destination for completed build; the default
+;;                                 is "build/site"
 ;;
 ;; Machine-only keywords:
 ;;
@@ -233,6 +235,7 @@
          site-config-options
          site-config-content
          current-mode
+         current-stamp
          extract-options)
 
 (module reader syntax/module-reader
@@ -353,6 +356,7 @@
     [(#:repo) (string? val)]
     [(#:clean?) (boolean? val)]
     [(#:pull?) (boolean? val)]
+    [(#:site-dest) (path-string? val)]
     [else 'bad-keyword]))
 
 (define (check-machine-keyword kw val)
@@ -368,6 +372,15 @@
 
 (define current-mode (make-parameter "default"))
 
+(define current-stamp
+  (let* ([f (build-path "build" "stamp.txt")]
+         [s (and (file-exists? f)
+                 (call-with-input-file* f read-line))])
+    (lambda ()
+      (if (string? s)
+          s
+          "now"))))
+
 (define (extract-options config-file config-mode)
   (or
    (and (file-exists? config-file)

pkgs/distro-build/download-page.rkt

@@ -32,7 +32,7 @@
     (keyword-apply make-download-page
                    (map car args)
                    (map cdr args)
-                   table-file)))
+                   (list table-file))))
 
 (define (make-download-page table-file
                             #:dest [dest "index.html"]

pkgs/distro-build/installer-dmg.rkt

@@ -55,14 +55,16 @@
                 "attach" "-readwrite" "-noverify" "-noautoopen"
                 "-mountpoint" mnt dmg)
   (define mnt-name (let-values ([(base name dir?) (split-path mnt)]) (path->string name)))
-  ;; see also https://github.com/andreyvit/yoursway-create-dmg
+  ;; See also https://github.com/andreyvit/yoursway-create-dmg
+  ;; First, give Finder a chance to see the new disk:
   (define script
     @~a{
         tell application "Finder"
           -- look for a single disk with the mount point as its name
           -- (maybe this works only on newer osx versions?)
-	  set myDisks to every disk
           set theDMGDisk to ""
+          repeat while theDMGDisk = ""
+            set myDisks to every disk
             repeat with d in myDisks
               if name of d = "@mnt-name"
                 if theDMGDisk = ""
@@ -72,6 +74,9 @@
                 end if
               end if
             end repeat
+            -- not found? maybe Finder wasn't ready
+            if theDMGDisk = "" then delay 1
+          end repeat
           if theDMGDisk = "" then error "Attached DMG not found!"
           -- found a single matching disk, continue
           tell theDMGDisk

pkgs/distro-build/stamp.rkt

@@ -1,27 +0,0 @@
-#lang racket/base
-(require racket/system
-         racket/format)
-
-(provide get-date-stamp
-         get-commit-stamp
-         get-date+commit-stamp)
-
-(define (get-commit-stamp)
-  (define git (or (find-executable-path "git")
-                  (find-executable-path "git.exe")))
-  (define s (open-output-string))
-  (parameterize ([current-output-port s]
-                 [current-input-port (open-input-string "")])
-    (system* git "log" "-1" "--pretty=format:%h"))
-  (define commit-id (get-output-string s))
-  commit-id)
-
-(define (get-date-stamp)
-  (define d (seconds->date (current-seconds)))
-  (define (n n) (~a n #:align 'right #:pad-string "0" #:width 2))
-  (~a (date-year d) (n (date-month d)) (n (date-day d))))
-
-(define (get-date+commit-stamp)
-  (~a (get-date-stamp)
-      "-"
-      (get-commit-stamp)))