summaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2020-05-23 19:09:14 +0200
committerMathieu Othacehe <othacehe@gnu.org>2020-05-29 08:37:13 +0200
commit7feefb3b82186be382725ac2d6b7e9f8953e4a83 (patch)
tree6b352b4bdeec4425ba647047a056a94b3f16ef6d /gnu/system
parent7c5c21fd467cb4554a39569087a118621fc42ec3 (diff)
bootloader: Add 'disk-image-installer'.
* gnu/bootloader.scm (<bootloader>)[disk-image-installer]: New field, (bootloader-disk-image-installer): export it. * gnu/bootloader/grub.scm (install-grub-disk-image): New procedure ... (grub-bootloader): ... used as "disk-image-installer" here. (grub-efi-bootloader): set "disk-image-installer" to #f. * gnu/system/image.scm (root-partition?, find-root-partition): Move to "Helpers" section. (root-partition-index): New procedure. (system-disk-image): Honor disk-image-installer, and use it to install the bootloader directly on the disk-image, if supported.
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/image.scm32
1 files changed, 22 insertions, 10 deletions
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index a1214dd20a..92b3f4424e 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -147,6 +147,18 @@
(guix build utils))
gexp* ...))))
+(define (root-partition? partition)
+ "Return true if PARTITION is the root partition, false otherwise."
+ (member 'boot (partition-flags partition)))
+
+(define (find-root-partition image)
+ "Return the root partition of the given IMAGE."
+ (srfi-1:find root-partition? (image-partitions image)))
+
+(define (root-partition-index image)
+ "Return the index of the root partition of the given IMAGE."
+ (1+ (srfi-1:list-index root-partition? (image-partitions image))))
+
;;
;; Disk image.
@@ -276,9 +288,17 @@ image ~a {
(let* ((substitutable? (image-substitutable? image))
(builder
(with-imported-modules*
- (let ((inputs '#+(list genimage coreutils findutils)))
+ (let ((inputs '#+(list genimage coreutils findutils))
+ (bootloader-installer
+ #+(bootloader-disk-image-installer bootloader)))
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
- (genimage #$(image->genimage-cfg image) #$output))))
+ (genimage #$(image->genimage-cfg image) #$output)
+ ;; Install the bootloader directly on the disk-image.
+ (when bootloader-installer
+ (bootloader-installer
+ #+(bootloader-package bootloader)
+ #$(root-partition-index image)
+ (string-append #$output "/" #$genimage-name))))))
(image-dir (computed-file "image-dir" builder)))
(computed-file name
#~(symlink
@@ -371,14 +391,6 @@ used in the image. "
;; Image creation.
;;
-(define (root-partition? partition)
- "Return true if PARTITION is the root partition, false otherwise."
- (member 'boot (partition-flags partition)))
-
-(define (find-root-partition image)
- "Return the root partition of the given IMAGE."
- (srfi-1:find root-partition? (image-partitions image)))
-
(define (image->root-file-system image)
"Return the IMAGE root partition file-system type."
(let ((format (image-format image)))