commit ee514c1c63144db893e2c84cfba27d556923bb8b
parent 3bfb743bb5ec389742c5295c9220160b78f92f34
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 1 Jul 2013 20:09:01 -0600
Generalize use of farm config file
Change `FARM_CONFIG' to just `CONFIG' and use it on the server, too.
original commit: 3264f16b63b483b9216b17b8999b50d6ba0b181b
Diffstat:
5 files changed, 133 insertions(+), 39 deletions(-)
diff --git a/pkgs/distro-build/drive-clients.rkt b/pkgs/distro-build/drive-clients.rkt
@@ -8,7 +8,8 @@
(only-in "farm.rkt"
current-mode
farm-config?
- farm-config-tag farm-config-options farm-config-content))
+ farm-config-tag farm-config-options farm-config-content)
+ "url-options.rkt")
;; See "farm.rkt" for an overview.
@@ -194,8 +195,7 @@
(if l
(apply ~a #:separator " " l)
default-pkgs)))
- (define doc-search (get-opt c '#:doc-search
- default-doc-search))
+ (define doc-search (choose-doc-search c default-doc-search))
(define dist-name (or (get-opt c '#:dist-name)
default-dist-name))
(define dist-base (or (get-opt c '#:dist-base)
@@ -203,7 +203,7 @@
(define dist-dir (or (get-opt c '#:dist-dir)
default-dist-dir))
(define dist-suffix (get-opt c '#:dist-suffix ""))
- (define dist-catalogs (get-opt c '#:dist-catalogs '("")))
+ (define dist-catalogs (choose-catalogs c '("")))
(define pull? (get-opt c '#:pull? #t))
(~a " SERVER=" server
" PKGS=" (q pkgs)
@@ -220,7 +220,9 @@
(define dir (or (get-opt c '#:dir)
"build/plt"))
(define (sh . args)
- (list "/bin/sh" "-c" (~a "'" (apply ~a args) "'")))
+ (list "/bin/sh" "-c" (~a "'"
+ (regexp-replace* #rx"'" (apply ~a args) "'\"'\"'")
+ "'")))
(define j (or (get-opt c '#:j) 1))
(ssh-script
host port user
diff --git a/pkgs/distro-build/farm.rkt b/pkgs/distro-build/farm.rkt
@@ -4,11 +4,17 @@
;; 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.
+;; The server machine first prepares packages for installation on
+;; clients. The farm 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 farm configuration file otherwise describes and configures
+;; client machines. 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,
@@ -54,13 +60,14 @@
;; 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.
+;; `sequential' are propagated to each machine in the group.
;;
;; For example, a configuration module might look like this:
;;
;; #lang distro-build/farm
;;
;; (sequential
+;; #:pkgs '("drracket")
;; #:server "192.168.56.1"
;; (machine
;; #:desc "Linux (32-bit, Precise Pangolin)"
@@ -90,33 +97,47 @@
;; #: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,
+;; `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 the
-;; `DOC_SEARCH' makefile variable or the
-;; `doc-search' argument
+;; 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 `dist-name'
-;; command-line argument
+;; `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
+;; (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
+;; (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_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
+;; 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
@@ -134,13 +155,14 @@
;; 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
+;; 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
;;
;; 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)
@@ -185,8 +207,10 @@
;; (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.
+;; 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
+;; farm configuration file.
;; ----------------------------------------
@@ -204,7 +228,8 @@
farm-config-tag
farm-config-options
farm-config-content
- current-mode)
+ current-mode
+ extract-options)
(module reader syntax/module-reader
distro-build/farm)
@@ -279,10 +304,16 @@
tag
(for/hash ([kw (in-list kws)]
[val (in-list kw-vals)])
+ (define r (check kw val))
+ (when (eq? r 'bad-keyword)
+ (error tag
+ (~a "unrecognized keyword for option\n"
+ " keyword: ~s")
+ kw))
(unless (check kw val)
(error tag
(~a "bad value for keyword\n"
- " keyword: ~s"
+ " keyword: ~s\n"
" value: ~e")
kw
val))
@@ -301,6 +332,7 @@
[(#:dist-dir) (simple-string? val)]
[(#:dist-suffix) (simple-string? val)]
[(#:dist-catalogs) (and (list? val) (andmap string? val))]
+ [(#:dist-base-url) (string? val)]
[(#:max-vm) (real? val)]
[(#:server) (simple-string? val)]
[(#:host) (simple-string? val)]
@@ -317,7 +349,7 @@
[(#:repo) (string? val)]
[(#:clean?) (boolean? val)]
[(#:pull?) (boolean? val)]
- [else #f]))
+ [else 'bad-keyword]))
(define (check-machine-keyword kw val)
(case kw
@@ -331,3 +363,12 @@
(regexp-match #rx"^[-a-zA-A0-9.]*$" s)))
(define current-mode (make-parameter "default"))
+
+(define (extract-options config-file config-mode)
+ (or
+ (and (file-exists? config-file)
+ (parameterize ([current-mode config-mode])
+ (farm-config-options
+ (dynamic-require (path->complete-path config-file) 'farm-config))))
+ (hash)))
+
diff --git a/pkgs/distro-build/install-pkgs.rkt b/pkgs/distro-build/install-pkgs.rkt
@@ -0,0 +1,21 @@
+#lang racket/base
+(require racket/cmdline
+ racket/string
+ (only-in "farm.rkt" extract-options))
+
+(define-values (config-file config-mode default-pkgs flags)
+ (command-line
+ #:args
+ (config-file config-mode pkgs . flag)
+ (values config-file config-mode pkgs flag)))
+
+(define pkgs (or (hash-ref (extract-options config-file config-mode)
+ '#:pkgs
+ #f)
+ (string-split default-pkgs)))
+
+(parameterize ([current-command-line-arguments
+ (list->vector (append (list "pkg" "install")
+ flags
+ pkgs))])
+ (dynamic-require 'raco #f))
diff --git a/pkgs/distro-build/set-config.rkt b/pkgs/distro-build/set-config.rkt
@@ -1,17 +1,25 @@
#lang racket/base
(require racket/cmdline
racket/file
- racket/path)
+ racket/path
+ (only-in "farm.rkt" extract-options)
+ "url-options.rkt")
-(define-values (config-file doc-search catalogs)
+(define-values (dest-config-file config-file config-mode default-doc-search default-catalogs)
(command-line
#:args
- (config-file doc-search . catalog)
- (values config-file doc-search catalog)))
+ (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 doc-search (choose-doc-search config default-doc-search))
+
+(define catalogs (choose-catalogs config default-catalogs))
(define orig
- (if (file-exists? config-file)
- (call-with-input-file* config-file read)
+ (if (file-exists? dest-config-file)
+ (call-with-input-file* dest-config-file read)
(hash)))
(let* ([table orig]
@@ -27,8 +35,8 @@
#f
c))))])
(unless (equal? table orig)
- (make-directory* (path-only config-file))
- (call-with-output-file config-file
+ (make-directory* (path-only dest-config-file))
+ (call-with-output-file dest-config-file
#:exists 'truncate
(lambda (o)
(write table o)
diff --git a/pkgs/distro-build/url-options.rkt b/pkgs/distro-build/url-options.rkt
@@ -0,0 +1,22 @@
+#lang racket/base
+(require net/url)
+
+(provide choose-doc-search
+ choose-catalogs)
+
+(define (choose-doc-search config default-doc-search)
+ (or (hash-ref config '#:doc-search #f)
+ (let ([v (hash-ref config '#:dist-base-url #f)])
+ (and v
+ (url->string
+ (combine-url/relative (string->url v) "docs/search.html"))))
+ default-doc-search))
+
+(define (choose-catalogs config default-catalogs)
+ (or (hash-ref config '#:dist-catalogs #f)
+ (let ([v (hash-ref config '#:dist-base-url #f)])
+ (and v
+ (list (url->string
+ (combine-url/relative (string->url v) "catalog"))
+ "")))
+ default-catalogs))
