bug#26815: [PATCH 2/3] vm: Support creating FAT partitions.

[Marius Bakke]

* gnu/build/vm.scm (create-ext-file-system, create-fat-file-system): New 
procedures.
(format-partition): Use procedures. Error for unknown file systems.
* gnu/system/vm.scm (qemu-image): Add DOSFSTOOLS to the closure.
* gnu/system/linux-initrd.scm (base-initrd): Add nls_is8859-1.ko regardless of
whether a FAT filesystem is present.
---
 gnu/build/vm.scm            | 43 ++++++++++++++++++++++++++++++++++++-------
 gnu/system/linux-initrd.scm |  4 +---
 gnu/system/vm.scm           |  2 +-
 3 files changed, 38 insertions(+), 11 deletions(-)

diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 3286ffb02..ad39e29ce 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -214,17 +214,46 @@ actual /dev name based on DEVICE."
 
 (define MS_BIND 4096)                             ; <sys/mounts.h> again!
 
+(define* (create-ext-file-system partition type
+                                 #:key label)
+  "Create an ext-family filesystem of TYPE on PARTITION.  If LABEL is true,
+use that as the volume name."
+  (format #t "creating ~a partition...\n" type)
+  (apply system* (string-append "mkfs." type)
+         "-F" partition
+         (if label
+             `("-L" ,label)
+             '())))
+
+(define* (create-fat32-file-system partition
+                                   #:key label)
+  "Create a FAT32 filesystem on PARTITION, which must be at least 32 MiB long.
+If LABEL is true, use that as volume name."
+  (format #t "Creating FAT32 partition...\n")
+  ;; Without the -F parameter, mkfs.fat will automatically determine
+  ;; the number of file allocation tables based on partition size.
+  ;; Ensure a FAT32 partition for compatibility with e.g. UEFI.
+  (apply system* "mkfs.fat" "-F32" partition
+         (if label
+             `("-n" ,label)
+             '())))
+
 (define* (format-partition partition type
                            #:key label)
   "Create a file system TYPE on PARTITION.  If LABEL is true, use that as the
 volume name."
-  (format #t "creating ~a partition...\n" type)
-  (unless (zero? (apply system* (string-append "mkfs." type)
-                        "-F" partition
-                        (if label
-                            `("-L" ,label)
-                            '())))
-    (error "failed to create partition")))
+  (define format-procedure
+    (cond
+     ((string-prefix? "ext" type)
+      (create-ext-file-system partition type #:label label))
+     ((string-suffix? "fat" type)
+      (create-fat32-file-system partition #:label label))
+     (else #f)))
+  (if format-procedure
+      (match (status:exit-val format-procedure)
+        (0 #t)
+        (_ (error "Formatting partition failed.")))
+      (error "Unsupported file system.")))
 
 (define (initialize-partition partition)
   "Format PARTITION, a <partition> object with a non-#f 'device' field, mount
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index dfe198e43..3a5e76034 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -268,6 +268,7 @@ loaded at boot time in the order in which they appear."
       "usbhid" "hid-generic" "hid-apple"      ;keyboards during early boot
       "dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions
       "nvme"                                     ;for new SSD NVMe devices
+      "nls_iso8859-1"                            ;for `mkfs.fat`, et.al
       ,@(if (string-match "^(x86_64|i[3-6]86)-" (%current-system))
             '("pata_acpi" "pata_atiixp"    ;for ATA controllers
               "isci")                      ;for SAS controllers like Intel C602
@@ -281,9 +282,6 @@ loaded at boot time in the order in which they appear."
       ,@(if (find (file-system-type-predicate "9p") file-systems)
             virtio-9p-modules
             '())
-      ,@(if (find (file-system-type-predicate "vfat") file-systems)
-            '("nls_iso8859-1")
-            '())
       ,@(if (find (file-system-type-predicate "btrfs") file-systems)
             '("btrfs")
             '())
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 42c7690b1..099e3fac3 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -202,7 +202,7 @@ the image."
                       (guix build utils))
 
          (let ((inputs
-                '#$(append (list qemu parted e2fsprogs)
+                '#$(append (list qemu parted e2fsprogs dosfstools)
                            (map canonical-package
                                 (list sed grep coreutils findutils gawk))
                            (if register-closures? (list guix) '())))
-- 
2.12.2