[bug#63766] [PATCH 2/4] gnu: image: Add support for unformatted partitions.

[Efraim Flashner <efraim@flashner.co.il>]

* gnu/build/image.scm (make-unformatted-image): New procedure.
(make-partition-image): Add support for unformatted partition.
* gnu/system/image.scm (system-disk-image)[partition->gpt-type]: Add
case for using unformatted partition uuid.
[partition-image]: Add coreutils to image-builder closure.
---
 gnu/build/image.scm  |  8 ++++++++
 gnu/system/image.scm | 10 +++++++++-
 2 files changed, 17 insertions(+), 1 deletion(-)

diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 65a0373980..d47cb31aa0 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2022 Pavel Shlyak <p.shlyak@pantherx.org>
 ;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
+;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -122,6 +123,11 @@ (define* (make-vfat-image partition target root fs-bits)
                           (string-append "::" file))))
               (scandir root))))
 
+(define* (make-unformatted-image partition target)
+  "Make an unformatted partition of a certain size."
+  (let ((size (partition-size partition)))
+    (invoke "truncate" "--size" (number->string size) target)))
+
 (define* (make-partition-image partition-sexp target root)
   "Create and return the image of PARTITION-SEXP as TARGET.  Use the given
 ROOT directory to populate the image."
@@ -134,6 +140,8 @@ (define* (make-partition-image partition-sexp target root)
       (make-vfat-image partition target root 16))
      ((string=? type "fat32")
       (make-vfat-image partition target root 32))
+     ((string=? type "unformatted")
+      (make-unformatted-image partition target))
      (else
       (raise (condition
               (&message
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index afef79185f..3fe813f096 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2022 Pavel Shlyak <p.shlyak@pantherx.org>
 ;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
 ;;; Copyright © 2022 Alex Griffin <a@ajgrf.com>
+;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -390,6 +391,9 @@ (define* (system-disk-image image
          ((or (string=? file-system "vfat")
               (string=? file-system "fat16")
               (string=? file-system "fat32")) "F")
+         ((and (string=? file-system "unformatted")
+               (partition-uuid partition))
+          (uuid->string (partition-uuid partition)))
          (else
           (raise (condition
                   (&message
@@ -414,7 +418,11 @@ (define* (system-disk-image image
               (with-imported-modules*
                (let ((initializer (or #$(partition-initializer partition)
                                       initialize-root-partition))
-                     (inputs '#+(list e2fsprogs fakeroot dosfstools mtools))
+                     (inputs '#+(list e2fsprogs     ; ext2/3/4
+                                      fakeroot
+                                      dosfstools    ; vfat
+                                      mtools        ; vfat
+                                      coreutils))   ; truncate
                      (image-root "tmp-root"))
                  (sql-schema #$schema)
 
-- 
Efraim Flashner   <efraim@flashner.co.il>   רנשלפ םירפא
GPG key = A28B F40C 3E55 1372 662D  14F7 41AA E7DC CA3D 8351
Confidentiality cannot be guaranteed on emails sent or received unencrypted