diff mbox series

[bug#40480,v4] services: Add file system utilities to profile.

Message ID 20200423120002.32554-1-brice@waegenei.re
State Under Review
Delegated to: Christopher Baines
Headers show
Series [bug#40480,v4] services: Add file system utilities 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 23, 2020, noon UTC 
* 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.
---

Fix bcachefs typo and replace 'utils' by 'utilities'. Reword the
documentation procedures to be clearer. Remove (srfi srfi-2) and (ice-9
regex) which weren't used since v1.

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

Comments

Christopher Baines Dec. 18, 2020, 3:28 p.m. UTC | #1 
Brice Waegeneire <brice@waegenei.re> writes:

> * 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.
> ---
>
> Fix bcachefs typo and replace 'utils' by 'utilities'. Reword the
> documentation procedures to be clearer. Remove (srfi srfi-2) and (ice-9
> regex) which weren't used since v1.
>
>  gnu/services/base.scm       | 40 +++++++++++++++++++++++++++++++++++--
>  gnu/system.scm              | 28 ++++++++++++++++----------
>  gnu/system/file-systems.scm |  6 +++++-
>  3 files changed, 61 insertions(+), 13 deletions(-)

Thanks for the updated patch Brian, and apologies it's taken so long to
review.

I've had a quick look through, and generally it looks fine to me.

> diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
> index 3b599efa8e..f78c3b1b8e 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-utilities?
>  
>              file-system-type-predicate
>  
> @@ -111,7 +113,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>

On utilties? here, I wonder if the name for this option could be
clearer? Most of the other options can be interpreted in the context of
the filesystem itself, but this is about whether the system profile
should include utilities for that filesystem. I haven't got any
particularly good ideas though, maybe system-include-utilities?

I think utilities? is OK though, if someone wants to turn it off, then
they'll probably be able to work out how. On that, maybe the only must
before merging this is adding to the list of options in the
documentation. Is this something you're able to do?

Thanks,

Chris
diff mbox series

Patch

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 2913478e4a..9b2c8c22b9 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))
@@ -66,6 +73,7 @@ 
   #:export (fstab-service-type
             root-file-system-service
             file-system-service-type
+            file-system-utilities
             swap-service
             host-name-service
             console-keymap-service
@@ -413,6 +421,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
@@ -420,6 +454,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 29e622872d..3b8a1c4822 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -424,6 +424,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 ((target (string-append "/dev/mapper/" (mapped-device-target device))))
@@ -519,13 +527,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
 
@@ -552,7 +561,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.
@@ -645,8 +654,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 3b599efa8e..f78c3b1b8e 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-utilities?
 
             file-system-type-predicate
 
@@ -111,7 +113,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>