bug#55406: [PATCH] GUIX Image API support for vfat and boot flag

bug#55406: [PATCH] GUIX Image API support for vfat and boot flag

[Pavel Shlyak]

[-- Attachment #1: Type: text/plain, Size: 30 bytes --]

Ok, I tried to format them :)

[-- Attachment #2: 0001-Image-API-support-VFAT-partitions-in-MBR.patch --]
[-- Type: application/octet-stream, Size: 1399 bytes --]

From ec65ce70cfb26a9936099cdb0d1a156a747fa42b Mon Sep 17 00:00:00 2001
From: Pavel Shlyak <p.shlyak@pantherx.org>
Date: Sun, 22 May 2022 16:52:45 +0300
Subject: [PATCH 1/4] Image API: support VFAT partitions in MBR

---
 gnu/system/image.scm | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index 42e215f614..a83f844682 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -304,10 +304,15 @@ (define (format->image-type format)
     (define (partition->dos-type partition)
       ;; Return the MBR partition type corresponding to the given PARTITION.
       ;; See: https://en.wikipedia.org/wiki/Partition_type.
-      (let ((flags (partition-flags partition)))
+      (let ((flags (partition-flags partition)) (file-system (partition-file-system partition)))
         (cond
-         ((member 'esp flags) "0xEF")
-         (else "0x83"))))
+          ((member 'esp flags) "0xEF")
+          ((string-prefix? "ext" file-system) "0x83")
+          ((string=? file-system "vfat") "0x0E")
+          (else
+            (raise (condition
+              (&message
+               (message "unsupported partition type"))))))))
 
     (define (partition->gpt-type partition)
       ;; Return the genimage GPT partition type code corresponding to PARTITION.
-- 
2.32.1 (Apple Git-133)


[-- Attachment #3: 0002-Image-API-support-VFAT-partitions-in-GPT.patch --]
[-- Type: application/octet-stream, Size: 1359 bytes --]

From 87dd32f21450c4f84c55f6afc11ba1979e201ec9 Mon Sep 17 00:00:00 2001
From: Pavel Shlyak <p.shlyak@pantherx.org>
Date: Sun, 22 May 2022 16:53:30 +0300
Subject: [PATCH 2/4] Image API: support VFAT partitions in GPT

---
 gnu/system/image.scm | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index a83f844682..a6267feab2 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -317,10 +317,15 @@ (define (partition->dos-type partition)
     (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)))
+      (let ((flags (partition-flags partition)) (file-system (partition-file-system partition)))
         (cond
           ((member 'esp flags) "U")
-          (else "L"))))
+          ((string-prefix? "ext" file-system) "L")
+          ((string=? file-system "vfat") "F")
+          (else
+            (raise (condition
+              (&message
+               (message "unsupported partition type"))))))))
 
     (define (partition-image partition)
       ;; Return as a file-like object, an image of the given PARTITION.  A
-- 
2.32.1 (Apple Git-133)


[-- Attachment #4: 0003-Image-API-support-boot-flag.patch --]
[-- Type: application/octet-stream, Size: 3079 bytes --]

From 62980309a32ca1ecc5547345bdbc706d42c59d3b Mon Sep 17 00:00:00 2001
From: Pavel Shlyak <p.shlyak@pantherx.org>
Date: Sun, 22 May 2022 16:53:49 +0300
Subject: [PATCH 3/4] Image API: support boot flag

---
 gnu/build/image.scm  |  6 ++++--
 gnu/system/image.scm | 11 ++++++++---
 2 files changed, 12 insertions(+), 5 deletions(-)

diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 81caa424f8..321fba40e3 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -48,12 +48,13 @@ (define (sexp->partition sexp)
   "Take SEXP, a tuple as returned by 'partition->gexp', and turn it into a
 <partition> record."
   (match sexp
-    ((size file-system file-system-options label uuid)
+    ((size file-system file-system-options label uuid flags)
      (partition (size size)
                 (file-system file-system)
                 (file-system-options file-system-options)
                 (label label)
-                (uuid uuid)))))
+                (uuid uuid)
+                (flags flags)))))
 
 (define (size-in-kib size)
   "Convert SIZE expressed in bytes, to kilobytes and return it as a string."
@@ -78,6 +79,7 @@ (define* (make-ext-image partition target root
         (fs-options (partition-file-system-options partition))
         (label (partition-label partition))
         (uuid (partition-uuid partition))
+        (flags (partition-flags partition))
         (journal-options "lazy_itable_init=1,lazy_journal_init=1"))
     (apply invoke
            `("fakeroot" "mke2fs" "-t" ,fs "-d" ,root
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index a6267feab2..d903cb4579 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -218,7 +218,8 @@ (define (partition->gexp partition)
       #$(partition-file-system-options partition)
       #$(partition-label partition)
       #$(and=> (partition-uuid partition)
-               uuid-bytevector)))
+               uuid-bytevector)
+      #$(partition-flags partition)))
 
 (define gcrypt-sqlite3&co
   ;; Guile-Gcrypt, Guile-SQLite3, and their propagated inputs.
@@ -392,17 +393,21 @@ (define (partition->config image partition)
                     (partition-type-values image partition)))
         (let ((label (partition-label partition))
               (image (partition-image partition))
-              (offset (partition-offset partition)))
+              (offset (partition-offset partition))
+              (bootable (if (member 'boot (partition-flags partition))
+                          "true" "false" )))
           #~(format #f "~/partition ~a {
   ~/~/~a = ~a
   ~/~/image = \"~a\"
   ~/~/offset = \"~a\"
+  ~/~/bootable = \"~a\"
   ~/}"
                     #$label
                     #$partition-type-attribute
                     #$partition-type-value
                     #$image
-                    #$offset))))
+                    #$offset
+                    #$bootable))))
 
     (define (genimage-type-options image-type image)
       (cond
-- 
2.32.1 (Apple Git-133)


[-- Attachment #5: 0004-Update-copyright.patch --]
[-- Type: application/octet-stream, Size: 1266 bytes --]

From e8d8130a3c06c43715879d5d74ded2fa8e57dd2e Mon Sep 17 00:00:00 2001
From: Pavel Shlyak <p.shlyak@pantherx.org>
Date: Sun, 22 May 2022 16:58:22 +0300
Subject: [PATCH 4/4] Update copyright

---
 gnu/build/image.scm  | 1 +
 gnu/system/image.scm | 1 +
 2 files changed, 2 insertions(+)

diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 321fba40e3..3e8b94e2d6 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2020, 2022 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2022 Pavel Shlyak <p.shlyak@pantherx.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index d903cb4579..e1eecabc33 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020, 2021 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2022 Pavel Shlyak <p.shlyak@pantherx.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
-- 
2.32.1 (Apple Git-133)