diff --git a/INSTALL.txt b/INSTALL.txt index 7253c7e17d..41df609574 100644 --- a/INSTALL.txt +++ b/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 -can be provided as `make' arguments via `PKGS', `SERVER', `DIST_NAME' -and `DIST_DIR', respectively. Note that a sets of packages specified -in a configure file affects the clients, but it does not affect the -packages prepared by the server; only `PKGS' affects the server (and -the client's packages must be a subset of the server's packages). +of the server, distribution name, and installer directory, but defaults +can be provided as `make' arguments via `PKGS', `SERVER', `DIST_NAME', +`DIST_BASE', and `DIST_DIR', respectively. Note that a sets of +packages specified in a configure file affects the clients, but it +does not affect the packages prepared by the server; only `PKGS' +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 - ---. + ---. -where defaults to "racket" (but can be set via -`DIST_NAME'), is from `(system-library-subpath #f)' but +where defaults to "racket" (but can be set via +`DIST_BASE'), is from `(system-library-subpath #f)' but normalizing the Windows results to "i386-win32" and "x86_63-win32", - is omitted unless a `#:dist-suffix' string is specified for the client in the farm configuration, and 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 - the base name of the installer file for all platforms, provide + To change the base name of the installer file, provide `DIST_BASE + 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 -also uploaded to the server, which leaves the installer in a -"build/installers" directory. +contains the path to the generated installer on one line, followed by +the description on a second line. The installer is also uploaded to +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". diff --git a/Makefile b/Makefile index 1cd0b9396f..c3411bd2c4 100644 --- a/Makefile +++ b/Makefile @@ -81,19 +81,28 @@ SERVER = localhost # snapshot installers): RELEASE_MODE = -# Human-readable name and installation-directory name for the -# generated installers: +# Human-readable name, installation name base, and installation +# 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: -FARM_CONFIG = build/farm-config.rktd +# Configuration of clients to run for a build farm, normally +# 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': diff --git a/pkgs/distro-build/drive-clients.rkt b/pkgs/distro-build/drive-clients.rkt index 55847437e0..5d0fd23e31 100644 --- a/pkgs/distro-build/drive-clients.rkt +++ b/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 -;; grammar: -;; -;; = (machine ... ...) -;; | ( ... ... ...) -;; -;; = parallel | sequential -;; -;; Normally, a configuration file start with "( ...)", since -;; the configuration otherwise specifies only one client machine. -;; -;; A ` ... ...' 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 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 means no spaces, etc.): -;; -;; #:pkgs ( ...) --- packages to install; defaults to -;; the `pkgs' command-line argument -;; #:server --- the address of the server from the client; -;; defaults to `server' command-line argument -;; #:dist-name --- the distribution name; defaults to the -;; `dist-name' command-line argument -;; #:dist-dir --- the distribution's installation directory; -;; defaults to `dist-dir' command-line argument -;; #:dist-suffix --- a suffix for the installer's name, usually -;; used for an OS variant; defaults to "" -;; #:max-vm --- max number of VMs allowed to run with this -;; machine, counting the machine; defaults to 1 -;; #:port --- ssh port for the client; defaults to 22 -;; #:user --- ssh user for the client; defaults to current user -;; #:dir --- defaults to "build/plt" or "build\\plt" -;; #:vbox --- Virtual Box machine name; if provided the -;; virtual machine is started and stopped as needed -;; #:platform --- 'windows or 'unix, defaults to 'unix -;; #:configure ( ...) --- arguments to `configure' -;; #:bits --- 32 or 64, affects Visual Studio path -;; #:vc --- "x86" or "x64" to select the Visual C build mode; -;; default depends on bits -;; #:j --- parallelism for `make' on Unix and Mac OS X; -;; defaults to 1 -;; #:timeout --- numbers of seconds to wait before declaring -;; failure; defaults to 30 minutes -;; #:repo --- the git repository for Racket; defaults to -;; "http://:9440/.git" -;; #:clean? --- override default cleaning mode -;; -;; Machine-only keywords: -;; #:name --- defaults to host -;; #:host --- 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) - (values config-file server pkgs dist-name dist-dir))) + #:args (config-file config-mode + 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))) -;; ---------------------------------------- - -(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 (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) +(unless (farm-config? config) + (error 'drive-clients + "configuration module did not provide a farm-configuration value: ~e" + config)) ;; ---------------------------------------- (define (merge-options opts c) - (let loop ([c (cdr c)] [opts opts]) - (cond - [(and (pair? c) - (keyword? (car c))) - (loop (cddr c) - (hash-set opts (car c) (cadr c)))] - [else opts]))) + (for/fold ([opts opts]) ([(k v) (in-hash (farm-config-options c))]) + (hash-set opts k v))) (define (get-opt opts kw [default #f]) (hash-ref opts kw default)) (define (get-content c) - (let loop ([c (cdr c)]) - (if (and (pair? c) - (keyword? (car c))) - (loop (cddr c)) - c))) + (farm-config-content 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 diff --git a/pkgs/distro-build/farm.rkt b/pkgs/distro-build/farm.rkt new file mode 100644 index 0000000000..15766dd092 --- /dev/null +++ b/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 means no spaces, etc.): +;; +;; #:host --- defaults to "localhost" +;; #:port --- ssh port for the client; defaults to 22 +;; #:user --- ssh user for the client; defaults to current user +;; #:dir --- defaults to "build/plt" or "build\\plt" +;; #:server --- the address of the server as accessed by the +;; client; defaults to the `server' command-line +;; argument +;; #:repo --- the git repository for Racket; defaults to +;; "http://:9440/.git" +;; #:pkgs '( ...) --- packages to install; defaults to +;; `PKGS' in the makfile (or, more genereally, +;; the `pkgs' command-line argument to +;; `distro-build/drive-clients') +;; #:dist-name --- the distribution name; defaults to the +;; `DIST_NAME' makefile variable or `dist-name' +;; command-line argument +;; #:dist-base --- the distribution's installater name prefix; +;; defaults to the `DIST_BASE' makefile variable +;; or the `dist-base' command-line argument +;; #:dist-dir --- the distribution's installation directory; +;; defaults to the `DIST_DIR' makefile variable +;; or the `dist-dir' command-line argument +;; #:dist-suffix --- 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 --- max number of VMs allowed to run with this +;; machine, counting the machine; defaults to 1 +;; #:vbox --- Virtual Box machine name; if provided the +;; virtual machine is started and stopped as needed +;; #:platform --- 'windows or 'unix, defaults to 'unix +;; #:configure '( ...) --- arguments to `configure' +;; #:bits --- 32 or 64, affects Visual Studio path +;; #:vc --- "x86" or "x64" to select the Visual C build mode; +;; default depends on bits +;; #:j --- parallelism for `make' on Unix and Mac OS X; +;; defaults to 1 +;; #:timeout --- numbers of seconds to wait before declaring +;; failure; defaults to 30 minutes +;; #:clean? --- if true, then the build process on the client +;; machine starts by removing ; the default +;; is #f, but the `--clean' command-line flag +;; changes the default to #t +;; +;; Machine-only keywords: +;; #:name --- 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 ... ...) -> farm-config? +;; Produces a farm configuration based on the given keyword-based +;; options. The support keyword arguments are described above. +;; +;; (sequential ... ... config ...) +;; -> farm-config? +;; config : farm-config? +;; Produces a farm configuration that runs each `config' +;; sequentially. The support keyword arguments are described above. +;; +;; (parallel ... ... 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")) diff --git a/pkgs/distro-build/installer-dmg.rkt b/pkgs/distro-build/installer-dmg.rkt index bf7154a789..5a656f88dc 100644 --- a/pkgs/distro-build/installer-dmg.rkt +++ b/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) diff --git a/pkgs/distro-build/installer-exe.rkt b/pkgs/distro-build/installer-exe.rkt index 284462b667..d1322611f7 100644 --- a/pkgs/distro-build/installer-exe.rkt +++ b/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) diff --git a/pkgs/distro-build/installer-sh.rkt b/pkgs/distro-build/installer-sh.rkt index 391630cbdb..7f17d29550 100644 --- a/pkgs/distro-build/installer-sh.rkt +++ b/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 diff --git a/pkgs/distro-build/installer.rkt b/pkgs/distro-build/installer.rkt index 67f16493c5..cdcb6dc909 100644 --- a/pkgs/distro-build/installer.rkt +++ b/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)] - [(macosx) (installer-dmg human-name dir-name dist-suffix)] - [(windows) (installer-exe short-human-name dir-name release? dist-suffix)])) + [(unix) (installer-sh human-name base-name dir-name release? dist-suffix)] + [(macosx) (installer-dmg human-name base-name 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"))) diff --git a/pkgs/distro-build/serve-catalog.rkt b/pkgs/distro-build/serve-catalog.rkt index 8d98b80a14..fe32601326 100644 --- a/pkgs/distro-build/serve-catalog.rkt +++ b/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)