Build native bases from materialized FreeBSD sources
This commit is contained in:
@@ -26,6 +26,7 @@
|
||||
freebsd-base-kernconf
|
||||
freebsd-base-make-flags
|
||||
%default-freebsd-base
|
||||
freebsd-package
|
||||
freebsd-package?
|
||||
freebsd-package-name
|
||||
freebsd-package-version
|
||||
|
||||
@@ -300,7 +300,8 @@
|
||||
`((build-version . ,native-freebsd-build-version)
|
||||
(source-root . ,source-root)
|
||||
(source-tree-identity-mode . "mtree:type,link,size,mode,sha256digest")
|
||||
(source-tree-sha256 . ,(native-build-source-tree-sha256 source-root))
|
||||
(source-tree-sha256 . ,(or (build-plan-ref plan 'materialized-source-tree-sha256 #f)
|
||||
(native-build-source-tree-sha256 source-root)))
|
||||
(target . ,target)
|
||||
(target-arch . ,target-arch)
|
||||
(kernconf . ,kernconf)
|
||||
@@ -323,11 +324,25 @@
|
||||
(commit . ,(build-plan-ref plan 'base-source-commit #f))
|
||||
(sha256 . ,(build-plan-ref plan 'base-source-sha256 #f))))
|
||||
|
||||
(define (native-build-materialized-source plan)
|
||||
`((store-path . ,(build-plan-ref plan 'materialized-source-store #f))
|
||||
(source-root . ,(build-plan-ref plan 'source-root "/usr/src"))
|
||||
(info-file . ,(build-plan-ref plan 'materialized-source-info-file #f))
|
||||
(tree-sha256 . ,(build-plan-ref plan 'materialized-source-tree-sha256 #f))
|
||||
(cache-path . ,(build-plan-ref plan 'materialized-source-cache-path #f))
|
||||
(effective-source . ((kind . ,(build-plan-ref plan 'effective-source-kind #f))
|
||||
(url . ,(build-plan-ref plan 'effective-source-url #f))
|
||||
(path . ,(build-plan-ref plan 'effective-source-path #f))
|
||||
(ref . ,(build-plan-ref plan 'effective-source-ref #f))
|
||||
(commit . ,(build-plan-ref plan 'effective-source-commit #f))
|
||||
(sha256 . ,(build-plan-ref plan 'effective-source-sha256 #f))))))
|
||||
|
||||
(define (native-build-manifest-string package input-paths)
|
||||
(let* ((plan (freebsd-package-install-plan package))
|
||||
(common (native-build-common-manifest plan))
|
||||
(declared-base (native-build-declared-base plan))
|
||||
(declared-source (native-build-declared-source plan))
|
||||
(materialized-source (native-build-materialized-source plan))
|
||||
(keep-paths (build-plan-ref plan 'keep-paths '()))
|
||||
(prune-paths (build-plan-ref plan 'prune-paths '())))
|
||||
(string-append
|
||||
@@ -339,6 +354,8 @@
|
||||
(object->string declared-base)
|
||||
"\ndeclared-source=\n"
|
||||
(object->string declared-source)
|
||||
"\nmaterialized-source=\n"
|
||||
(object->string materialized-source)
|
||||
"\nnative-build-common=\n"
|
||||
(object->string common)
|
||||
"\nkeep-paths=\n"
|
||||
@@ -493,6 +510,7 @@
|
||||
(version . ,(freebsd-package-version package))
|
||||
(declared-base . ,(native-build-declared-base plan))
|
||||
(declared-source . ,(native-build-declared-source plan))
|
||||
(materialized-source . ,(native-build-materialized-source plan))
|
||||
(build-system . ,(freebsd-package-build-system package))
|
||||
(source-root . ,(assoc-ref common 'source-root))
|
||||
(source-tree-sha256 . ,(assoc-ref common 'source-tree-sha256))
|
||||
@@ -550,38 +568,101 @@
|
||||
(write-file (string-append output-path "/.freebsd-native-build-info.scm")
|
||||
(object->string (native-build-output-metadata package common build-root final-stage-root)))))
|
||||
|
||||
(define (package-cache-key package)
|
||||
(string-append (freebsd-package-name package) "-" (freebsd-package-version package)))
|
||||
(define (package-with-install-plan package install-plan)
|
||||
(freebsd-package
|
||||
#:name (freebsd-package-name package)
|
||||
#:version (freebsd-package-version package)
|
||||
#:build-system (freebsd-package-build-system package)
|
||||
#:inputs (freebsd-package-inputs package)
|
||||
#:home-page (freebsd-package-home-page package)
|
||||
#:synopsis (freebsd-package-synopsis package)
|
||||
#:description (freebsd-package-description package)
|
||||
#:license (freebsd-package-license package)
|
||||
#:install-plan install-plan))
|
||||
|
||||
(define (materialize-freebsd-package package store-dir cache)
|
||||
(let ((cached (hash-ref cache (package-cache-key package) #f)))
|
||||
(define (plan-freebsd-source plan)
|
||||
(freebsd-source #:name (build-plan-ref plan 'base-source-name "default")
|
||||
#:kind (build-plan-ref plan 'base-source-kind 'local-tree)
|
||||
#:url (build-plan-ref plan 'base-source-url #f)
|
||||
#:path (build-plan-ref plan 'base-source-path #f)
|
||||
#:ref (build-plan-ref plan 'base-source-ref #f)
|
||||
#:commit (build-plan-ref plan 'base-source-commit #f)
|
||||
#:sha256 (build-plan-ref plan 'base-source-sha256 #f)))
|
||||
|
||||
(define (source-cache-key source)
|
||||
(string-hash (object->string (freebsd-source-spec source))))
|
||||
|
||||
(define (materialize-freebsd-source/cached source store-dir source-cache)
|
||||
(let* ((key (source-cache-key source))
|
||||
(cached (hash-ref source-cache key #f)))
|
||||
(or cached
|
||||
(let ((result (materialize-freebsd-source source #:store-dir store-dir)))
|
||||
(hash-set! source-cache key result)
|
||||
result))))
|
||||
|
||||
(define (plan-with-materialized-source plan source-result)
|
||||
(let* ((effective (assoc-ref source-result 'effective-source))
|
||||
(overrides
|
||||
`((source-root . ,(assoc-ref source-result 'source-root))
|
||||
(materialized-source-store . ,(assoc-ref source-result 'source-store-path))
|
||||
(materialized-source-info-file . ,(assoc-ref source-result 'source-info-file))
|
||||
(materialized-source-tree-sha256 . ,(assoc-ref source-result 'source-tree-sha256))
|
||||
(materialized-source-cache-path . ,(assoc-ref source-result 'cache-path))
|
||||
(effective-source-kind . ,(assoc-ref effective 'kind))
|
||||
(effective-source-url . ,(assoc-ref effective 'url))
|
||||
(effective-source-path . ,(assoc-ref effective 'path))
|
||||
(effective-source-ref . ,(assoc-ref effective 'ref))
|
||||
(effective-source-commit . ,(assoc-ref effective 'commit))
|
||||
(effective-source-sha256 . ,(assoc-ref effective 'sha256)))))
|
||||
(append overrides plan)))
|
||||
|
||||
(define* (materialize-freebsd-package package store-dir cache #:optional source-cache)
|
||||
(let* ((source-cache (or source-cache (make-hash-table)))
|
||||
(input-paths (map (lambda (input)
|
||||
(materialize-freebsd-package input store-dir cache source-cache))
|
||||
(freebsd-package-inputs package)))
|
||||
(prepared-package
|
||||
(if (freebsd-native-build-package? package)
|
||||
(let* ((source (plan-freebsd-source (freebsd-package-install-plan package)))
|
||||
(source-result (materialize-freebsd-source/cached source store-dir source-cache))
|
||||
(plan (plan-with-materialized-source (freebsd-package-install-plan package)
|
||||
source-result)))
|
||||
(package-with-install-plan package plan))
|
||||
package))
|
||||
(effective-input-paths
|
||||
(if (freebsd-native-build-package? package)
|
||||
(cons (build-plan-ref (freebsd-package-install-plan prepared-package)
|
||||
'materialized-source-store
|
||||
#f)
|
||||
input-paths)
|
||||
input-paths))
|
||||
(effective-input-paths (filter identity effective-input-paths))
|
||||
(manifest (package-manifest-string prepared-package effective-input-paths))
|
||||
(cache-key (string-hash manifest))
|
||||
(cached (hash-ref cache cache-key #f)))
|
||||
(if cached
|
||||
cached
|
||||
(let* ((input-paths (map (lambda (input)
|
||||
(materialize-freebsd-package input store-dir cache))
|
||||
(freebsd-package-inputs package)))
|
||||
(manifest (package-manifest-string package input-paths))
|
||||
(hash (string-hash manifest))
|
||||
(let* ((hash (string-hash manifest))
|
||||
(output-path (string-append store-dir "/" hash "-"
|
||||
(freebsd-package-name package)
|
||||
(freebsd-package-name prepared-package)
|
||||
"-"
|
||||
(freebsd-package-version package))))
|
||||
(freebsd-package-version prepared-package))))
|
||||
(unless (file-exists? output-path)
|
||||
(case (freebsd-package-build-system package)
|
||||
(case (freebsd-package-build-system prepared-package)
|
||||
((copy-build-system)
|
||||
(mkdir-p output-path)
|
||||
(for-each (lambda (entry)
|
||||
(materialize-plan-entry output-path entry))
|
||||
(freebsd-package-install-plan package))
|
||||
(freebsd-package-install-plan prepared-package))
|
||||
(write-file (string-append output-path "/.references")
|
||||
(string-join input-paths "\n"))
|
||||
(string-join effective-input-paths "\n"))
|
||||
(write-file (string-append output-path "/.fruix-package") manifest))
|
||||
((freebsd-world-build-system freebsd-kernel-build-system)
|
||||
(materialize-native-freebsd-package package input-paths manifest output-path))
|
||||
(materialize-native-freebsd-package prepared-package effective-input-paths manifest output-path))
|
||||
(else
|
||||
(error (format #f "unsupported package build system: ~a"
|
||||
(freebsd-package-build-system package))))))
|
||||
(hash-set! cache (package-cache-key package) output-path)
|
||||
(freebsd-package-build-system prepared-package))))))
|
||||
(hash-set! cache cache-key output-path)
|
||||
output-path))))
|
||||
|
||||
(define prefix-materializer-version "3")
|
||||
@@ -1572,6 +1653,20 @@
|
||||
(mkdir-p tree-root)
|
||||
(walk ""))
|
||||
|
||||
(define (hash-table-values table)
|
||||
(hash-fold (lambda (_ value result)
|
||||
(cons value result))
|
||||
'()
|
||||
table))
|
||||
|
||||
(define (freebsd-source-materialization-spec result)
|
||||
`((source-store-path . ,(assoc-ref result 'source-store-path))
|
||||
(source-root . ,(assoc-ref result 'source-root))
|
||||
(source-info-file . ,(assoc-ref result 'source-info-file))
|
||||
(source-tree-sha256 . ,(assoc-ref result 'source-tree-sha256))
|
||||
(cache-path . ,(assoc-ref result 'cache-path))
|
||||
(effective-source . ,(assoc-ref result 'effective-source))))
|
||||
|
||||
(define* (materialize-operating-system os
|
||||
#:key
|
||||
(store-dir "/frx/store")
|
||||
@@ -1580,13 +1675,14 @@
|
||||
(shepherd-prefix "/tmp/shepherd-freebsd-validate-install"))
|
||||
(validate-operating-system os)
|
||||
(let* ((cache (make-hash-table))
|
||||
(source-cache (make-hash-table))
|
||||
(kernel-package (operating-system-kernel os))
|
||||
(bootloader-package (operating-system-bootloader os))
|
||||
(base-packages (operating-system-base-packages os))
|
||||
(kernel-store (materialize-freebsd-package kernel-package store-dir cache))
|
||||
(bootloader-store (materialize-freebsd-package bootloader-package store-dir cache))
|
||||
(kernel-store (materialize-freebsd-package kernel-package store-dir cache source-cache))
|
||||
(bootloader-store (materialize-freebsd-package bootloader-package store-dir cache source-cache))
|
||||
(base-package-stores (map (lambda (package)
|
||||
(materialize-freebsd-package package store-dir cache))
|
||||
(materialize-freebsd-package package store-dir cache source-cache))
|
||||
base-packages))
|
||||
(base-package-pairs (map cons base-packages base-package-stores))
|
||||
(store-classification
|
||||
@@ -1627,17 +1723,27 @@
|
||||
(freebsd-native-build-package? (car entry)))
|
||||
store-classification))))
|
||||
(fruix-runtime-stores (list guile-store guile-extra-store shepherd-store))
|
||||
(source-materializations
|
||||
(delete-duplicates (hash-table-values source-cache)))
|
||||
(materialized-source-stores
|
||||
(delete-duplicates (map (lambda (result)
|
||||
(assoc-ref result 'source-store-path))
|
||||
source-materializations)))
|
||||
(metadata-files
|
||||
`(("metadata/freebsd-base.scm"
|
||||
. ,(object->string (freebsd-base-spec (operating-system-freebsd-base os))))
|
||||
("metadata/freebsd-source.scm"
|
||||
. ,(object->string (freebsd-source-spec (freebsd-base-source (operating-system-freebsd-base os)))))
|
||||
("metadata/freebsd-source-materializations.scm"
|
||||
. ,(object->string (map freebsd-source-materialization-spec source-materializations)))
|
||||
("metadata/host-base-provenance.scm"
|
||||
. ,(object->string (host-freebsd-provenance)))
|
||||
("metadata/store-layout.scm"
|
||||
. ,(object->string
|
||||
`((freebsd-base . ,(freebsd-base-spec (operating-system-freebsd-base os)))
|
||||
(freebsd-source . ,(freebsd-source-spec (freebsd-base-source (operating-system-freebsd-base os))))
|
||||
(materialized-source-store-count . ,(length materialized-source-stores))
|
||||
(materialized-source-stores . ,materialized-source-stores)
|
||||
(host-base-store-count . ,(length host-base-stores))
|
||||
(host-base-stores . ,host-base-stores)
|
||||
(native-base-store-count . ,(length native-base-stores))
|
||||
@@ -1655,7 +1761,7 @@
|
||||
. ,(render-activation-rc-script))
|
||||
("usr/local/etc/rc.d/fruix-shepherd"
|
||||
. ,(render-rc-script shepherd-store guile-store guile-extra-store)))))
|
||||
(references (delete-duplicates (append host-base-stores native-base-stores fruix-runtime-stores)))
|
||||
(references (delete-duplicates (append materialized-source-stores host-base-stores native-base-stores fruix-runtime-stores)))
|
||||
(manifest (string-append
|
||||
"closure-spec=\n"
|
||||
(object->string (operating-system-closure-spec os))
|
||||
@@ -1714,6 +1820,8 @@
|
||||
(fruix-runtime-stores . ,fruix-runtime-stores)
|
||||
(freebsd-base-file . ,(string-append closure-path "/metadata/freebsd-base.scm"))
|
||||
(freebsd-source-file . ,(string-append closure-path "/metadata/freebsd-source.scm"))
|
||||
(freebsd-source-materializations-file . ,(string-append closure-path "/metadata/freebsd-source-materializations.scm"))
|
||||
(materialized-source-stores . ,materialized-source-stores)
|
||||
(host-base-provenance-file . ,(string-append closure-path "/metadata/host-base-provenance.scm"))
|
||||
(store-layout-file . ,(string-append closure-path "/metadata/store-layout.scm"))
|
||||
(generated-files . ,(map car generated-files))
|
||||
@@ -1981,6 +2089,9 @@
|
||||
(native-base-stores . ,(assoc-ref closure 'native-base-stores))
|
||||
(fruix-runtime-stores . ,(assoc-ref closure 'fruix-runtime-stores))
|
||||
(freebsd-base-file . ,(assoc-ref closure 'freebsd-base-file))
|
||||
(freebsd-source-file . ,(assoc-ref closure 'freebsd-source-file))
|
||||
(freebsd-source-materializations-file . ,(assoc-ref closure 'freebsd-source-materializations-file))
|
||||
(materialized-source-stores . ,(assoc-ref closure 'materialized-source-stores))
|
||||
(host-base-provenance-file . ,(assoc-ref closure 'host-base-provenance-file))
|
||||
(store-layout-file . ,(assoc-ref closure 'store-layout-file))
|
||||
(image-spec . ,image-spec)
|
||||
|
||||
Reference in New Issue
Block a user