[bug#49128] [PATCH] services: Add file system utilities to profile.

[Brice Waegeneire <brice@waegenei.re>]

Fixes <https://issues.guix.gnu.org/issue/39505>.

* gnu/services/base.scm (file-system-type->utilities,
file-system-utilities): New procedures.
(file-system-service-type): Extend 'profile-service-type' with
'file-system-utilities'.
* gnu/system.scm (boot-file-system-service): New procedure…
(operating-system-default-essential-services): …use it.
(%base-packages): Remove 'e2fsprogs'.
* gnu/system/file-systems.scm (file-system): Add 'utilities?' field.
* doc/guix.texi (File Systems): Document 'file-system-utilities?'.
---
 doc/guix.texi               |  6 ++++++
 gnu/services/base.scm       | 40 +++++++++++++++++++++++++++++++++++--
 gnu/system.scm              | 28 ++++++++++++++++----------
 gnu/system/file-systems.scm |  6 +++++-
 4 files changed, 67 insertions(+), 13 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index efeb176e3d..3115dbed38 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -14031,6 +14031,12 @@ a dependency of @file{/sys/fs/cgroup/cpu} and
 
 Another example is a file system that depends on a mapped device, for
 example for an encrypted partition (@pxref{Mapped Devices}).
+
+@item @code{utilities?} (default: @code{#t})
+When true, the filesystem utility package is added to the system
+profile.  Such as @code{e2fsprogs} for ext4 or @code{btrfs-progs} for
+Btrfs partitions.
+
 @end table
 @end deftp
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 3be2e984c3..9a05dd3c02 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -46,13 +46,20 @@
                 #:select (file-system-packages))
   #:use-module (gnu packages admin)
   #:use-module ((gnu packages linux)
-                #:select (alsa-utils crda eudev e2fsprogs fuse gpm kbd lvm2 rng-tools))
+                #:select (alsa-utils btrfs-progs crda eudev
+                          e2fsprogs f2fs-tools fuse gpm kbd lvm2 rng-tools
+                          util-linux xfsprogs))
   #:use-module (gnu packages bash)
   #:use-module ((gnu packages base)
                 #:select (coreutils glibc glibc-utf8-locales))
   #:use-module (gnu packages package-management)
   #:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
-  #:use-module (gnu packages linux)
+  #:use-module ((gnu packages disk)
+                #:select (dosfstools))
+  #:use-module ((gnu packages file-systems)
+                #:select (bcachefs-tools jfsutils zfs))
+  #:use-module ((gnu packages mtools)
+                #:select (exfat-utils))
   #:use-module (gnu packages terminals)
   #:use-module ((gnu build file-systems)
                 #:select (mount-flags->bit-mask))
@@ -69,6 +76,7 @@
   #:export (fstab-service-type
             root-file-system-service
             file-system-service-type
+            file-system-utilities
             swap-service
             host-name-service
             %default-console-font
@@ -422,6 +430,32 @@ FILE-SYSTEM."
                 (memq 'bind-mount (file-system-flags file-system))))
           file-systems))
 
+(define (file-system-type->utilities type)
+  "Return a package providing the utilities for file system TYPE, #f
+otherwise."
+  (assoc-ref
+   `(("bcachefs" . ,bcachefs-tools)
+     ("btrfs" . ,btrfs-progs)
+     ("exfat" . ,exfat-utils)
+     ("ext2" . ,e2fsprogs)
+     ("ext3" . ,e2fsprogs)
+     ("ext4" . ,e2fsprogs)
+     ("fat" . ,dosfstools)
+     ("f2fs" . ,f2fs-tools)
+     ("jfs" . ,jfsutils)
+     ("vfat" . ,dosfstools)
+     ("xfs" . ,xfsprogs)
+     ("zfs" . ,zfs))
+   type))
+
+(define (file-system-utilities file-systems)
+  "Return a list of packages containing file system utilities for
+FILE-SYSTEMS."
+  (filter-map (lambda (file-system)
+                (when (file-system-utilities? file-system)
+                  (file-system-type->utilities (file-system-type file-system))))
+              file-systems))
+
 (define file-system-service-type
   (service-type (name 'file-systems)
                 (extensions
@@ -429,6 +463,8 @@ FILE-SYSTEM."
                                           file-system-shepherd-services)
                        (service-extension fstab-service-type
                                           file-system-fstab-entries)
+                       (service-extension profile-service-type
+                                          file-system-utilities)
 
                        ;; Have 'user-processes' depend on 'file-systems'.
                        (service-extension user-processes-service-type
diff --git a/gnu/system.scm b/gnu/system.scm
index 8a3ae27d04..23b4b23c28 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -526,6 +526,14 @@ marked as 'needed-for-boot'."
   (service file-system-service-type
            (map add-dependencies file-systems)))
 
+(define (boot-file-system-service os)
+  "Return a service which adds, to the system profile, packages providing the
+utilites for the file systems marked as 'needed-for-boot' in OS."
+  (let ((file-systems (filter file-system-needed-for-boot?
+                              (operating-system-file-systems os))))
+    (simple-service 'boot-file-system-utilities profile-service-type
+                    (file-system-utilities file-systems))))
+
 (define (mapped-device-users device file-systems)
   "Return the subset of FILE-SYSTEMS that use DEVICE."
   (let ((targets (map (cut string-append "/dev/mapper/" <>)
@@ -637,13 +645,14 @@ bookkeeping."
   (define known-fs
     (map file-system-mount-point (operating-system-file-systems os)))
 
-  (let* ((mappings  (device-mapping-services os))
-         (root-fs   (root-file-system-service))
-         (other-fs  (non-boot-file-system-service os))
-         (swaps     (swap-services os))
-         (procs     (service user-processes-service-type))
-         (host-name (host-name-service (operating-system-host-name os)))
-         (entries   (operating-system-directory-base-entries os)))
+  (let* ((mappings     (device-mapping-services os))
+         (root-fs      (root-file-system-service))
+         (boot-fs      (boot-file-system-service os))
+         (non-boot-fs  (non-boot-file-system-service os))
+         (swaps        (swap-services os))
+         (procs        (service user-processes-service-type))
+         (host-name    (host-name-service (operating-system-host-name os)))
+         (entries      (operating-system-directory-base-entries os)))
     (cons* (service system-service-type entries)
            (service linux-builder-service-type
                     (linux-builder-configuration
@@ -674,7 +683,7 @@ bookkeeping."
                     (operating-system-setuid-programs os))
            (service profile-service-type
                     (operating-system-packages os))
-           other-fs
+           boot-fs non-boot-fs
            (append mappings swaps
 
                    ;; Add the firmware service.
@@ -812,8 +821,7 @@ of PROVENANCE-SERVICE-TYPE to its services."
 (define %base-packages
   ;; Default set of packages globally visible.  It should include anything
   ;; required for basic administrator tasks.
-  (append (list e2fsprogs)
-          %base-packages-interactive
+  (append %base-packages-interactive
           %base-packages-linux
           %base-packages-networking
           %base-packages-utils))
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 464e87cb18..35803d39e9 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2020 Google LLC
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -54,6 +55,7 @@
             file-system-create-mount-point?
             file-system-dependencies
             file-system-location
+            file-system-utilities?
 
             file-system-type-predicate
             btrfs-subvolume?
@@ -129,7 +131,9 @@
                     (default '()))                ; or <mapped-device>
   (location         file-system-location
                     (default (current-source-location))
-                    (innate)))
+                    (innate))
+  (utilities?       file-system-utilities?        ; Boolean
+                    (default #t)))
 
 ;; A file system label for use in the 'device' field.
 (define-record-type <file-system-label>
-- 
2.31.1