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

meta/pkg-build: add support for "minimal" vs. full VMs

Browse Source 
Try building on a minimal VM, first, and then fall back to a more
general VM is that fails. For example, a minimal VM might not include
a C compiler, which can help clarify that a package will work in some
environments and not in others.
This commit is contained in:
Matthew Flatt 2014-10-24 19:02:49 -06:00
parent 8c9a9da525
commit abf76be7f0
2 changed files with 69 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
pkgs/plt-services/meta/pkg-build/main.rkt
View File

@ -58,7 +58,7 @@
;; - tier-based selection of packages on conflict ;; - tier-based selection of packages on conflict
;; - support for running tests ;; - support for running tests
(struct vm (host user dir name init-snapshot installed-snapshot)) (struct vm (host user dir name init-snapshot installed-snapshot minimal-variant))
;; Each VM must provide at least an ssh server and `tar`, and the ;; Each VM must provide at least an ssh server and `tar`, and the
;; intent is that it is otherwise isolated (e.g., no network ;; intent is that it is otherwise isolated (e.g., no network
@ -76,10 +76,13 @@
#:init-shapshot [init-snapshot "init"] #:init-shapshot [init-snapshot "init"]
;; An "installed" snapshot is created after installing Racket ;; An "installed" snapshot is created after installing Racket
;; and before building any package: ;; and before building any package:
#:installed-shapshot [installed-snapshot "installed"]) #:installed-shapshot [installed-snapshot "installed"]
;; If not #f, a `vm` that is more constrained and will be
;; tried as an installation target before this one:
#:minimal-variant [minimal-variant #f])
(unless (complete-path? dir) (unless (complete-path? dir)
(error 'vbox-vm "need a complete path for #:dir")) (error 'vbox-vm "need a complete path for #:dir"))
(vm host user dir name init-snapshot installed-snapshot)) (vm host user dir name init-snapshot installed-snapshot minimal-variant))
;; The build steps: ;; The build steps:
(define all-steps-in-order (define all-steps-in-order
@ -143,7 +146,8 @@
;; "docs/P-adds.rktd" listing of docs, exes, etc., and ;; "docs/P-adds.rktd" listing of docs, exes, etc., and
;; "success/P.txt" records success; ;; "success/P.txt" records success;
;; "install/P.txt" records installation; ;; "install/P.txt" records installation;
;; "deps/P.txt" records dependency-checking failure ;; "deps/P.txt" records dependency-checking failure;
;; "min-fail/P.txt" records failure on minimal-host attempt
;; * pkgs/P.orig-CHECKSUM matching archived catalog ;; * pkgs/P.orig-CHECKSUM matching archived catalog
;; + fail/P.txt ;; + fail/P.txt
;; => up-to-date and failed; ;; => up-to-date and failed;
@ -163,6 +167,7 @@
;; 'success-log --- #f or relative path ;; 'success-log --- #f or relative path
;; 'failure-log --- #f or relative path ;; 'failure-log --- #f or relative path
;; 'dep-failure-log --- #f or relative path ;; 'dep-failure-log --- #f or relative path
;; 'min-failure-log --- #f or relative path
;; 'docs --- list of one of ;; 'docs --- list of one of
;; * (docs/none name) ;; * (docs/none name)
;; * (docs/main name path) ;; * (docs/main name path)
@ -243,6 +248,7 @@
(define built-pkgs-dir (build-path built-dir "pkgs/")) (define built-pkgs-dir (build-path built-dir "pkgs/"))
(define built-catalog-dir (build-path built-dir "catalog")) (define built-catalog-dir (build-path built-dir "catalog"))
(define fail-dir (build-path built-dir "fail")) (define fail-dir (build-path built-dir "fail"))
(define min-fail-dir (build-path built-dir "min-fail"))
(define success-dir (build-path built-dir "success")) (define success-dir (build-path built-dir "success"))
(define install-success-dir (build-path built-dir "install")) (define install-success-dir (build-path built-dir "install"))
(define deps-fail-dir (build-path built-dir "deps")) (define deps-fail-dir (build-path built-dir "deps"))
@ -424,8 +430,11 @@
(take-vbox-snapshot (vm-name vm) (vm-installed-snapshot vm))) (take-vbox-snapshot (vm-name vm) (vm-installed-snapshot vm)))
(unless skip-install? (unless skip-install?
(install (car vms) #:one-time? #t) (for ([vm (in-list vms)]
(map install (cdr vms))) [i (in-naturals)])
(install vm #:one-time? (zero? i))
(when (vm-minimal-variant vm)
(install (vm-minimal-variant vm)))))
;; ---------------------------------------- ;; ----------------------------------------
(status "Resetting ready content of ~a\n" built-pkgs-dir) (status "Resetting ready content of ~a\n" built-pkgs-dir)
@ -449,7 +458,8 @@
(define (pkg-checksum-file pkg) (build-path built-pkgs-dir (~a pkg ".orig-CHECKSUM"))) (define (pkg-checksum-file pkg) (build-path built-pkgs-dir (~a pkg ".orig-CHECKSUM")))
(define (pkg-zip-file pkg) (build-path built-pkgs-dir (~a pkg ".zip"))) (define (pkg-zip-file pkg) (build-path built-pkgs-dir (~a pkg ".zip")))
(define (pkg-zip-checksum-file pkg) (build-path built-pkgs-dir (~a pkg ".zip.CHECKSUM"))) (define (pkg-zip-checksum-file pkg) (build-path built-pkgs-dir (~a pkg ".zip.CHECKSUM")))
(define (pkg-failure-dest pkg) (build-path fail-dir (txt pkg))) (define (pkg-failure-dest pkg #:minimal? [min? #f])
(build-path (if min? min-fail-dir fail-dir) (txt pkg)))
(define failed-pkgs (define failed-pkgs
(for/set ([pkg (in-list all-pkg-names)] (for/set ([pkg (in-list all-pkg-names)]
@ -511,9 +521,11 @@
(define zip-file (pkg-zip-file pkg)) (define zip-file (pkg-zip-file pkg))
(define zip-checksum-file (pkg-zip-checksum-file pkg)) (define zip-checksum-file (pkg-zip-checksum-file pkg))
(define failure-dest (pkg-failure-dest pkg)) (define failure-dest (pkg-failure-dest pkg))
(define min-failure-dest (pkg-failure-dest pkg #:minimal? #t))
(when (file-exists? zip-file) (delete-file zip-file)) (when (file-exists? zip-file) (delete-file zip-file))
(when (file-exists? zip-checksum-file) (delete-file zip-checksum-file)) (when (file-exists? zip-checksum-file) (delete-file zip-checksum-file))
(when (file-exists? failure-dest) (delete-file failure-dest)) (when (file-exists? failure-dest) (delete-file failure-dest))
(when (file-exists? min-failure-dest) (delete-file min-failure-dest))
(call-with-output-file* (call-with-output-file*
checksum-file checksum-file
#:exists 'truncate/replace #:exists 'truncate/replace
@ -625,6 +637,7 @@
;; ---------------------------------------- ;; ----------------------------------------
(make-directory* (build-path built-dir "adds")) (make-directory* (build-path built-dir "adds"))
(make-directory* fail-dir) (make-directory* fail-dir)
(make-directory* min-fail-dir)
(make-directory* success-dir) (make-directory* success-dir)
(make-directory* install-success-dir) (make-directory* install-success-dir)
(make-directory* deps-fail-dir) (make-directory* deps-fail-dir)
@ -645,7 +658,7 @@
#f) #f)
;; Build one package or a group of packages: ;; Build one package or a group of packages:
(define (build-pkgs vm pkgs) (define (build-pkgs vm pkgs #:minimal? [minimal? #f])
(define flat-pkgs (flatten pkgs)) (define flat-pkgs (flatten pkgs))
;; one-pkg can be a list in the case of mutual dependencies: ;; one-pkg can be a list in the case of mutual dependencies:
(define one-pkg (and (= 1 (length pkgs)) (car pkgs))) (define one-pkg (and (= 1 (length pkgs)) (car pkgs)))
@ -663,7 +676,7 @@
(show-list pkgs))) (show-list pkgs)))
(define failure-dest (and one-pkg (define failure-dest (and one-pkg
(pkg-failure-dest (car flat-pkgs)))) (pkg-failure-dest (car flat-pkgs) #:minimal? minimal?)))
(define install-success-dest (build-path install-success-dir (define install-success-dest (build-path install-success-dir
(txt (car flat-pkgs)))) (txt (car flat-pkgs))))
@ -743,6 +756,7 @@
#t))) #t)))
(define doc-ok? (define doc-ok?
(and (and
(or ok? (not minimal?))
;; If we're building a single package (or set of mutually ;; If we're building a single package (or set of mutually
;; dependent packages), then try to save generated documentation ;; dependent packages), then try to save generated documentation
;; even on failure. We'll put it in the "dumpster". ;; even on failure. We'll put it in the "dumpster".
@ -764,6 +778,9 @@
(for ([pkg (in-list flat-pkgs)]) (for ([pkg (in-list flat-pkgs)])
(when (file-exists? (pkg-failure-dest pkg)) (when (file-exists? (pkg-failure-dest pkg))
(delete-file (pkg-failure-dest pkg))) (delete-file (pkg-failure-dest pkg)))
(when (and minimal?
(file-exists? (pkg-failure-dest pkg #:minimal? #t)))
(delete-file (pkg-failure-dest pkg #:minimal? #t)))
(when (and deps-ok? (file-exists? (pkg-deps-failure-dest pkg))) (when (and deps-ok? (file-exists? (pkg-deps-failure-dest pkg)))
(delete-file (pkg-deps-failure-dest pkg))) (delete-file (pkg-deps-failure-dest pkg)))
(scp rt (at-vm vm (~a there-dir "/built/" pkg ".zip")) (scp rt (at-vm vm (~a there-dir "/built/" pkg ".zip"))
@ -788,7 +805,9 @@
(for ([pkg (in-list flat-pkgs)]) (for ([pkg (in-list flat-pkgs)])
(when (list? one-pkg) (when (list? one-pkg)
(unless (equal? pkg (car one-pkg)) (unless (equal? pkg (car one-pkg))
(copy-file failure-dest (pkg-failure-dest (car one-pkg)) #t))) (copy-file failure-dest
(pkg-failure-dest (car one-pkg) #:minimal? minimal?)
#t)))
(save-checksum pkg)) (save-checksum pkg))
;; Keep any docs that might have been built: ;; Keep any docs that might have been built:
(for ([pkg (in-list flat-pkgs)]) (for ([pkg (in-list flat-pkgs)])
@ -810,8 +829,19 @@
;; if the big group fails: ;; if the big group fails:
(define (build-pkg-set vm pkgs) (define (build-pkg-set vm pkgs)
(define len (length pkgs)) (define len (length pkgs))
(define has-minimal? (and (vm-minimal-variant vm) #t))
(define ok? (and (len . <= . max-build-together) (define ok? (and (len . <= . max-build-together)
(build-pkgs vm pkgs))) (or
;; Here's the main build attempt:
(build-pkgs (if has-minimal?
(vm-minimal-variant vm)
vm)
pkgs
#:minimal? has-minimal?)
;; ... but if that was minimal, try again
;; with the non-minimal variant:
(and has-minimal?
(build-pkgs vm pkgs #:minimal? #f)))))
(flush-chunk-output) (flush-chunk-output)
(unless (or ok? (= 1 len)) (unless (or ok? (= 1 len))
(define part (min (quotient len 2) (define part (min (quotient len 2)
@ -1157,6 +1187,12 @@
'failure 'failure
'success) 'success)
'unknown)) 'unknown))
(define min-status
(if (eq? status 'success)
(if (file-exists? (build-path min-fail-dir (txt pkg)))
'failure
'success)
'unknown))
(define adds (let ([adds-file (if (eq? status 'success) (define adds (let ([adds-file (if (eq? status 'success)
(pkg-adds-file pkg) (pkg-adds-file pkg)
(build-path dumpster-adds-dir (format "~a-adds.rktd" pkg)))]) (build-path dumpster-adds-dir (format "~a-adds.rktd" pkg)))])
@ -1180,6 +1216,8 @@
(path->relative (pkg-failure-dest pkg))) (path->relative (pkg-failure-dest pkg)))
'dep-failure-log (and (eq? dep-status 'failure) 'dep-failure-log (and (eq? dep-status 'failure)
(path->relative (build-path deps-fail-dir (txt pkg)))) (path->relative (build-path deps-fail-dir (txt pkg))))
'min-failure-log (and (eq? min-status 'failure)
(path->relative (build-path min-fail-dir (txt pkg))))
'docs (for/list ([doc (in-list docs)]) 'docs (for/list ([doc (in-list docs)])
(define path (~a "doc/" (~a doc "@" pkg) "/index.html")) (define path (~a "doc/" (~a doc "@" pkg) "/index.html"))
(if (or (not (eq? status 'success)) (if (or (not (eq? status 'success))

22
pkgs/plt-services/meta/pkg-build/summary.rkt
View File

@ -44,6 +44,12 @@
'failure 'failure
'success) 'success)
'unknown)) 'unknown))
(define min-status
(if (eq? status 'success)
(if (hash-ref ht 'min-failure-log)
'failure
'success)
'unknown))
(define docs (hash-ref ht 'docs)) (define docs (hash-ref ht 'docs))
(define author (hash-ref ht 'author)) (define author (hash-ref ht 'author))
(define conflicts-log (hash-ref ht 'conflicts-log)) (define conflicts-log (hash-ref ht 'conflicts-log))
@ -77,7 +83,10 @@
[(success) [(success)
(case dep-status (case dep-status
[(failure) "yield"] [(failure) "yield"]
[else "go"])] [else
(case min-status
[(failure) "ok"]
[else "go"])])]
[else "unknown"]) [else "unknown"])
(case status (case status
[(failure) [(failure)
@ -92,7 +101,15 @@
(list (list
" with " " with "
(a href: (hash-ref ht 'dep-failure-log) (a href: (hash-ref ht 'dep-failure-log)
"dependency problems"))]))] "dependency problems"))])
(case min-status
[(failure)
(list
(if (eq? dep-status 'failure)
" and with "
" with ")
(a href: (hash-ref ht 'min-failure-log)
"extra system dependencies"))]))]
[(confusion) [(confusion)
(list (list
"install both " "install both "
@ -114,6 +131,7 @@
(define page-headers (define page-headers
(style/inline @~a|{ (style/inline @~a|{
.go { background-color: #ccffcc } .go { background-color: #ccffcc }
.ok { background-color: #ccffff }
.stop { background-color: #ffcccc } .stop { background-color: #ffcccc }
.yield { background-color: #ffffcc } .yield { background-color: #ffffcc }
.author { font-size: small; font-weight: normal; } .author { font-size: small; font-weight: normal; }