From 200f4478e25712fa67d730c763691705142421ee Mon Sep 17 00:00:00 2001 From: Brice Waegeneire Date: Sun, 12 Apr 2020 21:10:02 +0200 Subject: services: Add file-system utils to profile. * 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. --- 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 cb556e87bc..da1eeb92d7 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -43,13 +43,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)) @@ -58,12 +65,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 @@ -533,6 +543,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 @@ -540,6 +574,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 ;;; Copyright © 2019 Meiyo Peng ;;; Copyright © 2020 Danny Milosavljevic +;;; Copyright © 2020 Brice Waegeneire ;;; ;;; 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 +;;; Copyright © 2020 Brice Waegeneire ;;; ;;; 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 (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 -- cgit v1.2.3