aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBrice Waegeneire <brice@waegenei.re>2020-04-22 20:50:04 +0200
committerGuix Patches Tester <>2020-04-22 19:52:12 +0100
commit0d8c2ff75b25697aa1e729f59c697a4b9c68b841 (patch)
tree3219be9f761e78b1dfc1c940d017d425fecfe0c5
parent9475c631a70b82614a8f3d6db2840d00955e2e1c (diff)
downloadpatches-series-3631.tar
patches-series-3631.tar.gz
services: Add file-system utils to profile.series-3631
* 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.
-rw-r--r--gnu/services/base.scm40
-rw-r--r--gnu/system.scm28
-rw-r--r--gnu/system/file-systems.scm6
3 files changed, 61 insertions, 13 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 2913478e4a..9a1d2f9efa 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,13 +66,16 @@
#: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)
#:re-export (user-processes-service-type) ;backwards compatibility
#:export (fstab-service-type
root-file-system-service
file-system-service-type
+ file-system-utils
swap-service
host-name-service
console-keymap-service
@@ -413,6 +423,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
@@ -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-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 3ee2c84235..efd88fa373 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -423,6 +423,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))))
@@ -503,13 +511,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
@@ -536,7 +545,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.
@@ -629,8 +638,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..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>