diff mbox series

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

Message ID 20200407083054.19472-1-brice@waegenei.re
State Superseded
Headers show
Series [bug#40480] services: Add file-system utils to profile. | expand

Checks

Context Check Description
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch success View Laminar job

Commit Message

Brice Waegeneire April 7, 2020, 8:30 a.m. UTC
* gnu/services/base.scm (file-system-type->utils, file-system-utils):
New procedure.
(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.
---
 gnu/services/base.scm       | 39 +++++++++++++++++++++++++++++++++++--
 gnu/system.scm              | 28 +++++++++++++++++---------
 gnu/system/file-systems.scm |  6 +++++-
 3 files changed, 61 insertions(+), 12 deletions(-)

Comments

Brice Waegeneire April 12, 2020, 7:26 p.m. UTC | #1
Hello Guix,

Looks like I forgot to describe this patch... It adds the utils package 
of
each used file-system type to the system profile. This behavior can be
disabled by setting the “file-system-utils?” field to #f.

When you have an issue with your file system it's not the time to 
discover
the absence of the utility package nor trying to install it. This patch 
fix
that.

We talked about such feature at[0].

[0]: https://issues.guix.info/issue/39332

- Brice
Brice Waegeneire April 23, 2020, 12:18 p.m. UTC | #2
Tobias,

Thank you for taking the time to review this patch.

> I'm amused that bcachefs is amongst this list so I'll test it on a
> bcachefs system and get back to you.

I'm not sure  if it'll works, I've  just searched the packages  for all 
the
file system utilities that were available  in Guix to make the mapping. 
You
will at least need to patch your kernel to get bcachefs working 
properly.

> In the next revision and future patches, please write ‘utilities’
> instead of ‘utils’, ‘operating-system’ instead of ‘os’, &c. (in
> prose and code).  In general, in Scheme, avoid all the tedious and
> unnecessary abbreviation fashionable in some other languages.

This is still difficult for me especially for such widely used
abbreviations. I have kept OS in gnu/system.scm because it's used
extensively there and that 'boot-file-system-service' is modeled onto
'non-boot-file-system-service'. About the usage of 'utils' you may want 
to
rename %base-package-utils introduced in 93664feee1.

Cheers,
- Brice
diff mbox series

Patch

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 070765ab83..1fef44cf01 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,29 @@  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."
+  (define pattern->utils
+    `(("ext[234]" . ,e2fsprogs)
+      ("btrfs" . ,btrfs-progs)
+      ("jfs" . ,jfsutils)
+      ("exfat" . ,exfat-utils)
+      ("bachefs" . ,bcachefs-tools)
+      ("xfs" . ,xfsprogs)
+      ("fat" . ,dosfstools)
+      ("f2fs" . ,f2fs-tools)
+      ("zfs" . ,zfs)))
+  (and-let* ((utils
+              (find (lambda (a) (string-match (car a) type)) pattern->utils)))
+    (cdr utils)))
+
+(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 +575,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 <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>
 ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
+;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; 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 <ludo@gnu.org>
+;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; 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>