suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

change farm-configuration file to a module

Browse Source 
Also, improve connection between installers and farm-configuration
entries, and improve configuration of installer name versus
target-install directory.
This commit is contained in:
Matthew Flatt 2013-07-01 06:57:13 -06:00
parent 15b49c7607
commit 29b9a22d87
9 changed files with 467 additions and 267 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
INSTALL.txt
View File

@ -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
<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
`DIST_NAME'), <platform> is from `(system-library-subpath #f)' but
where <dist-base> defaults to "racket" (but can be set via
`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
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".

35
Makefile
View File

@ -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':

261
pkgs/distro-build/drive-clients.rkt
View File

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

313
pkgs/distro-build/farm.rkt Normal file
View File

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

4
pkgs/distro-build/installer-dmg.rkt
View File

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

4
pkgs/distro-build/installer-exe.rkt
View File

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

4
pkgs/distro-build/installer-sh.rkt
View File

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

21
pkgs/distro-build/installer.rkt
View File

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

26
pkgs/distro-build/serve-catalog.rkt
View File

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