change farm-configuration file to a module

Also, improve connection between installers and farm-configuration
entries, and improve configuration of installer name versus
target-install directory.

INSTALL.txt

@@ -161,38 +161,43 @@ machines that implement clients.
 
 See
 
-  pkgs/distro-build/drive-clients.rkt
+  pkgs/distro-build/farm.rkt
 
-for a description of the farm-configuration file and requirements on
+for a description of the farm-configuration module and requirements on
 client hosts.
 
-If "my-farm-config.rktd" is a configuration file, then
+If "my-farm-config.rkt" is a configuration module, then
 
- make farm FARM_CONFIG=my-farm-config.rktd PKGS="..."
+ make farm FARM_CONFIG=my-farm-config.rkt PKGS="..."
 
 drives the build farm, and the resulting installers are in
-"build/installers".
+"build/installers", with a hash table mapping descriptions to
+installer filenames in "build/installer/table.rktd".
 
-The default FARM_CONFIG path is "build/farm-config.rktd", so you could
+The default FARM_CONFIG path is "build/farm-config.rkt", so you could
 put your configuration file there and omit the `FARM_CONFIG' argument
 to `make'. Similarly, you can omit `PKGS' to use the default specified
-in the Makefile.
+in the Makefile. Supply `FARM_MODE="..."' to pass a configuration mode
+on to your farm-configuration module (accessible via the
+`current-mode' parameter). Supply `CLEAN_MODE="--clean"' to make the
+default `#:clean?' configration for a client #t instead of #f.
 
 A configuration file can specify the packages to include, host address
-of the server, distribution name, and installer directory, but default
+of the server, distribution name, and installer directory, but defaults
-can be provided as `make' arguments via `PKGS', `SERVER', `DIST_NAME'
+can be provided as `make' arguments via `PKGS', `SERVER', `DIST_NAME',
-and `DIST_DIR', respectively. Note that a sets of packages specified
+`DIST_BASE', and `DIST_DIR', respectively. Note that a sets of
-in a configure file affects the clients, but it does not affect the
+packages specified in a configure file affects the clients, but it
-packages prepared by the server; only `PKGS' affects the server (and
+does not affect the packages prepared by the server; only `PKGS'
-the client's packages must be a subset of the server's packages).
+affects the server (and the client's packages must be a subset of the
+server's packages).
 
 For each installer written to "build/installers", the installer's name
 is
 
- <dist-name>-<version>-<platform>-<dist-suffix>.<ext>
+ <dist-base>-<version>-<platform>-<dist-suffix>.<ext>
 
-where <dist-name> defaults to "racket" (but can be set via
+where <dist-base> defaults to "racket" (but can be set via
-`DIST_NAME'), <platform> is from `(system-library-subpath #f)' but
+`DIST_BASE'), <platform> is from `(system-library-subpath #f)' but
 normalizing the Windows results to "i386-win32" and "x86_63-win32",
 -<dist-suffix> is omitted unless a `#:dist-suffix' string is specified
 for the client in the farm configuration, and <ext> is
@@ -221,14 +226,21 @@ Roughly, the steps are
     Add `DIST_NAME="..."' to the `client' line to give an installer a
     different human-readable distribution name, instead of "Racket".
 
+    Add `DIST_BASE="..."' to the `client' line to adjust the installer
+    name's prefix, instead of starting with "racket".
+
     Add `DIST_DIR="..."' to the `client' line to make the installer
-    use a different directory name on installation, instead of
+    use a different directory name on installation on Unix, instead of
     "racket".
 
     Add `DIST_SUFFIX="..."' to the `client' line to add a suffix
     string for the installer's name, such as an identifier for a
     particular variant of Linux.
 
+    Add `DIST_DESC="..."' to the `client' line to set the installer's
+    description, which is used as a key in the generated table of
+    installer files.
+
 In more detail:
 
  1a. Build "racket" on a server.
@@ -287,16 +299,24 @@ In more detail:
      distribution name is "Racket". Whatever name you pick, the Racket
      version number is automatically added for various contexts.
 
-     To change the directory name for Unix installation, as well as
+     To change the base name of the installer file, provide `DIST_BASE
-     the base name of the installer file for all platforms, provide
+     to `make'. The default is "racket".
+
+     To change the directory name for Unix installation, provide
      `DIST_DIR' to `make'. The default is "racket".
 
      To add an extra piece to the installer's name, such as an
-     identifier for a variant of Linux, provide `DIST_SUFFIX to
+     identifier for a variant of Linux, provide `DIST_SUFFIX' to
      `make'. The default is "", which omits the prefix and its
      preceding hyphen.
 
+     To set the description string for the installer, provide
+     `DIST_DESC' to `make'. The description string is recorded
+     alongside the installer.
+
 On each client, step 2b produces a "bundle/installer.txt" file that
-contains the path to the generated installer, but the installer is
+contains the path to the generated installer on one line, followed by
-also uploaded to the server, which leaves the installer in a
+the description on a second line. The installer is also uploaded to
-"build/installers" directory.
+the server, which leaves the installer in a "build/installers"
+directory and records a mapping from the installer's description to
+its filename in "build/installers/table.rktd".

Makefile

@@ -81,19 +81,28 @@ SERVER = localhost
 # snapshot installers):
 RELEASE_MODE =
 
-# Human-readable name and installation-directory name for the
+# Human-readable name, installation name base, and installation
-# generated installers:
+# directory name (Unix) for the generated installers:
 DIST_NAME = Racket
+DIST_BASE = racket
 DIST_DIR = racket
 # An extra suffix for the installer name, usually used to specify
-# a variant of an OS
+# a variant of an OS:
 DIST_SUFFIX = 
+# A human-readable description of the generated installer, usually
+# describing a platform:
+DIST_DESC =
 
-# Configuration of clients to run for a build farm:
+# Configuration of clients to run for a build farm, normally
-FARM_CONFIG = build/farm-config.rktd
+# implemented with `#lang distro-build/farm':
+FARM_CONFIG = build/farm-config.rkt
+
+# A mode that is made available to the farm-configuration module
+# through the `current-mode' parameter:
+FARM_MODE = default
 
 # Set to "--clean" to flush client directories in a build farm
-# (except as overriding in the `FARM_CONFIG' file):
+# (except as overridden in the `FARM_CONFIG' module):
 CLEAN_MODE =
 
 # A command to run after the server has started; normally set by
@@ -238,7 +247,10 @@ client:
 	$(MAKE) bundle-from-server
 	$(MAKE) installer-from-bundle
 
-COPY_ARGS = SERVER=$(SERVER) PKGS="$(PKGS)" RELEASE_MODE=$(RELEASE_MODE) DIST_NAME="$(DIST_NAME)" DIST_DIR=$(DIST_DIR) DIST_SUFFIX=$(DIST_SUFFIX)
+COPY_ARGS = SERVER=$(SERVER) PKGS="$(PKGS)" RELEASE_MODE=$(RELEASE_MODE) \
+            DIST_NAME="$(DIST_NAME)" DIST_BASE=$(DIST_BASE) \
+            DIST_DIR=$(DIST_DIR) DIST_SUFFIX=$(DIST_SUFFIX) \
+            DIST_DESC="$(DIST_DESC)"
 
 win32-client:
 	IF EXIST build\user cmd /c rmdir /S /Q build\user
@@ -263,12 +275,13 @@ bundle-from-server:
 	$(RACKET) -l distro-build/unpack-collects http://$(SERVER):9440/
 	bundle/racket/bin/raco pkg install $(REMOTE_INST_AUTO) $(PKGS) $(REQUIRED_PKGS)
 
-UPLOAD = --upload http://$(SERVER):9440/
+UPLOAD = --upload http://$(SERVER):9440/ --desc "$(DIST_DESC)"
+DIST_ARGS = $(UPLOAD) $(RELEASE_MODE) "$(DIST_NAME)" $(DIST_BASE) $(DIST_DIR) "$(DIST_SUFFIX)"
 
 # Create an installer from the build (with installed packages) that's
 # in "bundle/racket":
 installer-from-bundle:
-	$(RACKET) -l- distro-build/installer $(UPLOAD) $(RELEASE_MODE) "$(DIST_NAME)" $(DIST_DIR) "$(DIST_SUFFIX)"
+	$(RACKET) -l- distro-build/installer $(DIST_ARGS)
 
 win32-distro-build-from-server:
 	$(WIN32_RACO) pkg install $(REMOTE_USER_AUTO) distro-build
@@ -287,12 +300,12 @@ win32-bundle-from-server:
 	bundle\racket\raco pkg install $(REMOTE_INST_AUTO) $(PKGS)
 
 win32-installer-from-bundle:
-	$(WIN32_RACKET) -l- distro-build/installer $(UPLOAD) $(RELEASE_MODE) "$(DIST_NAME)" $(DIST_DIR) "$(DIST_SUFFIX)"
+	$(WIN32_RACKET) -l- distro-build/installer $(DIST_ARGS)
 
 # ------------------------------------------------------------
 # Drive installer build:
 
-DRIVE_ARGS = $(RELEASE_MODE) $(CLEAN_MODE) "$(FARM_CONFIG)" $(SERVER) "$(PKGS)" "$(DIST_NAME)" $(DIST_DIR)
+DRIVE_ARGS = $(RELEASE_MODE) $(CLEAN_MODE) "$(FARM_CONFIG)" "$(FARM_MODE)" $(SERVER) "$(PKGS)" "$(DIST_NAME)" $(DIST_BASE) $(DIST_DIR)
 DRIVE_CMD = $(RACKET) -l- distro-build/drive-clients $(DRIVE_ARGS)
 
 # Full server build and clients drive, based on `FARM_CONFIG':

pkgs/distro-build/drive-clients.rkt

@@ -1,245 +1,57 @@
 #lang racket/base
-
-;; Each client is built by running commands via `ssh', where the
-;; client's host (and optional port and/or user) indicate the ssh
-;; target. Each client machine must be set up with a public-key
-;; authenticaion, because a direct `ssh' is expected to work without a
-;; password prompt.
-;;
-;; On the client machine, all work is performed with a git clone at a
-;; specified directory that defaults to "build/plt" (Unix, Mac OS X)
-;; or "build\\plt" (Windows).
-;;
-;; If a build fails for a machine, building continues on other
-;; machines.  Success for a given machine means that its installer
-;; ends up in "build/installers" (and failure for a machine means no
-;; installer).
-;; 
-;; Machine Requirements
-;; --------------------
-;;
-;; Each Unix or Mac OS X client needs the following available:
-;;
-;;   * ssh server with public-key authentication
-;;   * git
-;;   * gcc, make, etc.
-;;
-;; Each Windows client needs the following:
-;;
-;;   * git
-;;   * Microsoft Visual Studio 9.0 (2008), installed in the
-;;     default folder:
-;;      C:\Program Files\Microsoft Visual Studio 9.0       (32-bit host)
-;;      C:\Program Files (x86)\Microsoft Visual Studio 9.0 (64-bit host)
-;;   * Nullsoft Scriptable Install System (NSIS), installed in the
-;;     default folder:
-;;      C:\Program Files\NSIS\makensis.exe
-;;      or  C:\Program Files (x86)\NSIS\makensis.exe
-;;     or instaled so that `makensis' in in yur PATH.
-;;
-;; Farm Configuration
-;; -------------------
-;;
-;; A farm configuration file is `read' to obtain a configuration. The
-;; file must have a single S-expression that matches the <config>
-;; grammar:
-;; 
-;;    <config> = (machine <keyword> <val> ... ...)
-;;             | (<group-kind> <keyword> <val> ... ... <config> ...)
-;; 
-;;    <group-kind> = parallel | sequential
-;;
-;; Normally, a configuration file start with "(<group-kind> ...)", since
-;; the configuration otherwise specifies only one client machine.
-;;
-;; A `<keyword> <val> ... ...' sequence specifies options as
-;; keyword--value pairs. The available options are listed below. The
-;; options of a group are propagated to all machines in the group,
-;; except at overridden at a machine or nested group.
-;;
-;; A <group-kind> specifies whether the machines within a group are
-;; run sequentially or in parallel. Note that the default`#:max-vm'
-;; setting is 1, so a parallel configuration of virtual machines will
-;; fail (for some machines) unless `#:max-vm' is increased.
-;;
-;; Machine/group keywords (where <string*> means no spaces, etc.):
-;;
-;;   #:pkgs (<string*> ...) --- packages to install; defaults to
-;;                              the `pkgs' command-line argument
-;;   #:server <string*> --- the address of the server from the client;
-;;                          defaults to `server' command-line argument
-;;   #:dist-name <string> --- the distribution name; defaults to the
-;;                            `dist-name' command-line argument
-;;   #:dist-dir <string*> --- the distribution's installation directory;
-;;                            defaults to `dist-dir' command-line argument
-;;   #:dist-suffix <string*> --- a suffix for the installer's name, usually
-;;                               used for an OS variant; defaults to ""
-;;   #:max-vm <real> --- max number of VMs allowed to run with this
-;;                       machine, counting the machine; defaults to 1
-;;   #:port <integer> --- ssh port for the client; defaults to 22
-;;   #:user <string*> --- ssh user for the client; defaults to current user
-;;   #:dir <string> --- defaults to "build/plt" or "build\\plt"
-;;   #:vbox <string> --- Virtual Box machine name; if provided the
-;;                       virtual machine is started and stopped as needed
-;;   #:platform <symbol> --- 'windows or 'unix, defaults to 'unix
-;;   #:configure (<string> ...) --- arguments to `configure'
-;;   #:bits <integer> --- 32 or 64, affects Visual Studio path
-;;   #:vc <string*> --- "x86" or "x64" to select the Visual C build mode;
-;;                     default depends on bits
-;;   #:j <integer> --- parallelism for `make' on Unix and Mac OS X;
-;;                     defaults to 1
-;;   #:timeout <number> --- numbers of seconds to wait before declaring
-;;                          failure; defaults to 30 minutes
-;;   #:repo <string> --- the git repository for Racket; defaults to
-;;                       "http://<server>:9440/.git"
-;;   #:clean? <boolean> --- override default cleaning mode
-;;
-;; Machine-only keywords:
-;;   #:name <string> --- defaults to host
-;;   #:host <string*> --- defaults to "localhost"
-
-;; ----------------------------------------
-
 (require racket/cmdline
          racket/system
          racket/port
          racket/format
          racket/file
-         racket/string)
+         racket/string
+         (only-in "farm.rkt"
+                  current-mode
+                  farm-config?
+                  farm-config-tag farm-config-options farm-config-content))
+
+;; See "farm.rkt" for an overview.
 
 ;; ----------------------------------------
 
 (define release? #f)
 (define default-clean? #f)
 
-(define-values (config-file default-server default-pkgs default-dist-name default-dist-dir)
+(define-values (config-file config-mode
+                            default-server default-pkgs 
+                            default-dist-name default-dist-base default-dist-dir)
   (command-line
    #:once-each
    [("--release") "Create release-mode installers"
     (set! release? #t)]
    [("--clean") "Erase client directories before building"
     (set! default-clean? #t)]
-   #:args (config-file server pkgs dist-name dist-dir)
+   #:args (config-file config-mode 
-   (values config-file server pkgs dist-name dist-dir)))
+                       server pkgs 
+                       dist-name dist-base dist-dir)
+   (values config-file config-mode 
+           server pkgs 
+           dist-name dist-base dist-dir)))
 
-(define config (call-with-input-file* config-file read))
+(define config (parameterize ([current-mode config-mode])
+                 (dynamic-require (path->complete-path config-file) 'farm-config)))
 
-;; ----------------------------------------
+(unless (farm-config? config)
-
+  (error 'drive-clients 
-(define (simple-string? s)
+         "configuration module did not provide a farm-configuration value: ~e"
-  (and (string? s)
+         config))
-       ;; No spaces, quotes, or other things that could
-       ;; break a command-line, path, or URL construction:
-       (regexp-match #rx"^[-a-zA-A0-9.]*$" s)))
-
-(define (check-group-keyword kw val)
-  (case kw
-    [(#:pkgs) (and (list? val) (andmap simple-string? val))]
-    [(#:dist-name) (string? val)]
-    [(#:dist-dir) (simple-string? val)]
-    [(#:dist-suffix) (simple-string? val)]
-    [(#:max-vm) (real? val)]
-    [(#:server) (simple-string? val)]
-    [(#:host) (simple-string? val)]
-    [(#:user) (simple-string? val)]
-    [(#:port) (and (exact-integer? val) (<= 1 val 65535))]
-    [(#:dir) (string? val)]
-    [(#:vbox) (string? val)]
-    [(#:platform) (memq val '(unix windows))]
-    [(#:configure) (and (list? val) (andmap string? val))]
-    [(#:bits) (or (equal? val 32) (equal? val 64))]
-    [(#:vc) (or (equal? val "x86") (equal? val "x64"))]
-    [(#:timeout) (real? val)]
-    [(#:j) (exact-positive-integer? val)]
-    [(#:repo) (string? val)]
-    [(#:clean?) (boolean? val)]
-    [else #f]))
-
-(define (check-machine-keyword kw val)
-  (case kw
-    [(#:name) (string? val)]
-    [else (check-group-keyword kw val)]))
-
-(define (check-config config)
-  (define (bad-format msg . rest)
-    (raise-user-error 'drive-clients
-                      "~a"
-                      (apply ~a "bad configuration"
-                             "\n " msg
-                             (if config-file
-                                 (~a "\n  config file: "
-                                     config-file)
-                                 "")
-                             rest)))
-  (unless (list? config)
-    (bad-format (if config-file
-                    "does not `read' as a list"
-                    "not a list")))
-  (let loop ([config config])
-    (unless (list? config)
-      (bad-format "not a list"
-                  (format "\n  given: ~e" config)))
-    (cond
-     [(and (pair? config)
-           (or (eq? 'parallel (car config))
-               (eq? 'sequential (car config))))
-      (let gloop ([group (cdr config)])
-        (cond
-         [(keyword? (car group))
-          (unless (pair? (cdr group))
-            (bad-format "missing value after group keyword"
-                        (format "\n  keyword: ~e" (car group))))
-          (unless (check-group-keyword (car group) (cadr group))
-            (bad-format "bad value for keyword in group"
-                        (format "\n  keyword: ~e\n  value: ~e"
-                                (car group)
-                                (cadr group))))
-          (gloop (cddr group))]
-         [else (for-each loop group)]))]
-     [(and (pair? config)
-           (eq? 'machine (car config)))
-      (let loop ([client (cdr config)])
-        (cond
-         [(null? client) (void)]
-         [(keyword? (car client))
-          (unless (pair? (cdr client))
-            (bad-format "machine spec missing value after keyword"
-                        (format "\n  keyword: ~e" (car client))))
-          (unless (check-machine-keyword (car client) (cadr client))
-            (bad-format "bad value for keyword in machine spec"
-                        (format "\n  keyword: ~e\n  value: ~e"
-                                (car client)
-                                (cadr client))))
-          (loop (cddr client))]
-         [else
-          (bad-format "bad machine spec; expected a keyword"
-                      (format "\n  found: ~e" (car client)))]))]
-     [else 
-      (bad-format "bad format (does not start with 'machine, 'parallel, or 'sequential)"
-                  (format "\n  found: ~e" config))])))
-
-(check-config config)
 
 ;; ----------------------------------------
 
 (define (merge-options opts c)
-  (let loop ([c (cdr c)] [opts opts])
+  (for/fold ([opts opts]) ([(k v) (in-hash (farm-config-options c))])
-    (cond
+    (hash-set opts k v)))
-     [(and (pair? c)
-           (keyword? (car c)))
-      (loop (cddr c)
-            (hash-set opts (car c) (cadr c)))]
-     [else opts])))
 
 (define (get-opt opts kw [default #f])
   (hash-ref opts kw default))
 
 (define (get-content c)
-  (let loop ([c (cdr c)])
+  (farm-config-content c))
-    (if (and (pair? c)
-             (keyword? (car c)))
-        (loop (cddr c))
-        c)))
 
 (define (client-name opts)
   (or (get-opt opts '#:name)
@@ -356,16 +168,18 @@
 (define (q s)
   (~a "\"" s "\""))
 
-(define (client-args server pkgs dist-name dist-dir dist-suffix)
+(define (client-args desc server pkgs dist-name dist-base dist-dir dist-suffix)
   (~a " SERVER=" server
       " PKGS=" (q pkgs)
+      " DIST_DESC=" (q desc)
       " DIST_NAME=" (q dist-name)
+      " DIST_BASE=" dist-base
       " DIST_DIR=" dist-dir
       " DIST_SUFFIX=" (q dist-suffix)
       " RELEASE_MODE=" (if release? "--release" (q ""))))
 
 (define (unix-build c host port user server repo clean?
-                    pkgs dist-name dist-dir dist-suffix)
+                    pkgs dist-name dist-base dist-dir dist-suffix)
   (define dir (or (get-opt c '#:dir)
                   "build/plt"))
   (define (sh . args) 
@@ -382,12 +196,14 @@
        "git pull")
    (sh "cd " (q dir) " ; "
        "make -j " j " client"
-       (client-args server pkgs dist-name dist-dir dist-suffix)
+       (client-args (client-name c)
+                    server pkgs 
+                    dist-name dist-base dist-dir dist-suffix)
        " CORE_CONFIGURE_ARGS=" (q (apply ~a #:separator " "
                                          (get-opt c '#:configure null))))))
 
 (define (windows-build c host port user server repo clean?
-                       pkgs dist-name dist-dir dist-suffix)
+                       pkgs dist-name dist-base dist-dir dist-suffix)
   (define dir (or (get-opt c '#:dir)
                   "build\\plt"))
   (define bits (or (get-opt c '#:bits) 64))
@@ -407,7 +223,10 @@
    (cmd "cd " (q dir)
         " && \"c:\\Program Files" (if (= bits 64) " (x86)" "") "\\Microsoft Visual Studio 9.0\\vc\\vcvarsall.bat\""
         " " vc
-        " && nmake win32-client" (client-args server pkgs dist-name dist-dir dist-suffix))))
+        " && nmake win32-client" 
+        (client-args (client-name c)
+                     server pkgs 
+                     dist-name dist-base dist-dir dist-suffix))))
 
 (define (client-build c)
   (define host (or (get-opt c '#:host)
@@ -421,6 +240,8 @@
                    default-pkgs))
   (define dist-name (or (get-opt c '#:dist-name)
                         default-dist-name))
+  (define dist-base (or (get-opt c '#:dist-base)
+                        default-dist-base))
   (define dist-dir (or (get-opt c '#:dist-dir)
                        default-dist-dir))
   (define dist-suffix (get-opt c '#:dist-suffix ""))
@@ -434,7 +255,7 @@
      [(unix) unix-build]
      [else windows-build])
    c host port user server repo clean?
-   pkgs dist-name dist-dir dist-suffix))
+   pkgs dist-name dist-base dist-dir dist-suffix))
 
 ;; ----------------------------------------
 
@@ -479,7 +300,7 @@
  (let loop ([config config]
             [mode 'sequential]
             [opts (hasheq)])
-   (case (car config)
+   (case (farm-config-tag config)
      [(parallel sequential)
       (define new-opts (merge-options opts config))
       (define ts

pkgs/distro-build/farm.rkt

@@ -0,0 +1,313 @@
+#lang racket/base
+
+;; A build farm is normally run via the `farm' target of the Racket
+;; repository's top-level makefile. That target, in turn, uses the
+;; `distro-build/drive-clients' module.
+;;
+;; Each client is built by running commands via `ssh', where the
+;; client's host (and optional port and/or user) indicate the ssh
+;; target. Each client machine must be set up with a public-key
+;; authenticaion, because a direct `ssh' is expected to work without a
+;; password prompt.
+;;
+;; On the client machine, all work is performed with a git clone at a
+;; specified directory. The directory defaults to "build/plt" (Unix,
+;; Mac OS X) or "build\\plt" (Windows). If the directory exists
+;; already on a client machine (and the machine is not configured for
+;; "clean" mode), then the directory is assumed to be a suitable git
+;; clone, and it is updated with `git pull'. Otherwise, a git
+;; repository is cloned; by default, the server is used as the source
+;; git repository (so that the server and client are in sync).
+;;
+;; If a build fails for a machine, building continues on other
+;; machines.  Success for a given machine means that its installer
+;; ends up in "build/installers" (and failure for a machine means no
+;; installer) as recorded in the "table.rktd" file.
+;; 
+;; Machine Requirements
+;; --------------------
+;;
+;; Each Unix or Mac OS X client needs the following available:
+;;
+;;   * ssh server with public-key authentication
+;;   * git
+;;   * gcc, make, etc.
+;;
+;; Each Windows client needs the following:
+;;
+;;   * git
+;;   * Microsoft Visual Studio 9.0 (2008), installed in the
+;;     default folder:
+;;      C:\Program Files\Microsoft Visual Studio 9.0       (32-bit host)
+;;      C:\Program Files (x86)\Microsoft Visual Studio 9.0 (64-bit host)
+;;   * Nullsoft Scriptable Install System (NSIS), installed in the
+;;     default folder:
+;;      C:\Program Files\NSIS\makensis.exe
+;;      or  C:\Program Files (x86)\NSIS\makensis.exe
+;;     or instaled so that `makensis' in in yur PATH.
+;;
+;; Farm Configuration
+;; -------------------
+;;
+;; A farm configuration module is normally wriiten in the
+;; `distro-build/farm' language. The configuration describes
+;; individual machines, and groups them with `parallel' or
+;; `sequential' to indicate whether the machine's builds should run
+;; sequentially or in parallel.  Options specified at `parallel' or
+;; `sequential' are propagated to eachmachine in the group.
+;;
+;; For example, a configuration module might look like this:
+;;
+;;     #lang distro-build/farm
+;;    
+;;     (sequential
+;;      #:server "192.168.56.1"
+;;      (machine
+;;       #:desc "Linux (32-bit, Precise Pangolin)"
+;;       #:name "Ubuntu 32"
+;;       #:vbox "Ubuntu 12.04"
+;;       #:host "192.168.56.102")
+;;      (machine
+;;       #:desc "Windows (64-bit)"
+;;       #:name "Windows 64"
+;;       #:vbox "Windows 7"
+;;       #:host "192.168.56.103"
+;;       #:port 2022
+;;       #:dir "c:\\Users\\mflatt\\build\\plt"
+;;       #:platform 'windows
+;;       #:bits 64))
+;;
+;;
+;; Farm-configuration keywords (where <string*> means no spaces, etc.):
+;;
+;;   #:host <string*> --- defaults to "localhost"
+;;   #:port <integer> --- ssh port for the client; defaults to 22
+;;   #:user <string*> --- ssh user for the client; defaults to current user
+;;   #:dir <string> --- defaults to "build/plt" or "build\\plt"
+;;   #:server <string*> --- the address of the server as accessed by the
+;;                          client; defaults to the `server' command-line
+;;                          argument
+;;   #:repo <string> --- the git repository for Racket; defaults to
+;;                       "http://<server>:9440/.git"
+;;   #:pkgs '(<string*> ...) --- packages to install; defaults to
+;;                              `PKGS' in the makfile (or, more genereally,
+;;                              the `pkgs' command-line argument to
+;;                              `distro-build/drive-clients')
+;;   #:dist-name <string> --- the distribution name; defaults to the
+;;                            `DIST_NAME' makefile variable or `dist-name'
+;;                            command-line argument
+;;   #:dist-base <string*> --- the distribution's installater name prefix;
+;;                             defaults to the `DIST_BASE' makefile variable
+;;                             or the `dist-base' command-line argument
+;;   #:dist-dir <string*> --- the distribution's installation directory;
+;;                            defaults to the `DIST_DIR' makefile variable
+;;                            or the `dist-dir' command-line argument
+;;   #:dist-suffix <string*> --- a suffix for the installer's name, usually
+;;                               used for an OS variant; defaults to the
+;;                               `DIST_SUFFIX' makefile variable or the
+;;                               `dist-suffix' command-line argument
+;;   #:max-vm <real> --- max number of VMs allowed to run with this
+;;                       machine, counting the machine; defaults to 1
+;;   #:vbox <string> --- Virtual Box machine name; if provided the
+;;                       virtual machine is started and stopped as needed
+;;   #:platform <symbol> --- 'windows or 'unix, defaults to 'unix
+;;   #:configure '(<string> ...) --- arguments to `configure'
+;;   #:bits <integer> --- 32 or 64, affects Visual Studio path
+;;   #:vc <string*> --- "x86" or "x64" to select the Visual C build mode;
+;;                     default depends on bits
+;;   #:j <integer> --- parallelism for `make' on Unix and Mac OS X;
+;;                     defaults to 1
+;;   #:timeout <number> --- numbers of seconds to wait before declaring
+;;                          failure; defaults to 30 minutes
+;;   #:clean? <boolean> --- if true, then the build process on the client
+;;                          machine starts by removing <dir>; the default
+;;                          is #f, but the `--clean' command-line flag
+;;                          changes the default to #t
+;;
+;; Machine-only keywords:
+;;   #:name <string> --- defaults to host; this string is recorded as
+;;                       a description of the installer (for use in a
+;;                       generated table of installer links, for example)
+;;
+;;
+;; More precisely, the `distro-build/farm' language is like
+;; `racket/base' except that the module body must have exactly one
+;; expression (plus any number of definitions, etc.) that produces a
+;; farm-configuration value. The value is exported as `farm-config'
+;; from the module. Any module can act as a farm-configuration module
+;; a long as it exports `farm-config' as a farm-configuration value.
+;;
+;; The `distro-build/farm' language also adds the following functions
+;; to `racket/base':
+;;
+;;  (machine <opt-kw> <opt-val> ... ...) -> farm-config?
+;;    Produces a farm configuration based on the given keyword-based
+;;    options. The support keyword arguments are described above.
+;;
+;;  (sequential <opt-kw> <opt-val> ... ... config ...)
+;;    -> farm-config?
+;;     config : farm-config?
+;;    Produces a farm configuration that runs each `config'
+;;    sequentially. The support keyword arguments are described above.
+;;
+;;  (parallel <opt-kw> <opt-val> ... ... config ...)
+;;    -> farm-config?
+;;     config : farm-config?
+;;    Produces a farm configuration that runs each `config' in
+;;    parallel. The support keyword arguments are described above.
+;;
+;;  (farm-config? v) -> boolean?
+;;  (farm-config-tag config) -> (or/c 'machine 'sequential 'parallel)
+;;     config : farm-config?
+;;  (farm-config-options config) -> (hash/c keyword? any/c)
+;;     config : farm-config?
+;;  (farm-config-content config) -> (listof farm-config?)
+;;     config : farm-config?
+;;   Farm configuation inspection
+;;
+;;  (current-mode) -> string?
+;;  (current-mode s) -> void?
+;;     s : string?
+;;   A parameter whose value is the user's requested mode for this
+;;   configuration. The default mode is "default". The interpretation
+;;   of modes is completely up to the farm-configuration file.
+
+;; ----------------------------------------
+
+(require racket/format
+         (for-syntax syntax/kerncase
+                     racket/base))
+
+(provide (except-out (all-from-out racket/base)
+                     #%module-begin)
+         (rename-out [module-begin #%module-begin])
+         sequential
+         parallel
+         machine
+         farm-config?
+         farm-config-tag
+         farm-config-options
+         farm-config-content
+         current-mode)
+
+(module reader syntax/module-reader
+  distro-build/farm)
+
+(struct farm-config (tag options content))
+
+(define-syntax-rule (module-begin form ...)
+  (#%plain-module-begin (farm-begin #f form ...)))
+
+(define-syntax (farm-begin stx)
+  (syntax-case stx ()
+    [(_ #t) #'(begin)]
+    [(_ #f)
+     (raise-syntax-error 'farm
+                         "did not find an expression for the farm configuration")]
+    [(_ found? next . rest) 
+     (let ([expanded (local-expand #'next 'module (kernel-form-identifier-list))])
+       (syntax-case expanded (begin)
+         [(begin next1 ...)
+          #`(farm-begin found? next1 ... . rest)]
+         [(id . _)
+          (and (identifier? #'id)
+               (ormap (lambda (kw) (free-identifier=? #'id kw))
+                      (syntax->list #'(require
+                                       provide
+                                       define-values
+                                       define-syntaxes
+                                       begin-for-syntax
+                                       module
+                                       module*
+                                       #%require
+                                       #%provide))))
+          #`(begin #,expanded (farm-begin found? . rest))]
+         [_else
+          (if (syntax-e #'found?)
+              (raise-syntax-error 'farm
+                                  "found second top-level expression"
+                                  #'next)
+              #`(begin
+                 (provide farm-config)
+                 (define farm-config (let ([v #,expanded])
+                                       (unless (farm-config? v)
+                                         (error 'farm
+                                                (~a "expression did not produce a farm configuration\n"
+                                                    "  result: ~e\n"
+                                                    "  expression: ~.s")
+                                                v
+                                                'next))
+                                       v))
+                 (farm-begin
+                  #t
+                  . rest)))]))]))
+
+(define sequential
+  (make-keyword-procedure
+   (lambda (kws kw-vals . subs)
+     (constructor kws kw-vals subs
+                  check-group-keyword 'sequential))))
+(define parallel
+  (make-keyword-procedure
+   (lambda (kws kw-vals . subs)
+     (constructor kws kw-vals subs
+                  check-group-keyword 'sequential))))
+(define machine
+  (make-keyword-procedure
+   (lambda (kws kw-vals)
+     (constructor kws kw-vals null
+                  check-machine-keyword 'machine))))
+
+(define (constructor kws kw-vals subs check tag)
+  (farm-config
+   tag
+   (for/hash ([kw (in-list kws)]
+              [val (in-list kw-vals)])
+     (unless (check kw val)
+       (error tag
+              (~a "bad value for keyword\n"
+                  "  keyword: ~s"
+                  "  value: ~e")
+              kw
+              val))
+     (values kw val))
+   (for/list ([sub subs])
+     (unless (farm-config? sub)
+       (raise-argument-error tag "farm-config?" sub))
+     sub)))
+
+(define (check-group-keyword kw val)
+  (case kw
+    [(#:pkgs) (and (list? val) (andmap simple-string? val))]
+    [(#:dist-name) (string? val)]
+    [(#:dist-dir) (simple-string? val)]
+    [(#:dist-suffix) (simple-string? val)]
+    [(#:max-vm) (real? val)]
+    [(#:server) (simple-string? val)]
+    [(#:host) (simple-string? val)]
+    [(#:user) (simple-string? val)]
+    [(#:port) (and (exact-integer? val) (<= 1 val 65535))]
+    [(#:dir) (string? val)]
+    [(#:vbox) (string? val)]
+    [(#:platform) (memq val '(unix windows))]
+    [(#:configure) (and (list? val) (andmap string? val))]
+    [(#:bits) (or (equal? val 32) (equal? val 64))]
+    [(#:vc) (or (equal? val "x86") (equal? val "x64"))]
+    [(#:timeout) (real? val)]
+    [(#:j) (exact-positive-integer? val)]
+    [(#:repo) (string? val)]
+    [(#:clean?) (boolean? val)]
+    [else #f]))
+
+(define (check-machine-keyword kw val)
+  (case kw
+    [(#:name) (string? val)]
+    [else (check-group-keyword kw val)]))
+
+(define (simple-string? s)
+  (and (string? s)
+       ;; No spaces, quotes, or other things that could
+       ;; break a command-line, path, or URL construction:
+       (regexp-match #rx"^[-a-zA-A0-9.]*$" s)))
+
+(define current-mode (make-parameter "default"))

pkgs/distro-build/installer-dmg.rkt

@@ -108,9 +108,9 @@
   (system*/show hdiutil "detach" mnt)
   (delete-directory mnt))
 
-(define (installer-dmg human-name dir-name dist-suffix)
+(define (installer-dmg human-name base-name dist-suffix)
   (define dmg-name (format "bundle/~a-~a~a.dmg"
-                           dir-name
+                           base-name
                            (system-library-subpath #f)
                            dist-suffix))
   (make-dmg human-name "bundle/racket" dmg-name bg-image)

pkgs/distro-build/installer-exe.rkt

@@ -397,14 +397,14 @@ SectionEnd
   (parameterize ([current-directory "bundle"])
     (system* makensis "/V3" "installer.nsi")))
 
-(define (installer-exe human-name dir-name release? dist-suffix)
+(define (installer-exe human-name base-name release? dist-suffix)
   (define makensis (or (find-executable-path "makensis.exe")
                        (try-exe "c:\\Program Files\\NSIS\\makensis.exe")
                        (try-exe "c:\\Program Files (x86)\\NSIS\\makensis.exe")
                        (error 'installer-exe "cannot find \"makensis.exe\"")))
   (define platform (let-values ([(base name dir?) (split-path (system-library-subpath #f))])
                      (path->string name)))
-  (define exe-path (format "bundle/~a-~a-win32~a.exe" dir-name platform dist-suffix))
+  (define exe-path (format "bundle/~a-~a-win32~a.exe" base-name platform dist-suffix))
   (nsis-generate exe-path
                  human-name
                  (version)

pkgs/distro-build/installer-sh.rkt

@@ -69,9 +69,9 @@
   (system/show "chmod" "+x" dest)
   (delete-file tmp-tgz))
 
-(define (installer-sh human-name dir-name release? dist-suffix)
+(define (installer-sh human-name base-name dir-name release? dist-suffix)
   (define sh-path (format "bundle/~a-~a~a.sh" 
-                          dir-name 
+                          base-name 
                           (system-library-subpath #f) 
                           dist-suffix))
   (generate-installer-sh "bundle/racket" sh-path

pkgs/distro-build/installer.rkt

@@ -9,18 +9,22 @@
 
 (define release? #f)
 (define upload-to #f)
+(define upload-desc "")
 
-(define-values (short-human-name human-name dir-name dist-suffix)
+(define-values (short-human-name human-name base-name dir-name dist-suffix)
   (command-line
    #:once-each
    [("--release") "Create a release installer"
     (set! release? #t)]
    [("--upload") url "Upload installer"
     (set! upload-to url)]
+   [("--desc") desc "Description to accompany upload"
+    (set! upload-desc desc)]
    #:args
-   (human-name dir-name dist-suffix)
+   (human-name base-name dir-name dist-suffix)
    (values human-name
            (format "~a v~a" human-name (version))
+           (format "~a-~a" base-name (version))
            (if release?
                dir-name
                (format "~a-~a" dir-name (version)))
@@ -30,14 +34,16 @@
 
 (define installer-file
   (case (system-type)
-    [(unix) (installer-sh human-name dir-name release? dist-suffix)]
+    [(unix) (installer-sh human-name base-name dir-name release? dist-suffix)]
-    [(macosx) (installer-dmg human-name dir-name dist-suffix)]
+    [(macosx) (installer-dmg human-name base-name dist-suffix)]
-    [(windows) (installer-exe short-human-name dir-name release? dist-suffix)]))
+    [(windows) (installer-exe short-human-name base-name release? dist-suffix)]))
 
 (call-with-output-file*
  (build-path "bundle" "installer.txt")
  #:exists 'truncate/replace
- (lambda (o) (fprintf o "~a\n" installer-file)))
+ (lambda (o) 
+   (fprintf o "~a\n" installer-file)
+   (fprintf o "~a\n" upload-desc)))
 
 (when upload-to
   (printf "Upload ~a to ~a\n" installer-file upload-to)
@@ -46,6 +52,7 @@
      (string->url (format "~aupload/~a"
                           upload-to
                           (path->string (file-name-from-path installer-file))))
-     (file->bytes installer-file)))
+     (file->bytes installer-file)
+     (list (string-append "Description: " upload-desc))))
   (unless (equal? (read i) #t)
     (error "file upload failed")))

pkgs/distro-build/serve-catalog.rkt

@@ -68,6 +68,27 @@
 (define (write-info req pkg-name)
   (response/sexpr (pkg-name->info req pkg-name)))
 
+(define (record-installer dir filename desc)
+  (when desc
+    (define table-file (build-path dir "table.rktd"))
+    (call-with-file-lock/timeout 
+     #:max-delay 2
+     table-file
+     'exclusive
+     (lambda ()
+       (define t (hash-set
+                  (if (file-exists? table-file)
+                      (call-with-input-file* table-file read)
+                      (hash))
+                  desc
+                  filename))
+       (call-with-output-file table-file
+         #:exists 'truncate/replace
+         (lambda (o) 
+           (write t o)
+           (newline o))))
+     void)))
+
 (define (receive-file req filename)
   (unless (relative-path? filename)
     (error "upload path name must be relative"))
@@ -77,6 +98,11 @@
     #:exists 'truncate/replace
     (lambda (o)
       (write-bytes (request-post-data/raw req) o)))
+  (define desc
+    (for/or ([h (in-list (request-headers/raw req))])
+      (and (equal? (header-field h) #"Description")
+           (bytes->string/utf-8 (header-value h)))))
+  (record-installer dir filename desc)
   (response/sexpr #t))
 
 (define-values (dispatch main-url)