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

Generalize use of farm config file

Browse Source 
Change `FARM_CONFIG' to just `CONFIG' and use it on the server, too.

original commit: 3264f16b63b483b9216b17b8999b50d6ba0b181b
This commit is contained in:
Matthew Flatt 2013-07-01 20:09:01 -06:00
parent 3bfb743bb5
commit ee514c1c63
5 changed files with 133 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

91
pkgs/distro-build/farm.rkt
View File

@ -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,
@ -61,6 +67,7 @@
;; #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)))

21
pkgs/distro-build/install-pkgs.rkt Normal file
View File

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

24
pkgs/distro-build/set-config.rkt
View File

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

22
pkgs/distro-build/url-options.rkt Normal file
View File

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