[bug#40480] [PATCH v2] services: Add file-system utils to profile.

[Brice Waegeneire]

* gnu/services/base.scm (file-system-type->utils, file-system-utils):
New procedures.
(file-system-service-type): Extend 'profile-service-type' with
'file-system-utils'.
* 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 'utils?' field.

---

This version simplify 'file-system-type->utils' and makes it compliant with
the coding style.

 gnu/services/base.scm       | 40 +++++++++++++++++++++++++++++++++++--
 gnu/system.scm              | 28 +++++++++++++++++---------
 gnu/system/file-systems.scm |  6 +++++-
 3 files changed, 62 insertions(+), 12 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 070765ab83..9744a6517a 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -44,13 +44,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 eudev/btrfs-fix
+                          e2fsprogs f2fs-tools fuse gpm kbd lvm2 rng-tools
+                          util-linux xfsprogs))
   #:use-module (gnu packages bash)
   #:use-module ((gnu packages base)
                 #:select (canonical-package 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))
@@ -59,12 +66,15 @@
   #:use-module (guix modules)
   #:use-module ((guix self) #:select (make-config.scm))
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
   #:use-module (ice-9 format)
   #:export (fstab-service-type
             root-file-system-service
             file-system-service-type
+            file-system-utils
             swap-service
             user-processes-service-type
             host-name-service
@@ -535,6 +545,30 @@ FILE-SYSTEM."
                 (memq 'bind-mount (file-system-flags file-system))))
           file-systems))
 
+(define (file-system-type->utils type)
+  "Return a utils package for file system TYPE, #f otherwise."
+  (assoc-ref
+   `(("bachefs" . ,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-utils file-systems)
+  "Return the list of file-system utils packages for FILE-SYSTEMS"
+  (filter-map (lambda (file-system)
+                (when (file-system-utils? file-system)
+                  (file-system-type->utils (file-system-type file-system))))
+              file-systems))
+
 (define file-system-service-type
   (service-type (name 'file-systems)
                 (extensions
@@ -542,6 +576,8 @@ FILE-SYSTEM."
                                           file-system-shepherd-services)
                        (service-extension fstab-service-type
                                           file-system-fstab-entries)
+                       (service-extension profile-service-type
+                                          file-system-utils)
 
                        ;; Have 'user-processes' depend on 'file-systems'.
                        (service-extension user-processes-service-type
diff --git a/gnu/system.scm b/gnu/system.scm
index fd456c6206..d86098fbe0 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
 ;;; Copyright © 2019 Meiyo Peng <address@hidden>
 ;;; Copyright © 2020 Danny Milosavljevic <address@hidden>
+;;; Copyright © 2020 Brice Waegeneire <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -418,6 +419,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 adding to the system profile the file system utils
+packages for the file systems of OS that are marked as 'needed-for-boot'."
+  (let ((file-systems (filter file-system-needed-for-boot?
+                              (operating-system-file-systems os))))
+    (simple-service 'boot-file-system-utils profile-service-type
+                    (file-system-utils file-systems))))
+
 (define (mapped-device-users device file-systems)
   "Return the subset of FILE-SYSTEMS that use DEVICE."
   (let ((target (string-append "/dev/mapper/" (mapped-device-target device))))
@@ -504,13 +513,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)
            %boot-service
 
@@ -537,7 +547,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.
@@ -607,7 +617,7 @@ of PROVENANCE-SERVICE-TYPE to its services."
          ;; already depends on it anyway.
          kmod eudev
 
-         e2fsprogs kbd
+         kbd
 
          bash-completion
 
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 3b599efa8e..9bc1687696 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès 
<address@hidden>
+;;; Copyright © 2020 Brice Waegeneire <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -42,6 +43,7 @@
             file-system-create-mount-point?
             file-system-dependencies
             file-system-location
+            file-system-utils?
 
             file-system-type-predicate
 
@@ -111,7 +113,9 @@
                     (default '()))                ; or <mapped-device>
   (location         file-system-location
                     (default (current-source-location))
-                    (innate)))
+                    (innate))
+  (utils?           file-system-utils?            ; Boolean
+                    (default #t)))
 
 ;; A file system label for use in the 'device' field.
 (define-record-type <file-system-label>
-- 
2.26.0