add distro-builds/manage-snapshots

INSTALL.txt

@@ -212,6 +212,57 @@ for the client in the site configuration, and <ext> is
 platform-specific: ".sh" for Unix, ".dmg" for Mac Os X, and ".exe" for
 Windows.
 
+Generating Installer Web Sites
+------------------------------
+
+The `site' target of the makefile uses the `installers' target to
+generate a set of installers, and then it combines the installers,
+packages, and a package catalog into a directory that is suitable for
+access via a web server.
+
+Supply the same `CONFIG=...' and `CONFIG_MODE=...' arguments for
+`site' as for `installers'. The configuration file should have a
+`#:dist-base-url' entry for the URL where installers and packages will
+be made available; the `installers' target uses `#:dist-base-url' to
+embed suitable configuration into the installers. Specifically,
+installers are configured to access pre-built packages and
+documentation from the site indicated by `#:dist-base-url'.
+
+Note that `#:dist-base-url' should almost always end with "/", since
+others URLs will be constructed as relative to `#:dist-base-url'.
+
+The site is generated as "build/site" but default. A `#:site-dest'
+entry in the configuration file can select an alternate destination.
+
+Use the `site-from-installers' makefile target to perform the part of
+`site' that happens after `installers' (i.e., to generate a `site'
+from an already-generated set of installers).
+
+Managing Snapshot Web Sites
+---------------------------
+
+The `snapshot-site' makefile target uses `site' (so supply the same
+`CONFIG=...' and `CONFIG_MODE=...' arguments), and then treats the
+resulting site as a snapshot with additional snapshot-management
+tasks.
+
+For snapshot management, the destination of the files generated for
+`site' (as specified by `#:site-dest') should be within a directory of
+snapshots. The configuration file can use `(current-stamp)' to get a
+string that represents the current build, and then use the string both
+for `#:dist-base-url' and `#:site-dest'. Normally, the stamp string is
+a combination of the date and git commit hash.
+
+Snapshot management includes creating an "index.html" file in the
+snapshots directory (essentially a copy of the snapshot's own
+"index.html") and pruning snapshot subdirectories to keep the number
+of snapshots at the amount specified by `#:max-snapshots'
+configuration-file entry (with a default value of 5).
+
+Use the `snapshot-at-site' makefile target to perform the part of
+`snapshot-site that happens after `site (i.e., to manage snapshots
+around an already-generated site).
+
 Separate Server and Clients
 ---------------------------
 

Makefile

@@ -11,11 +11,15 @@
 #
 #  core = build in "racket" only (i.e., first step of `in-place')
 #
-#  server = build core, build packages listed in $(PKGS), start 
-#           server at port 9440
+#  server = build core, build packages listed in $(PKGS) or specified
+#           via $(CONFIG), start server at port 9440
 #
 #  client = build core, create an installer with $(PKGS) with the help
 #           of $(SERVER); result is recorded in "bundle/installer.txt"
+#
+#  installers = `server' plus `client' via $(CONFIG)
+
+DEFAULT_PKGS = main-distribution plt-services
 
 # ------------------------------------------------------------
 # In-place build
@@ -74,7 +78,6 @@ racket/src/build/Makefile: racket/src/configure racket/src/Makefile.in
 # side of its definition.
 
 # Packages (separated by spaces) to include in a distribution:
-DEFAULT_PKGS = main-distribution plt-services
 PKGS = $(DEFAULT_PKGS)
 
 # Catalog for sources and native packages; use "local" to bootstrap
@@ -380,11 +383,12 @@ site:
 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)
+# ------------------------------------------------------------
+# Create a snapshot site:
+
+snapshot-site:
+	$(MAKE) site
+	$(MAKE) snapshot-at-site
+
+snapshot-at-site:
+	$(RACKET) -l- distro-build/manage-snapshots $(CONFIG_MODE_q)

pkgs/distro-build/config.rkt

@@ -164,8 +164,11 @@
 ;;                         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"
+;;   #:site-dest <path-string> --- destination for completed build, used
+;;                                 by the `site' makefile target; the
+;;                                 default is "build/site"
+;;   #:max-snapshots <number> --- number of snapshots to keep, used by
+;;                                the `snapshot-site' makefile target
 ;;
 ;; Machine-only keywords:
 ;;
@@ -217,6 +220,10 @@
 ;;   `CONFIG_MODE' variable. The default mode is "default". The
 ;;   interpretation of modes is completely up to the
 ;;   site configuration file.
+;;
+;;  (current-stamp) -> string?
+;;   Returns a string to identifiy the current build, normally a
+;;   combination of the date and a git commit hash.
 
 ;; ----------------------------------------
 
@@ -357,6 +364,7 @@
     [(#:clean?) (boolean? val)]
     [(#:pull?) (boolean? val)]
     [(#:site-dest) (path-string? val)]
+    [(#:max-snapshots) (real? val)]
     [else 'bad-keyword]))
 
 (define (check-machine-keyword kw val)

pkgs/distro-build/download-page.rkt

@@ -38,7 +38,8 @@
                             #:dest [dest "index.html"]
                             #:installers-url [installers-url "./"]
                             #:title [title "Racket Downloads"]
-                            #:git-clone [git-clone #f])
+                            #:git-clone [git-clone #f]
+                            #:post-content [post-content null])
 
   (define table (call-with-input-file table-file read))
 
@@ -94,6 +95,7 @@
                    `((p
                       (div (span ([class "detail"]) "Repository: " (span ([class "path"]) ,origin)))
                       (div (span ([class "detail"]) "Commit: " (span ([class "checksum"]) ,stamp))))))
-                 null)))
+                 null)
+           ,@post-content))
         o)
        (void)))))

pkgs/distro-build/manage-snapshots.rkt

@@ -0,0 +1,52 @@
+#lang racket/base
+(require racket/cmdline
+         racket/file
+         net/url
+         "download-page.rkt"
+         (only-in "config.rkt" extract-options))
+
+(define build-dir (build-path "build"))
+(define installers-dir (build-path "installers"))
+
+(define-values (config-file config-mode)
+  (command-line
+   #:args
+   (config-file config-mode)
+   (values config-file config-mode)))
+
+(define config (extract-options config-file config-mode))
+
+(define site-dir (hash-ref config
+                           '#:site-dest
+                           (build-path build-dir "site")))
+
+(define current-snapshot
+  (let-values ([(base name dir?) (split-path site-dir)])
+    (path-element->string name)))
+
+(define snapshots-dir (build-path site-dir 'up))
+
+(define snapshots (for/list ([p (in-list (directory-list snapshots-dir))]
+                             #:when (directory-exists? (build-path snapshots-dir p)))
+                    (path-element->string p)))
+
+(define n (hash-ref config '#:max-snapshots 5))
+(when (n . < . (length snapshots))
+  (define remove-snapshots (remove
+                            current-snapshot
+                            (list-tail (sort snapshots string>?) n)))
+  (for ([s (in-list remove-snapshots)])
+    (printf "Removing snapshot ~a\n" s)
+    (delete-directory/files (build-path snapshots-dir s))))
+
+(make-download-page (build-path site-dir
+                                installers-dir
+                                "table.rktd")
+                    #:installers-url (string-append current-snapshot "/installers/")
+                    #:dest (build-path snapshots-dir
+                                       "index.html")
+                    #:git-clone (current-directory)
+                    #:post-content `((p "Snapshot ID: " 
+                                        (a ((href ,(string-append current-snapshot
+                                                                  "/index.html")))
+                                           ,current-snapshot))))