diff mbox series

[bug#51598,2/2] image: Support generating GPT images via `partition-table-type`

Message ID 20211104083511.11852-2-ryan@arctype.co
State Accepted
Headers show
Series [bug#51599,1/2] gnu: genimage: upgrade to v14 | expand

Checks

Context Check Description
cbaines/applying patch fail View Laminar job
cbaines/issue success View issue

Commit Message

Ryan Sundberg Nov. 4, 2021, 8:35 a.m. UTC 
* gnu/image.scm: Add partition-table-type field to image
* gnu/system/image.scm: Implement partition-table-type logic for
genimage.
---
 gnu/image.scm        |  3 +++
 gnu/system/image.scm | 59 +++++++++++++++++++++++++++++++-------------
 2 files changed, 45 insertions(+), 17 deletions(-)

Comments

Mathieu Othacehe Nov. 12, 2021, 1:37 p.m. UTC | #1 
Hello Ryan

Nice one! I tried to generate a GPT image like so:

--8<---------------cut here---------------start------------->8---
$ cat /tmp/my-img.scm
(use-modules (gnu)
             (gnu image)
             (gnu system image))

(define my-os
  (primitive-load "/home/mathieu/guix/gnu/system/examples/lightweight-desktop.tmpl"))

(image
 (inherit
  (os->image my-os #:type efi-raw-image-type))
 (name 'raw-gpt)
 (partition-table-type 'gpt))

$ ./pre-inst-env guix system image /tmp/img.scm
--8<---------------cut here---------------end--------------->8---

However, the resulting image was not bootable because Grub was lacking
the part_gpt module. This is now fixed with
fb3df2011692b2a6fea9f4fefd71dd788453fbae.

I also noticed that trying to build a GPT image with a grub-bootloader
(bare-bones.tmpl image for instance), failed at build time, probably
because install-grub-disk-image is expecting an msdos partition.

It would be great if you could have a look to this issue as a follow-up :).

I pushed this patch anyway as 096a2bf8c59a955c634cc838e7f7111941c07b37.

Thanks,

Mathieu
diff mbox series

Patch

diff --git a/gnu/image.scm b/gnu/image.scm
index 75d489490d..b83c4275da 100644
--- a/gnu/image.scm
+++ b/gnu/image.scm
@@ -37,6 +37,7 @@ 
             image-target
             image-size
             image-operating-system
+            image-partition-table-type
             image-partitions
             image-compression?
             image-volatile-root?
@@ -84,6 +85,8 @@ 
                       (default 'guess))
   (operating-system   image-operating-system  ;<operating-system>
                       (default #f))
+  (partition-table-type image-partition-table-type ; 'mbr or 'gpt
+                      (default 'mbr))
   (partitions         image-partitions ;list of <partition>
                       (default '()))
   (compression?       image-compression? ;boolean
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index 7a3a637e47..ed22484a62 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -309,6 +309,14 @@  used in the image."
          ((member 'esp flags) "0xEF")
          (else "0x83"))))
 
+    (define (partition->gpt-type partition)
+      ;; Return the genimage GPT partition type code corresponding to PARTITION.
+      ;; See https://github.com/pengutronix/genimage/blob/master/README.rst
+      (let ((flags (partition-flags partition)))
+        (cond
+          ((member 'esp flags) "U")
+          (else "L"))))
+
     (define (partition-image partition)
       ;; Return as a file-like object, an image of the given PARTITION.  A
       ;; directory, filled by calling the PARTITION initializer procedure, is
@@ -358,26 +366,43 @@  used in the image."
                        #:local-build? #f
                        #:options `(#:references-graphs ,inputs))))
 
-    (define (partition->config partition)
+    (define (gpt-image? image)
+      (eq? 'gpt (image-partition-table-type image)))
+
+    (define (partition-type-values image partition)
+      (if (gpt-image? image)
+          (values "partition-type-uuid" (partition->gpt-type partition))
+          (values "partition-type" (partition->dos-type partition))))
+
+    (define (partition->config image partition)
       ;; Return the genimage partition configuration for PARTITION.
-      (let ((label (partition-label partition))
-            (dos-type (partition->dos-type partition))
-            (image (partition-image partition))
-            (offset (partition-offset partition)))
-        #~(format #f "~/partition ~a {
-~/~/partition-type = ~a
-~/~/image = \"~a\"
-~/~/offset = \"~a\"
-~/}"
-                  #$label
-                  #$dos-type
-                  #$image
-                  #$offset)))
+      (let-values (((partition-type-attribute partition-type-value) (partition-type-values image partition)))
+        (let ((label (partition-label partition))
+              (image (partition-image partition))
+              (offset (partition-offset partition)))
+          #~(format #f "~/partition ~a {
+  ~/~/~a = ~a
+  ~/~/image = \"~a\"
+  ~/~/offset = \"~a\"
+  ~/}"
+                    #$label
+                    #$partition-type-attribute
+                    #$partition-type-value
+                    #$image
+                    #$offset))))
+
+    (define (genimage-type-options image-type image)
+      (cond
+        ((equal? image-type "hdimage")
+         (format #f "~%~/~/gpt = ~a~%~/" 
+                 (if (gpt-image? image) "true" "false")))
+        (else "")))
 
     (let* ((format (image-format image))
            (image-type (format->image-type format))
+           (image-type-options (genimage-type-options image-type image))
            (partitions (image-partitions image))
-           (partitions-config (map partition->config partitions))
+           (partitions-config (map (cut partition->config image <>) partitions))
            (builder
             #~(begin
                 (let ((format (@ (ice-9 format) format)))
@@ -386,9 +411,9 @@  used in the image."
                       (format port
                               "\
 image ~a {
-~/~a {}
+~/~a {~a}
 ~{~a~^~%~}
-}~%" #$genimage-name #$image-type (list #$@partitions-config))))))))
+}~%" #$genimage-name #$image-type #$image-type-options (list #$@partitions-config))))))))
       (computed-file "genimage.cfg" builder)))
 
   (let* ((image-name (image-name image))