commit 5c2efaf5ba85362ea0f1ee8e968fc6d4551ff362
parent 2ef4a6c09073285e3f3cdc58374f78d4429537e8
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 5 Jul 2013 15:42:46 -0600
Clean up site configuration module docs and defaults
As a result, `make installers' produces an installer with no further
configuration on a non-Windows platform, even without `git'.
original commit: 91c43fed9d49d8f45bca048b4ba931653ca662e1
Diffstat:
3 files changed, 48 insertions(+), 260 deletions(-)
diff --git a/pkgs/distro-build/config.rkt b/pkgs/distro-build/config.rkt
@@ -1,232 +1,5 @@
#lang racket/base
-;; A build farm is normally run via the `installers' target of the
-;; Racket repository's top-level makefile. That target, in turn, uses
-;; the `distro-build/drive-clients' module.
-;;
-;; The server machine first prepares packages for installation on
-;; clients. The site configuration's top-level entry is consulted for
-;; a `#:pkgs' and/or `#:doc-search' option, which overrides any `PKGS'
-;; and/or `DOC_SEARCH' configuration from the makefile.
-;;
-;; The site configuration file otherwise describes and configures
-;; client machines hierarchically, where configuration options
-;; propagate down the hierarchy when they are not overridden more
-;; locally.
-;;
-;; 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.
-;;
-;; Site Configuration
-;; -------------------
-;;
-;; A site configuration module is normally wriiten in the
-;; `distro-build/config' 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 each machine in the group.
-;;
-;; For example, a configuration module might look like this:
-;;
-;; #lang distro-build/config
-;;
-;; (sequential
-;; #:pkgs '("drracket")
-;; #: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))
-;;
-;;
-;; Site-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 makefile (or, particularly,
-;; the `pkgs' command-line argument to
-;; `distro-build/drive-clients')
-;; #:dist-base-url <string> --- a URL that is used to construct
-;; a default for #:doc-search and
-;; #:dist-catalogs, where the
-;; constructed values are consistent
-;; with converting a build server's
-;; content into a download site; since
-;; URLs are constructed via relative
-;; paths, this URL normally should end
-;; with a slash
-;; #:doc-search <string> --- URL to install as the configuration
-;; for remote documentation searches in
-;; generated installers; "" is replaced
-;; with the PLT default; defaults to
-;; #:dist-base-url (if present) extended
-;; with "doc/search.html", or the
-;; `DOC_SEARCH' makefile variable (or the
-;; `doc-search' argument)
-;; #:dist-name <string> --- the distribution name; defaults to the
-;; `DIST_NAME' makefile variable (or the
-;; `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)
-;; #:dist-catalogs '(<string> ...) --- catalog URLs to install as the
-;; initial catalog configuration
-;; in generated installed, where
-;; "" is replaced with the PLT
-;; default catalogs; defaults to
-;; #:dist-base-url (if present)
-;; extended with "catalogs" in a
-;; list followed by ""
-;; #: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 and
-;; for `raco setup' on all platforms; 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>; set this
-;; to #f for a shared repo checkout; the default
-;; is determined by the `CLEAN_MODE' makefile
-;; variable (or `--clean' command-line flag)
-;; #:pull? <boolean> --- if true, then the build process on the client
-;; machine starts by a `git pull' in <dir>; set
-;; to #f, for example, for a repo checkout that is
-;; shared with server; the default is #t
-;; #:site-dest <path-string> --- destination for completed build, used
-;; by the `site' makefile target; the
-;; default is "build/site"
-;; #:max-snapshots <number> --- number of snapshots to keep, used by
-;; the `snapshot-site' makefile target
-;;
-;; Machine-only keywords:
-;;
-;; #: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/config' language is like
-;; `racket/base' except that the module body must have exactly one
-;; expression (plus any number of definitions, etc.) that produces a
-;; site-configuration value. The value is exported as `site-config'
-;; from the module. Any module can act as a site-configuration module
-;; a long as it exports `site-config' as a site-configuration value.
-;;
-;; The `distro-build/config' language also adds the following functions
-;; to `racket/base':
-;;
-;; (machine <opt-kw> <opt-val> ... ...) -> site-config?
-;; Produces a site configuration based on the given keyword-based
-;; options. The support keyword arguments are described above.
-;;
-;; (sequential <opt-kw> <opt-val> ... ... config ...)
-;; -> site-config?
-;; config : site-config?
-;; Produces a site configuration that runs each `config'
-;; sequentially. The support keyword arguments are described above.
-;;
-;; (parallel <opt-kw> <opt-val> ... ... config ...)
-;; -> site-config?
-;; config : site-config?
-;; Produces a site configuration that runs each `config' in
-;; parallel. The support keyword arguments are described above.
-;;
-;; (site-config? v) -> boolean?
-;; (site-config-tag config) -> (or/c 'machine 'sequential 'parallel)
-;; config : site-config?
-;; (site-config-options config) -> (hash/c keyword? any/c)
-;; config : site-config?
-;; (site-config-content config) -> (listof site-config?)
-;; config : site-config?
-;; Site configuation inspection
-;;
-;; (current-mode) -> string?
-;; (current-mode s) -> void?
-;; s : string?
-;; A parameter whose value is the user's requested mode for this
-;; configuration, normally as provided via the makefile's
-;; `CONFIG_MODE' variable. The default mode is "default". The
-;; interpretation of modes is completely up to the
-;; site configuration file.
-;;
-;; (current-stamp) -> string?
-;; Returns a string to identifiy the current build, normally a
-;; combination of the date and a git commit hash.
-
-;; ----------------------------------------
-
(require racket/format
(for-syntax syntax/kerncase
racket/base))
@@ -350,9 +123,9 @@
[(#:max-vm) (real? val)]
[(#:server) (simple-string? val)]
[(#:host) (simple-string? val)]
- [(#:user) (simple-string? val)]
+ [(#:user) (or (not val) (simple-string? val))]
[(#:port) (and (exact-integer? val) (<= 1 val 65535))]
- [(#:dir) (string? val)]
+ [(#:dir) (path-string? val)]
[(#:vbox) (string? val)]
[(#:platform) (memq val '(unix windows))]
[(#:configure) (and (list? val) (andmap string? val))]
@@ -390,10 +163,6 @@
"now"))))
(define (extract-options config-file config-mode)
- (or
- (and (file-exists? config-file)
- (parameterize ([current-mode config-mode])
- (site-config-options
- (dynamic-require (path->complete-path config-file) 'site-config))))
- (hash)))
-
+ (parameterize ([current-mode config-mode])
+ (site-config-options
+ (dynamic-require (path->complete-path config-file) 'site-config))))
diff --git a/pkgs/distro-build/drive-clients.rkt b/pkgs/distro-build/drive-clients.rkt
@@ -48,8 +48,14 @@
(for/fold ([opts opts]) ([(k v) (in-hash (site-config-options c))])
(hash-set opts k v)))
-(define (get-opt opts kw [default #f])
- (hash-ref opts kw default))
+(define (get-opt opts kw [default #f] #:localhost [localhost-default default])
+ (hash-ref opts kw (cond
+ [(equal? default localhost-default) default]
+ [(and (equal? "localhost" (get-opt opts '#:host "localhost"))
+ (equal? #f (get-opt opts '#:user #f))
+ (equal? #f (get-opt opts '#:dir #f)))
+ localhost-default]
+ [else default])))
(define (get-content c)
(site-config-content c))
@@ -59,6 +65,12 @@
(get-opt opts '#:host)
"localhost"))
+(define (get-path-opt opt key default #:localhost [localhost-default default])
+ (define d (get-opt opt key default #:localhost localhost-default))
+ (if (path? d)
+ (path->string d)
+ d))
+
;; ----------------------------------------
;; Managing VirtualBox machines
@@ -156,15 +168,26 @@
(define scp (find-executable-path "scp"))
(define ssh (find-executable-path "ssh"))
-(define (ssh-script host port user . cmds)
+(define (ssh-script host port user kind . cmds)
(for/and ([cmd (in-list cmds)])
(or (not cmd)
- (apply system*/show ssh
- "-p" (~a port)
- (if user
- (~a user "@" host)
- host)
- cmd))))
+ (if (and (equal? host "localhost")
+ (not user))
+ (apply system*/show cmd)
+ (apply system*/show ssh
+ "-p" (~a port)
+ (if user
+ (~a user "@" host)
+ host)
+ (if (eq? kind 'unix)
+ ;; ssh needs an extra level of quoting
+ ;; relative to sh:
+ (for/list ([arg (in-list cmd)])
+ (~a "'"
+ (regexp-replace* #rx"'" arg "'\"'\"'")
+ "'"))
+ ;; windows quiting built into `cmd' aready
+ cmd))))))
(define (q s)
(~a "\"" s "\""))
@@ -204,7 +227,6 @@
default-dist-dir))
(define dist-suffix (get-opt c '#:dist-suffix ""))
(define dist-catalogs (choose-catalogs c '("")))
- (define pull? (get-opt c '#:pull? #t))
(~a " SERVER=" server
" PKGS=" (q pkgs)
" DOC_SEARCH=" (q doc-search)
@@ -217,15 +239,13 @@
" RELEASE_MODE=" (if release? "--release" (q ""))))
(define (unix-build c host port user server repo clean? pull?)
- (define dir (or (get-opt c '#:dir)
- "build/plt"))
- (define (sh . args)
- (list "/bin/sh" "-c" (~a "'"
- (regexp-replace* #rx"'" (apply ~a args) "'\"'\"'")
- "'")))
+ (define dir (get-path-opt c '#:dir "build/plt" #:localhost (current-directory)))
+ (define (sh . args)
+ (list "/bin/sh" "-c" (apply ~a args)))
(define j (or (get-opt c '#:j) 1))
(ssh-script
host port user
+ 'unix
(and clean?
(sh "rm -rf " (q dir)))
(sh "if [ ! -d " (q dir) " ] ; then"
@@ -241,8 +261,7 @@
" CONFIGURE_ARGS_qq=" (qq (get-opt c '#:configure null) 'unix))))
(define (windows-build c host port user server repo clean? pull?)
- (define dir (or (get-opt c '#:dir)
- "build\\plt"))
+ (define dir (get-path-opt c '#:dir "build\\plt" #:localhost (current-directory)))
(define bits (or (get-opt c '#:bits) 64))
(define vc (or (get-opt c '#:vc)
(if (= bits 32)
@@ -253,6 +272,7 @@
(list "cmd" "/c" (apply ~a args)))
(ssh-script
host port user
+ 'windows
(and clean?
(cmd "IF EXIST " (q dir) " rmdir /S /Q " (q dir)))
(cmd "IF NOT EXIST " (q dir) " git clone " (q repo) " " (q dir))
@@ -276,11 +296,8 @@
default-server))
(define repo (or (get-opt c '#:repo)
(~a "http://" server ":9440/.git")))
- (define clean? (let ([v (get-opt c '#:clean? 'none)])
- (if (eq? v 'none)
- default-clean?
- v)))
- (define pull? (get-opt c '#:pull? #t))
+ (define clean? (get-opt c '#:clean? default-clean? #:localhost #f))
+ (define pull? (get-opt c '#:pull? #t #:localhost #f))
((case (or (get-opt c '#:platform) 'unix)
[(unix) unix-build]
[else windows-build])
diff --git a/pkgs/distro-build/set-config.rkt b/pkgs/distro-build/set-config.rkt
@@ -11,7 +11,9 @@
(dest-config-file config-file config-mode doc-search . catalog)
(values dest-config-file config-file config-mode doc-search catalog)))
-(define config (extract-options config-file config-mode))
+(define config (if (equal? config-file "")
+ (hash)
+ (extract-options config-file config-mode)))
(define doc-search (choose-doc-search config default-doc-search))
