summaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/image.scm57
1 files changed, 42 insertions, 15 deletions
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index de975360ae9..df7fa2c3905 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -363,16 +363,27 @@ set to the given OS."
363 (guix build utils)) 363 (guix build utils))
364 gexp* ...)))) 364 gexp* ...))))
365 365
366(define (partition-has-flag? partition flag)
367 "Return true if PARTITION's flags include FLAG."
368 (member flag (partition-flags partition)))
369
370(define (find-partition-with-flag image flag)
371 "Return partition of the given IMAGE that has FLAG, or #f if not found."
372 (srfi-1:find (cut partition-has-flag? <> flag)
373 (image-partitions image)))
374
366(define (root-partition? partition) 375(define (root-partition? partition)
367 "Return true if PARTITION is the root partition, false otherwise." 376 "Return true if PARTITION is the root partition, false otherwise."
368 (member 'boot (partition-flags partition))) 377 (partition-has-flag? partition 'boot))
369 378
370(define (find-root-partition image) 379(define (find-root-partition image)
371 "Return the root partition of the given IMAGE." 380 (or (find-partition-with-flag image 'boot)
372 (or (srfi-1:find root-partition? (image-partitions image))
373 (raise (formatted-message 381 (raise (formatted-message
374 (G_ "image lacks a partition with the 'boot' flag"))))) 382 (G_ "image lacks a partition with the 'boot' flag")))))
375 383
384(define (find-esp-partition image)
385 (find-partition-with-flag image 'esp))
386
376(define (root-partition-index image) 387(define (root-partition-index image)
377 "Return the index of the root partition of the given IMAGE." 388 "Return the index of the root partition of the given IMAGE."
378 (1+ (srfi-1:list-index root-partition? (image-partitions image)))) 389 (1+ (srfi-1:list-index root-partition? (image-partitions image))))
@@ -980,6 +991,19 @@ it can be used for bootloading."
980 991
981 (let* ((root-file-system-type (image->root-file-system image)) 992 (let* ((root-file-system-type (image->root-file-system image))
982 (base-os (image-operating-system image)) 993 (base-os (image-operating-system image))
994 (esp-partition (find-esp-partition image))
995 ;; In case the user has added /boot/efi file-system,
996 ;; try to respect it and add a file-system pointing
997 ;; to the correct esp.
998 (wants-boot-efi? (and
999 (srfi-1:any
1000 (lambda (fs)
1001 (let ((mount-point (file-system-mount-point fs)))
1002 (string=? mount-point "/boot/efi")))
1003 (operating-system-file-systems base-os))
1004 esp-partition))
1005 ;; Replace root file system with one with proper UUID that the
1006 ;; target image will have. Similarly for /boot/efi.
983 (file-systems-to-keep 1007 (file-systems-to-keep
984 (srfi-1:remove 1008 (srfi-1:remove
985 (lambda (fs) 1009 (lambda (fs)
@@ -1006,19 +1030,22 @@ it can be used for bootloading."
1006 (inherit 1030 (inherit
1007 (operating-system-bootloader base-os)) 1031 (operating-system-bootloader base-os))
1008 (bootloader grub-mkrescue-bootloader)) 1032 (bootloader grub-mkrescue-bootloader))
1009 (operating-system-bootloader base-os))) 1033 (operating-system-bootloader base-os)))))
1010 (file-systems (cons (file-system
1011 (mount-point "/")
1012 (device "/dev/placeholder")
1013 (type root-file-system-type))
1014 file-systems-to-keep))))
1015 (uuid (root-uuid os))) 1034 (uuid (root-uuid os)))
1016 (operating-system 1035 (operating-system
1017 (inherit os) 1036 (inherit os)
1018 (file-systems (cons (file-system 1037 (file-systems (append
1019 (mount-point "/") 1038 (list (file-system
1020 (device uuid) 1039 (mount-point "/")
1021 (type root-file-system-type)) 1040 (device uuid)
1041 (type root-file-system-type)))
1042 (if wants-boot-efi?
1043 (list (file-system
1044 (mount-point "/boot/efi")
1045 (type "vfat")
1046 (device (file-system-label
1047 (partition-label esp-partition)))))
1048 '())
1022 file-systems-to-keep))))) 1049 file-systems-to-keep)))))
1023 1050
1024(define* (system-image image) 1051(define* (system-image image)