diff --git a/Makefile b/Makefile index 5f4956727f..5f415d080a 100644 --- a/Makefile +++ b/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) diff --git a/pkgs/distro-build/assemble-site.rkt b/pkgs/distro-build/assemble-site.rkt index 9b31754292..5273679472 100644 --- a/pkgs/distro-build/assemble-site.rkt +++ b/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)) diff --git a/pkgs/distro-build/config.rkt b/pkgs/distro-build/config.rkt index dee5b9a3f5..d147186338 100644 --- a/pkgs/distro-build/config.rkt +++ b/pkgs/distro-build/config.rkt @@ -164,6 +164,8 @@ ;; machine starts by a `git pull' in ; set ;; to #f, for example, for a repo checkout that is ;; shared with server; the default is #t +;; #:site-dest --- 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) diff --git a/pkgs/distro-build/download-page.rkt b/pkgs/distro-build/download-page.rkt index 7078750509..023f422739 100644 --- a/pkgs/distro-build/download-page.rkt +++ b/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"] diff --git a/pkgs/distro-build/installer-dmg.rkt b/pkgs/distro-build/installer-dmg.rkt index 5a656f88dc..4657b9d372 100644 --- a/pkgs/distro-build/installer-dmg.rkt +++ b/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" - -- 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 with d in myDisks - if name of d = "@mnt-name" - if theDMGDisk = "" - set theDMGDisk to d - else - error "Too many attached DMGs found!" - end if - end if - end repeat - if theDMGDisk = "" then error "Attached DMG not found!" - -- found a single matching disk, continue - tell theDMGDisk - open - set current view of container window to icon view - set toolbar visible of container window to false - set statusbar visible of container window to false - set bounds of container window to {320, 160, 1000, 540} - set theViewOptions to the icon view options of container window - set arrangement of theViewOptions to not arranged - set icon size of theViewOptions to 128 - set text size of theViewOptions to 16 - set background picture of theViewOptions to file "@bg" - make new alias file at container window to POSIX file "/Applications" with properties {name:"Applications"} - set position of item "@volname" of container window to {170, 180} - set position of item "@bg" of container window to {900, 180} - set position of item "Applications" of container window to {500, 180} - set name of file "@bg" to ".@bg" - close - open - update without registering applications - delay 5 - close - end tell - end tell + tell application "Finder" + -- look for a single disk with the mount point as its name + -- (maybe this works only on newer osx versions?) + set theDMGDisk to "" + repeat while theDMGDisk = "" + set myDisks to every disk + repeat with d in myDisks + if name of d = "@mnt-name" + if theDMGDisk = "" + set theDMGDisk to d + else + error "Too many attached DMGs found!" + 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 + open + set current view of container window to icon view + set toolbar visible of container window to false + set statusbar visible of container window to false + set bounds of container window to {320, 160, 1000, 540} + set theViewOptions to the icon view options of container window + set arrangement of theViewOptions to not arranged + set icon size of theViewOptions to 128 + set text size of theViewOptions to 16 + set background picture of theViewOptions to file "@bg" + make new alias file at container window to POSIX file "/Applications" with properties {name:"Applications"} + set position of item "@volname" of container window to {170, 180} + set position of item "@bg" of container window to {900, 180} + set position of item "Applications" of container window to {500, 180} + set name of file "@bg" to ".@bg" + close + open + update without registering applications + delay 5 + close + end tell + end tell }) (printf "~a\n" script) (parameterize ([current-input-port (open-input-string script)]) diff --git a/pkgs/distro-build/stamp.rkt b/pkgs/distro-build/stamp.rkt deleted file mode 100644 index 3f08641e62..0000000000 --- a/pkgs/distro-build/stamp.rkt +++ /dev/null @@ -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)))