commit 771e9300ca10ac14d75808665f3973a3deaaaf76
parent ee514c1c63144db893e2c84cfba27d556923bb8b
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 2 Jul 2013 09:28:39 -0600
Change "farm" terminology to "site", mostly
original commit: 2e657af9b6473cb2aef4b4e8e40135b90c720dea
Diffstat:
8 files changed, 551 insertions(+), 388 deletions(-)
diff --git a/pkgs/distro-build/assemble-site.rkt b/pkgs/distro-build/assemble-site.rkt
@@ -0,0 +1,64 @@
+#lang racket/base
+(require racket/cmdline
+ racket/file
+ net/url
+ "download-page.rkt"
+ (only-in "site.rkt" extract-options))
+
+(define build-dir (build-path "build"))
+(define dest-dir (build-path build-dir "site"))
+
+(define built-dir (build-path build-dir "built"))
+
+(define installers-dir (build-path "installers"))
+(define pkgs-dir (build-path "pkgs"))
+(define catalog-dir (build-path "catalog"))
+
+(define-values (config-file config-mode)
+ (command-line
+ #:args
+ (config-file config-mode)
+ (values config-file config-mode)))
+
+(define config (extract-options config-file config-mode))
+
+(define (copy dir [build-dir build-dir])
+ (make-directory* dest-dir)
+ (printf "Copying ~s\n" (build-path build-dir dir))
+ (copy-directory/files (build-path build-dir dir)
+ (build-path dest-dir dir)
+ #:keep-modify-seconds? #t))
+
+(delete-directory/files dest-dir #:must-exist? #f)
+(copy pkgs-dir built-dir)
+
+(printf "Building catalog\n")
+(let ([c-dir (build-path built-dir catalog-dir "pkg")]
+ [d-dir (build-path dest-dir catalog-dir "pkg")])
+ (make-directory* d-dir)
+ (define base-url (string->url (hash-ref config '#:dist-base-url)))
+ (for ([f (in-list (directory-list c-dir))])
+ (define ht (call-with-input-file* (build-path c-dir f) read))
+ (define new-ht
+ (hash-set ht 'source (url->string
+ (combine-url/relative
+ base-url
+ (path->string
+ (build-path
+ "pkgs"
+ (path-add-suffix f #".zip")))))))
+ (call-with-output-file*
+ (build-path d-dir f)
+ (lambda (o)
+ (write new-ht o)
+ (newline o)))))
+
+(copy installers-dir)
+
+(make-download-page (build-path build-dir
+ installers-dir
+ "table.rktd")
+ #:installers-url "installers/"
+ #:dest (build-path dest-dir
+ "index.html")
+ #:git-clone (current-directory))
diff --git a/pkgs/distro-build/config.rkt b/pkgs/distro-build/config.rkt
@@ -0,0 +1,374 @@
+#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. 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;
+;; 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
+;;
+;; 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.
+
+;; ----------------------------------------
+
+(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
+ site-config?
+ site-config-tag
+ site-config-options
+ site-config-content
+ current-mode
+ extract-options)
+
+(module reader syntax/module-reader
+ distro-build/site)
+
+(struct site-config (tag options content))
+
+(define-syntax-rule (module-begin form ...)
+ (#%plain-module-begin (site-begin #f form ...)))
+
+(define-syntax (site-begin stx)
+ (syntax-case stx ()
+ [(_ #t) #'(begin)]
+ [(_ #f)
+ (raise-syntax-error 'site
+ "did not find an expression for the site configuration")]
+ [(_ found? next . rest)
+ (let ([expanded (local-expand #'next 'module (kernel-form-identifier-list))])
+ (syntax-case expanded (begin)
+ [(begin next1 ...)
+ #`(site-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 (site-begin found? . rest))]
+ [_else
+ (if (syntax-e #'found?)
+ (raise-syntax-error 'site
+ "found second top-level expression"
+ #'next)
+ #`(begin
+ (provide site-config)
+ (define site-config (let ([v #,expanded])
+ (unless (site-config? v)
+ (error 'site
+ (~a "expression did not produce a site configuration\n"
+ " result: ~e\n"
+ " expression: ~.s")
+ v
+ 'next))
+ v))
+ (site-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)
+ (site-config
+ 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\n"
+ " value: ~e")
+ kw
+ val))
+ (values kw val))
+ (for/list ([sub subs])
+ (unless (site-config? sub)
+ (raise-argument-error tag "site-config?" sub))
+ sub)))
+
+(define (check-group-keyword kw val)
+ (case kw
+ [(#:pkgs) (and (list? val) (andmap simple-string? val))]
+ [(#:doc-search) (string? val)]
+ [(#:dist-name) (string? val)]
+ [(#:dist-base) (simple-string? val)]
+ [(#: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)]
+ [(#: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)]
+ [(#:pull?) (boolean? val)]
+ [else 'bad-keyword]))
+
+(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"))
+
+(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)))
+
diff --git a/pkgs/distro-build/download-page.rkt b/pkgs/distro-build/download-page.rkt
@@ -0,0 +1,99 @@
+#lang racket/base
+(require racket/format
+ racket/path
+ racket/system
+ net/url
+ openssl/sha1
+ xml)
+
+(provide make-download-page)
+
+(module+ main
+ (require racket/cmdline)
+
+ (define args null)
+ (define (arg! kw val)
+ (set! args (cons (cons kw val) args)))
+
+ (define table-file
+ (command-line
+ #:once-each
+ [("--at") url "URL for installaters reletaive to download page"
+ (arg! '#:installers-url url)]
+ [("--dest") file "Write to <dest>"
+ (arg! '#:dest file)]
+ [("--git") dir "Report information from git clone <dir>"
+ (arg! '#:git-clone dir)]
+ #:args
+ (table-file)
+ table-file))
+
+ (let ([args (sort args keyword<? #:key car)])
+ (keyword-apply make-download-page
+ (map car args)
+ (map cdr args)
+ table-file)))
+
+(define (make-download-page table-file
+ #:dest [dest "index.html"]
+ #:installers-url [installers-url "./"]
+ #:title [title "Racket Downloads"]
+ #:git-clone [git-clone #f])
+
+ (define table (call-with-input-file table-file read))
+
+ (unless (hash? table)
+ (raise-user-error
+ 'make-download-page
+ (~a "given file does not contain a hash table\n"
+ " file: ~a")
+ table-file))
+
+ (define (system*/string . args)
+ (define s (open-output-string))
+ (parameterize ([current-output-port s])
+ (apply system* args))
+ (get-output-string s))
+
+ (call-with-output-file*
+ dest
+ #:exists 'truncate/replace
+ (lambda (o)
+ (parameterize ([empty-tag-shorthand html-empty-tags])
+ (write-xexpr
+ `(html
+ (head (title ,title)
+ (style ,(~a " .detail { font-size: small; }"
+ " .checksum, .path { font-family: monospace }")))
+ (body
+ (h2 ,title)
+ (table
+ ,@(for/list ([key (in-list (sort (hash-keys table) string<?))])
+ (define inst (hash-ref table key))
+ `(tr (td (a ((href ,(url->string
+ (combine-url/relative
+ (string->url installers-url)
+ inst))))
+ ,key))
+ (td nbsp)
+ (td (span ([class "detail"])
+ "SHA1: "
+ (span ([class "checksum"])
+ ,(call-with-input-file*
+ (build-path (path-only table-file)
+ inst)
+ sha1)))))))
+ ,@(if git-clone
+ (let ([git (find-executable-path "git")])
+ (define origin (let ([s (system*/string git "remote" "show" "origin")])
+ (define m (regexp-match #rx"(?m:Fetch URL: (.*)$)" s))
+ (if m
+ (cadr m)
+ "???")))
+ (define stamp (system*/string git "log" "-1" "--format=%H"))
+ `((p
+ (div (span ([class "detail"]) "Repository: " (span ([class "path"]) ,origin)))
+ (div (span ([class "detail"]) "Commit: " (span ([class "checksum"]) ,stamp))))))
+ null)))
+ o)
+ (void)))))
diff --git a/pkgs/distro-build/drive-clients.rkt b/pkgs/distro-build/drive-clients.rkt
@@ -5,13 +5,13 @@
racket/format
racket/file
racket/string
- (only-in "farm.rkt"
+ (only-in "config.rkt"
current-mode
- farm-config?
- farm-config-tag farm-config-options farm-config-content)
+ site-config?
+ site-config-tag site-config-options site-config-content)
"url-options.rkt")
-;; See "farm.rkt" for an overview.
+;; See "config.rkt" for an overview.
;; ----------------------------------------
@@ -35,24 +35,24 @@
dist-name dist-base dist-dir)))
(define config (parameterize ([current-mode config-mode])
- (dynamic-require (path->complete-path config-file) 'farm-config)))
+ (dynamic-require (path->complete-path config-file) 'site-config)))
-(unless (farm-config? config)
+(unless (site-config? config)
(error 'drive-clients
- "configuration module did not provide a farm-configuration value: ~e"
+ "configuration module did not provide a site-configuration value: ~e"
config))
;; ----------------------------------------
(define (merge-options opts c)
- (for/fold ([opts opts]) ([(k v) (in-hash (farm-config-options c))])
+ (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-content c)
- (farm-config-content c))
+ (site-config-content c))
(define (client-name opts)
(or (get-opt opts '#:name)
@@ -333,12 +333,12 @@
[mode 'sequential]
[opts (hasheq)])
(unless stop?
- (case (farm-config-tag config)
+ (case (site-config-tag config)
[(parallel sequential)
(define new-opts (merge-options opts config))
(define ts
(map (lambda (c) (loop c
- (farm-config-tag config)
+ (site-config-tag config)
new-opts))
(get-content config)))
(define (wait)
diff --git a/pkgs/distro-build/farm.rkt b/pkgs/distro-build/farm.rkt
@@ -1,374 +0,0 @@
-#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.
-;;
-;; 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,
-;; 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 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)"
-;; #: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 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;
-;; 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
-;;
-;; 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, 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.
-
-;; ----------------------------------------
-
-(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
- extract-options)
-
-(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)])
- (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\n"
- " 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))]
- [(#:doc-search) (string? val)]
- [(#:dist-name) (string? val)]
- [(#:dist-base) (simple-string? val)]
- [(#: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)]
- [(#: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)]
- [(#:pull?) (boolean? val)]
- [else 'bad-keyword]))
-
-(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"))
-
-(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
@@ -1,7 +1,7 @@
#lang racket/base
(require racket/cmdline
racket/string
- (only-in "farm.rkt" extract-options))
+ (only-in "site.rkt" extract-options))
(define-values (config-file config-mode default-pkgs flags)
(command-line
diff --git a/pkgs/distro-build/set-config.rkt b/pkgs/distro-build/set-config.rkt
@@ -2,7 +2,7 @@
(require racket/cmdline
racket/file
racket/path
- (only-in "farm.rkt" extract-options)
+ (only-in "config.rkt" extract-options)
"url-options.rkt")
(define-values (dest-config-file config-file config-mode default-doc-search default-catalogs)
diff --git a/pkgs/distro-build/url-options.rkt b/pkgs/distro-build/url-options.rkt
@@ -17,6 +17,6 @@
(let ([v (hash-ref config '#:dist-base-url #f)])
(and v
(list (url->string
- (combine-url/relative (string->url v) "catalog"))
+ (combine-url/relative (string->url v) "catalog/"))
"")))
default-catalogs))
