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,48 +55,53 @@
                 "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"
+        tell application "Finder"
-	  -- look for a single disk with the mount point as its name
+          -- look for a single disk with the mount point as its name
-	  -- (maybe this works only on newer osx versions?)
+          -- (maybe this works only on newer osx versions?)
-	  set myDisks to every disk
+          set theDMGDisk to ""
-	  set theDMGDisk to ""
+          repeat while theDMGDisk = ""
-	  repeat with d in myDisks
+            set myDisks to every disk
-	    if name of d = "@mnt-name"
+            repeat with d in myDisks
-	      if theDMGDisk = ""
+              if name of d = "@mnt-name"
-	        set theDMGDisk to d
+                if theDMGDisk = ""
-	      else
+                  set theDMGDisk to d
-	        error "Too many attached DMGs found!"
+                else
-	      end if
+                  error "Too many attached DMGs found!"
-	    end if
+                end if
-	  end repeat
+              end if
-	  if theDMGDisk = "" then error "Attached DMG not found!"
+            end repeat
-	  -- found a single matching disk, continue
+            -- not found? maybe Finder wasn't ready
-	  tell theDMGDisk
+            if theDMGDisk = "" then delay 1
-	    open
+          end repeat
-	    set current view of container window to icon view
+          if theDMGDisk = "" then error "Attached DMG not found!"
-	    set toolbar visible of container window to false
+          -- found a single matching disk, continue
-	    set statusbar visible of container window to false
+          tell theDMGDisk
-	    set bounds of container window to {320, 160, 1000, 540}
+            open
-	    set theViewOptions to the icon view options of container window
+            set current view of container window to icon view
-	    set arrangement of theViewOptions to not arranged
+            set toolbar visible of container window to false
-	    set icon size of theViewOptions to 128
+            set statusbar visible of container window to false
-	    set text size of theViewOptions to 16
+            set bounds of container window to {320, 160, 1000, 540}
-	    set background picture of theViewOptions to file "@bg"
+            set theViewOptions to the icon view options of container window
-	    make new alias file at container window to POSIX file "/Applications" with properties {name:"Applications"}
+            set arrangement of theViewOptions to not arranged
-	    set position of item "@volname" of container window to {170, 180}
+            set icon size of theViewOptions to 128
-	    set position of item "@bg" of container window to {900, 180}
+            set text size of theViewOptions to 16
-	    set position of item "Applications" of container window to {500, 180}
+            set background picture of theViewOptions to file "@bg"
-	    set name of file "@bg" to ".@bg"
+            make new alias file at container window to POSIX file "/Applications" with properties {name:"Applications"}
-	    close
+            set position of item "@volname" of container window to {170, 180}
-	    open
+            set position of item "@bg" of container window to {900, 180}
-	    update without registering applications
+            set position of item "Applications" of container window to {500, 180}
-	    delay 5
+            set name of file "@bg" to ".@bg"
-	    close
+            close
-	  end tell
+            open
-	end tell
+            update without registering applications
+            delay 5
+            close
+          end tell
+        end tell
      })
   (printf "~a\n" script)
   (parameterize ([current-input-port (open-input-string script)])

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)))