Change "farm" terminology to "site", mostly
original commit: 2e657af9b6473cb2aef4b4e8e40135b90c720dea
This commit is contained in:
Matthew Flatt
parent
ee514c1c63
commit
771e9300ca
64
pkgs/distro-build/assemble-site.rkt
Normal file
64
pkgs/distro-build/assemble-site.rkt
Normal file
|
|
@ -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))
|
||||
|
|
@ -1,15 +1,15 @@
|
|||
#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.
|
||||
;; 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 farm configuration's top-level entry is consulted for
|
||||
;; 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 farm configuration file otherwise describes and configures
|
||||
;; 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
|
||||
|
|
@ -52,11 +52,11 @@
|
|||
;; or C:\Program Files (x86)\NSIS\makensis.exe
|
||||
;; or instaled so that `makensis' in in yur PATH.
|
||||
;;
|
||||
;; Farm Configuration
|
||||
;; Site Configuration
|
||||
;; -------------------
|
||||
;;
|
||||
;; A farm configuration module is normally wriiten in the
|
||||
;; `distro-build/farm' language. The configuration describes
|
||||
;; 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
|
||||
|
|
@ -64,7 +64,7 @@
|
|||
;;
|
||||
;; For example, a configuration module might look like this:
|
||||
;;
|
||||
;; #lang distro-build/farm
|
||||
;; #lang distro-build/config
|
||||
;;
|
||||
;; (sequential
|
||||
;; #:pkgs '("drracket")
|
||||
|
|
@ -85,7 +85,7 @@
|
|||
;; #:bits 64))
|
||||
;;
|
||||
;;
|
||||
;; Farm-configuration keywords (where <string*> means no spaces, etc.):
|
||||
;; Site-configuration keywords (where <string*> means no spaces, etc.):
|
||||
;;
|
||||
;; #:host <string*> --- defaults to "localhost"
|
||||
;; #:port <integer> --- ssh port for the client; defaults to 22
|
||||
|
|
@ -168,40 +168,40 @@
|
|||
;; generated table of installer links, for example)
|
||||
;;
|
||||
;;
|
||||
;; More precisely, the `distro-build/farm' language is like
|
||||
;; 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
|
||||
;; 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.
|
||||
;; 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/farm' language also adds the following functions
|
||||
;; The `distro-build/config' 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
|
||||
;; (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 ...)
|
||||
;; -> farm-config?
|
||||
;; config : farm-config?
|
||||
;; Produces a farm configuration that runs each `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 ...)
|
||||
;; -> farm-config?
|
||||
;; config : farm-config?
|
||||
;; Produces a farm configuration that runs each `config' in
|
||||
;; -> site-config?
|
||||
;; config : site-config?
|
||||
;; Produces a site 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
|
||||
;; (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?
|
||||
|
|
@ -210,7 +210,7 @@
|
|||
;; 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.
|
||||
;; site configuration file.
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
@ -224,32 +224,32 @@
|
|||
sequential
|
||||
parallel
|
||||
machine
|
||||
farm-config?
|
||||
farm-config-tag
|
||||
farm-config-options
|
||||
farm-config-content
|
||||
site-config?
|
||||
site-config-tag
|
||||
site-config-options
|
||||
site-config-content
|
||||
current-mode
|
||||
extract-options)
|
||||
|
||||
(module reader syntax/module-reader
|
||||
distro-build/farm)
|
||||
distro-build/site)
|
||||
|
||||
(struct farm-config (tag options content))
|
||||
(struct site-config (tag options content))
|
||||
|
||||
(define-syntax-rule (module-begin form ...)
|
||||
(#%plain-module-begin (farm-begin #f form ...)))
|
||||
(#%plain-module-begin (site-begin #f form ...)))
|
||||
|
||||
(define-syntax (farm-begin stx)
|
||||
(define-syntax (site-begin stx)
|
||||
(syntax-case stx ()
|
||||
[(_ #t) #'(begin)]
|
||||
[(_ #f)
|
||||
(raise-syntax-error 'farm
|
||||
"did not find an expression for the farm configuration")]
|
||||
(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 ...)
|
||||
#`(farm-begin found? next1 ... . rest)]
|
||||
#`(site-begin found? next1 ... . rest)]
|
||||
[(id . _)
|
||||
(and (identifier? #'id)
|
||||
(ormap (lambda (kw) (free-identifier=? #'id kw))
|
||||
|
|
@ -262,24 +262,24 @@
|
|||
module*
|
||||
#%require
|
||||
#%provide))))
|
||||
#`(begin #,expanded (farm-begin found? . rest))]
|
||||
#`(begin #,expanded (site-begin found? . rest))]
|
||||
[_else
|
||||
(if (syntax-e #'found?)
|
||||
(raise-syntax-error 'farm
|
||||
(raise-syntax-error 'site
|
||||
"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"
|
||||
(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))
|
||||
(farm-begin
|
||||
(site-begin
|
||||
#t
|
||||
. rest)))]))]))
|
||||
|
||||
|
|
@ -300,7 +300,7 @@
|
|||
check-machine-keyword 'machine))))
|
||||
|
||||
(define (constructor kws kw-vals subs check tag)
|
||||
(farm-config
|
||||
(site-config
|
||||
tag
|
||||
(for/hash ([kw (in-list kws)]
|
||||
[val (in-list kw-vals)])
|
||||
|
|
@ -319,8 +319,8 @@
|
|||
val))
|
||||
(values kw val))
|
||||
(for/list ([sub subs])
|
||||
(unless (farm-config? sub)
|
||||
(raise-argument-error tag "farm-config?" sub))
|
||||
(unless (site-config? sub)
|
||||
(raise-argument-error tag "site-config?" sub))
|
||||
sub)))
|
||||
|
||||
(define (check-group-keyword kw val)
|
||||
|
|
@ -368,7 +368,7 @@
|
|||
(or
|
||||
(and (file-exists? config-file)
|
||||
(parameterize ([current-mode config-mode])
|
||||
(farm-config-options
|
||||
(dynamic-require (path->complete-path config-file) 'farm-config))))
|
||||
(site-config-options
|
||||
(dynamic-require (path->complete-path config-file) 'site-config))))
|
||||
(hash)))
|
||||
|
||||
99
pkgs/distro-build/download-page.rkt
Normal file
99
pkgs/distro-build/download-page.rkt
Normal file
|
|
@ -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)))))
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user