distro-build/drive-clients: add `--clean' argument

This commit is contained in:
Matthew Flatt 2013-06-29 11:08:44 -06:00
parent a9408289c6
commit 19dc3a00ff
2 changed files with 31 additions and 13 deletions

View File

@ -75,7 +75,7 @@ SRC_CATALOG = local
# server): # server):
SERVER = localhost SERVER = localhost
# Set to "--release" to created release-mode installers (as opposed to # Set to "--release" to create release-mode installers (as opposed to
# snapshot installers): # snapshot installers):
RELEASE_MODE = RELEASE_MODE =
@ -87,6 +87,10 @@ DIST_DIR = racket
# Configuration of clients to run for a build farm: # Configuration of clients to run for a build farm:
FARM_CONFIG = build/farm-config.rktd FARM_CONFIG = build/farm-config.rktd
# Set to "--clean" to flush client directories in a build farm
# (except as overriding in the `FARM_CONFIG' file):
CLEAN_MODE =
# A command to run after the server has started; normally set by # A command to run after the server has started; normally set by
# the `farm' target: # the `farm' target:
SERVE_DURING_CMD = SERVE_DURING_CMD =
@ -283,7 +287,7 @@ win32-installer-from-bundle:
# ------------------------------------------------------------ # ------------------------------------------------------------
# Drive installer build: # Drive installer build:
DRIVE_ARGS = $(RELEASE_MODE) "$(FARM_CONFIG)" $(SERVER) "$(PKGS)" "$(DIST_NAME)" $(DIST_DIR) DRIVE_ARGS = $(RELEASE_MODE) $(CLEAN_MODE) "$(FARM_CONFIG)" $(SERVER) "$(PKGS)" "$(DIST_NAME)" $(DIST_DIR)
DRIVE_CMD = $(RACKET) -l- distro-build/drive-clients $(DRIVE_ARGS) DRIVE_CMD = $(RACKET) -l- distro-build/drive-clients $(DRIVE_ARGS)
# Full server build and clients drive, based on `FARM_CONFIG': # Full server build and clients drive, based on `FARM_CONFIG':

View File

@ -89,6 +89,7 @@
;; failure; defaults to 30 minutes ;; failure; defaults to 30 minutes
;; #:repo <string> --- the git repository for Racket; defaults to ;; #:repo <string> --- the git repository for Racket; defaults to
;; "http://<server>:9440/.git" ;; "http://<server>:9440/.git"
;; #:clean? <boolean> --- override default cleaning mode
;; ;;
;; Machine-only keywords: ;; Machine-only keywords:
;; #:name <string> --- defaults to host ;; #:name <string> --- defaults to host
@ -106,12 +107,15 @@
;; ---------------------------------------- ;; ----------------------------------------
(define release? #f) (define release? #f)
(define default-clean? #f)
(define-values (config-file default-server default-pkgs default-dist-name default-dist-dir) (define-values (config-file default-server default-pkgs default-dist-name default-dist-dir)
(command-line (command-line
#:once-each #:once-each
[("--release") "Create release-mode installers" [("--release") "Create release-mode installers"
(set! release? #t)] (set! release? #t)]
[("--clean") "Erase client directories before building"
(set! default-clean? #t)]
#:args (config-file server pkgs dist-name dist-dir) #:args (config-file server pkgs dist-name dist-dir)
(values config-file server pkgs dist-name dist-dir))) (values config-file server pkgs dist-name dist-dir)))
@ -143,6 +147,7 @@
[(#:timeout) (real? val)] [(#:timeout) (real? val)]
[(#:j) (exact-positive-integer? val)] [(#:j) (exact-positive-integer? val)]
[(#:repo) (string? val)] [(#:repo) (string? val)]
[(#:clean?) (boolean? val)]
[else #f])) [else #f]))
(define (check-machine-keyword kw val) (define (check-machine-keyword kw val)
@ -221,8 +226,8 @@
(hash-set opts (car c) (cadr c)))] (hash-set opts (car c) (cadr c)))]
[else opts]))) [else opts])))
(define (get-opt opts kw) (define (get-opt opts kw [default #f])
(hash-ref opts kw #f)) (hash-ref opts kw default))
(define (get-content c) (define (get-content c)
(let loop ([c (cdr c)]) (let loop ([c (cdr c)])
@ -335,12 +340,13 @@
(define (ssh-script host port user . cmds) (define (ssh-script host port user . cmds)
(for/and ([cmd (in-list cmds)]) (for/and ([cmd (in-list cmds)])
(apply system*/show ssh (or (not cmd)
"-p" (~a port) (apply system*/show ssh
(if user "-p" (~a port)
(~a user "@" host) (if user
host) (~a user "@" host)
cmd))) host)
cmd))))
(define (q s) (define (q s)
(~a "\"" s "\"")) (~a "\"" s "\""))
@ -352,7 +358,7 @@
" DIST_DIR=" dist-dir " DIST_DIR=" dist-dir
" RELEASE_MODE=" (if release? "--release" (q "")))) " RELEASE_MODE=" (if release? "--release" (q ""))))
(define (unix-build c host port user server repo (define (unix-build c host port user server repo clean?
pkgs dist-name dist-dir) pkgs dist-name dist-dir)
(define dir (or (get-opt c '#:dir) (define dir (or (get-opt c '#:dir)
"build/plt")) "build/plt"))
@ -361,6 +367,8 @@
(define j (or (get-opt c '#:j) 1)) (define j (or (get-opt c '#:j) 1))
(ssh-script (ssh-script
host port user host port user
(and clean?
(sh "rm -rf " (q dir)))
(sh "if [ ! -d " (q dir) " ] ; then" (sh "if [ ! -d " (q dir) " ] ; then"
" git clone " (q repo) " " (q dir) " ; " " git clone " (q repo) " " (q dir) " ; "
"fi") "fi")
@ -370,7 +378,7 @@
"make -j " j " client" "make -j " j " client"
(client-args server pkgs dist-name dist-dir)))) (client-args server pkgs dist-name dist-dir))))
(define (windows-build c host port user server repo (define (windows-build c host port user server repo clean?
pkgs dist-name dist-dir) pkgs dist-name dist-dir)
(define dir (or (get-opt c '#:dir) (define dir (or (get-opt c '#:dir)
"build\\plt")) "build\\plt"))
@ -383,6 +391,8 @@
(list "cmd" "/c" (apply ~a args))) (list "cmd" "/c" (apply ~a args)))
(ssh-script (ssh-script
host port user host port user
(and clean?
(cmd "IF EXIST " (q dir) " rmdir /S /Q " (q dir)))
(cmd "IF NOT EXIST " (q dir) " git clone " (q repo) " " (q dir)) (cmd "IF NOT EXIST " (q dir) " git clone " (q repo) " " (q dir))
(cmd "cd " (q dir) (cmd "cd " (q dir)
" && git pull") " && git pull")
@ -407,10 +417,14 @@
default-dist-dir)) default-dist-dir))
(define repo (or (get-opt c '#:repo) (define repo (or (get-opt c '#:repo)
(~a "http://" server ":9440/.git"))) (~a "http://" server ":9440/.git")))
(define clean? (let ([v (get-opt c '#:clean? 'none)])
(if (eq? v 'none)
default-clean?
v)))
((case (or (get-opt c '#:platform) 'unix) ((case (or (get-opt c '#:platform) 'unix)
[(unix) unix-build] [(unix) unix-build]
[else windows-build]) [else windows-build])
c host port user server repo c host port user server repo clean?
pkgs dist-name dist-dir)) pkgs dist-name dist-dir))
;; ---------------------------------------- ;; ----------------------------------------