branch master updated: services: Add file system utilities to profile.

[guix-commits]

This is an automated email from the git hooks/post-receive script.

apteryx pushed a commit to branch master
in repository guix.

The following commit(s) were added to refs/heads/master by this push:
     new 45eac6cdf5 services: Add file system utilities to profile.
45eac6cdf5 is described below

commit 45eac6cdf5c8d9d7b0c564b105c790d2d2007799
Author: Brice Waegeneire <brice@waegenei.re>
AuthorDate: Thu Apr 23 14:00:02 2020 +0200

    services: Add file system utilities to profile.
    
    * 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'.
    
    Signed-off-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>
    Modified-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>
---
 gnu/services/base.scm | 37 +++++++++++++++++++++++++++++++++++--
 gnu/system.scm        | 33 +++++++++++++++++++++------------
 2 files changed, 56 insertions(+), 14 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 616bc42e69..3f662f1a6c 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -55,7 +55,9 @@
                 #: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 tar))
@@ -64,7 +66,10 @@
   #:autoload   (gnu packages hurd) (hurd)
   #: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 exfat-utils jfsutils zfs))
   #:use-module (gnu packages terminals)
   #:use-module ((gnu build file-systems)
                 #:select (mount-flags->bit-mask
@@ -86,6 +91,7 @@
   #:export (fstab-service-type
             root-file-system-service
             file-system-service-type
+            file-system-utilities
             swap-service
             host-name-service
             %default-console-font
@@ -488,6 +494,31 @@ upon boot."
                 (memq 'bind-mount (file-system-flags file-system))))
           file-systems))
 
+(define (file-system-type->utilities type)
+  "Return the 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)
+                (file-system-type->utilities (file-system-type file-system)))
+              file-systems))
+
 (define file-system-service-type
   (service-type (name 'file-systems)
                 (extensions
@@ -495,6 +526,8 @@ upon boot."
                                           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 a94f0a9a1f..66ca629d63 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -575,6 +575,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/" <>)
@@ -720,13 +728,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
@@ -757,7 +766,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.
@@ -887,8 +896,9 @@ of PROVENANCE-SERVICE-TYPE to its services."
         iw wireless-tools))
 
 (define %base-packages-disk-utilities
-  ;; A well-rounded set of packages for interacting with disks, partitions
-  ;; and filesystems.
+  ;; A well-rounded set of packages for interacting with disks,
+  ;; partitions and filesystems, included with the Guix installation
+  ;; image.
   (list parted gptfdisk ddrescue
         ;; We used to provide fdisk from GNU fdisk, but as of version 2.0.0a
         ;; it pulls Guile 1.8, which takes unreasonable space; furthermore
@@ -903,8 +913,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-artwork
+  (append %base-packages-artwork
           %base-packages-interactive
           %base-packages-linux
           %base-packages-networking