summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBrice Waegeneire <brice@waegenei.re>2020-04-23 14:00:02 +0200
committerMaxim Cournoyer <maxim.cournoyer@gmail.com>2022-09-28 19:45:38 -0400
commit45eac6cdf5c8d9d7b0c564b105c790d2d2007799 (patch)
treec8457ca77ec0df19e76e49280eaa25646d160974
parentbb762ac517ff5ab4e55a0efb7e1b534c36c2b7c3 (diff)
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>
-rw-r--r--gnu/services/base.scm37
-rw-r--r--gnu/system.scm33
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