image: Add support for f2fs.

* gnu/build/image.scm (make-f2fs-image): New variable.
  (make-partition-image): Support f2fs.
  (estimate-partition-size): Add optional margin.
* gnu/system/image.scm (system-disk-image): Support f2fs.
* doc/guix.texi: (partition Reference): Support f2fs.

Change-Id: Ia7fc4483c3cc1af5f34fac86a529a90a1bd7c2c6
Signed-off-by: Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
Signed-off-by: Ludovic Courtès <ludo@gnu.org>

3 files changed, 45 insertions, 8 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 1e4d022e99e..310700cd0cb 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -54287,8 +54287,8 @@ there is no offset applied.
 @item @code{file-system} (default: @code{"ext4"})
 The partition file system as a string, defaulting to @code{"ext4"}.
 
-The supported values are @code{"vfat"}, @code{"fat16"}, @code{"fat32"},
-@code{"btrfs"}, and @code{"ext4"}.
+The supported values are @code{"btrfs"}, @code{"ext4"}, @code{"fat16"},
+@code{"fat32"}, and @code{"vfat"}.
 
 @code{"vfat"}, @code{"fat16"}, and @code{"fat32"} partitions without the
 @code{'esp} flag are by default LBA compatible.
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 2eb2ebd2179..c7cf72be91d 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -6,7 +6,7 @@
 ;;; 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>
-;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
+;;; Copyright © 2022, 2025 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
 ;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -66,12 +66,14 @@
   (number->string
    (inexact->exact (ceiling (/ size 1024)))))
 
-(define (estimate-partition-size root)
+(define* (estimate-partition-size root #:optional (margin .25))
   "Given the ROOT directory, evaluate and return its size.  As this doesn't
-take the partition metadata size into account, take a 25% margin.  As this in
+take the partition metadata size into account, take a MARGIN.  As this in
 turn doesn't take any constant overhead into account, force a 1-MiB minimum."
   (max (ash 1 20)
-       (* 1.25 (file-size root))))
+       ;; without inexact->exact, 'guess can result in an error like that:
+       ;; "Wrong type (expecting exact integer): 7179941140.0".
+       (inexact->exact (round (* (+ 1. margin) (file-size root))))))
 
 (define* (make-btrfs-image partition target root)
   "Handle the creation of BTRFS partition images. See
@@ -118,6 +120,35 @@ turn doesn't take any constant overhead into account, force a 1-MiB minimum."
                            (estimate-partition-size root)
                            size)))))))
 
+(define* (make-f2fs-image partition target root
+                          #:key
+                          (owner-uid 0)
+                          (owner-gid 0))
+  "Handle the creation of F2FS partition images.  See 'make-partition-image'."
+  (let ((size (partition-size partition))
+        (label (partition-label partition))
+        (uuid (partition-uuid partition))
+        (fs-options (partition-file-system-options partition)))
+    ;; The mkfs.f2fs utility can't create files, so we need to create one
+    ;; before running it.
+    (call-with-output-file target (const #t))
+    (truncate-file
+     target
+     (if (eq? size 'guess)
+         ;; The F2FS filesystem has more overhead than other filesystems like
+         ;; BTRFS and ext4.
+         (estimate-partition-size root .50)
+         size))
+    (apply invoke "fakeroot" "mkfs.f2fs"
+           "-l" label
+           "-R" (format #f "~a:~a" owner-uid owner-gid)
+           `(,@(if uuid
+                   `("-U" ,(uuid->string uuid))
+                   '())
+             ,@fs-options
+             ,target))
+    (invoke "fakeroot" "sload.f2fs" "-P" "-f" root target)))
+
 (define* (make-vfat-image partition target root fs-bits)
   "Handle the creation of VFAT partition images.  See 'make-partition-image'."
   (let ((size (partition-size partition))
@@ -162,6 +193,8 @@ ROOT directory to populate the image."
       (make-btrfs-image partition target root))
      ((string-prefix? "ext" type)
       (make-ext-image partition target root))
+     ((string=? "f2fs" type)
+      (make-f2fs-image partition target root))
      ((or (string=? type "vfat") (string=? type "fat16"))
       (make-vfat-image partition target root 16))
      ((string=? type "fat32")
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index 4693e13d164..b89d3a67781 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -404,7 +404,8 @@ used in the image."
         (cond
          ((member 'esp flags) "0xEF")
          ((or (string=? file-system "btrfs")
-              (string-prefix? "ext" file-system)) "0x83")
+              (string-prefix? "ext" file-system)
+              (string=? file-system "f2fs")) "0x83")
          ((or (string=? file-system "vfat")
               (string=? file-system "fat16")) "0x0E")
          ((string=? file-system "fat32") "0x0C")
@@ -424,7 +425,8 @@ used in the image."
         (cond
          ((member 'esp flags) "U")
          ((or (string=? file-system "btrfs")
-              (string-prefix? "ext" file-system)) "L")
+              (string-prefix? "ext" file-system)
+              (string=? file-system "f2fs")) "L")
          ((or (string=? file-system "vfat")
               (string=? file-system "fat16")
               (string=? file-system "fat32")) "F")
@@ -460,6 +462,8 @@ used in the image."
                                    (list btrfs-progs fakeroot))
                                   ((string-prefix? "ext" type)
                                    (list e2fsprogs fakeroot))
+                                  ((string=? type "f2fs")
+                                   (list f2fs-tools fakeroot))
                                   ((or (string=? type "vfat")
                                        (string-prefix? "fat" type))
                                    (list dosfstools fakeroot mtools))