build: image: Add optional closure copy support.

* gnu/build/image.scm (initialize-root-partition): Add a closure-copy?
argument and honor it.
This commit is contained in:
Mathieu Othacehe 2021-12-16 08:42:36 +01:00
parent 258150fd6e
commit cc4e8a84f4
No known key found for this signature in database
GPG key ID: 8354763531769CA6

View file

@ -166,6 +166,7 @@ produced by #:references-graphs. Pass WAL-MODE? to call-with-database."
bootcfg-location bootcfg-location
bootloader-package bootloader-package
bootloader-installer bootloader-installer
(copy-closures? #t)
(deduplicate? #t) (deduplicate? #t)
references-graphs references-graphs
(register-closures? #t) (register-closures? #t)
@ -176,30 +177,50 @@ produced by #:references-graphs. Pass WAL-MODE? to call-with-database."
"Initialize the given ROOT directory. Use BOOTCFG and BOOTCFG-LOCATION to "Initialize the given ROOT directory. Use BOOTCFG and BOOTCFG-LOCATION to
install the bootloader configuration. install the bootloader configuration.
If REGISTER-CLOSURES? is true, register REFERENCES-GRAPHS in the store. If If COPY-CLOSURES? is true, copy all of REFERENCES-GRAPHS to the partition. If
REGISTER-CLOSURES? is true, register REFERENCES-GRAPHS in the store. If
DEDUPLICATE? is true, then also deduplicate files common to CLOSURES and the DEDUPLICATE? is true, then also deduplicate files common to CLOSURES and the
rest of the store when registering the closures. SYSTEM-DIRECTORY is the name rest of the store when registering the closures. SYSTEM-DIRECTORY is the name
of the directory of the 'system' derivation. Pass WAL-MODE? to of the directory of the 'system' derivation. Pass WAL-MODE? to
register-closure." register-closure."
(define root-store
(string-append root (%store-directory)))
(define tmp-store ".tmp-store")
(populate-root-file-system system-directory root) (populate-root-file-system system-directory root)
(populate-store references-graphs root
#:deduplicate? deduplicate?) (when copy-closures?
(populate-store references-graphs root
#:deduplicate? deduplicate?))
;; Populate /dev. ;; Populate /dev.
(when make-device-nodes (when make-device-nodes
(make-device-nodes root)) (make-device-nodes root))
(when register-closures? (when register-closures?
(unless copy-closures?
;; XXX: 'register-closure' wants to palpate the things it registers, so
;; create a symlink to the store.
(rename-file root-store tmp-store)
(symlink (%store-directory) root-store))
(for-each (lambda (closure) (for-each (lambda (closure)
(register-closure root closure (register-closure root closure
#:wal-mode? wal-mode?)) #:wal-mode? wal-mode?))
references-graphs)) references-graphs)
(when bootloader-installer (unless copy-closures?
(display "installing bootloader...\n") (delete-file root-store)
(bootloader-installer bootloader-package #f root)) (rename-file tmp-store root-store)))
(when bootcfg
(install-boot-config bootcfg bootcfg-location root))) ;; There's no point installing a bootloader if we do not populate the store.
(when copy-closures?
(when bootloader-installer
(display "installing bootloader...\n")
(bootloader-installer bootloader-package #f root))
(when bootcfg
(install-boot-config bootcfg bootcfg-location root))))
(define* (make-iso9660-image xorriso grub-mkrescue-environment (define* (make-iso9660-image xorriso grub-mkrescue-environment
grub bootcfg system-directory root target grub bootcfg system-directory root target