mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
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>
This commit is contained in:
parent
bb762ac517
commit
45eac6cdf5
2 changed files with 56 additions and 14 deletions
|
@ -55,7 +55,9 @@ (define-module (gnu services base)
|
||||||
#:select (file-system-packages))
|
#:select (file-system-packages))
|
||||||
#:use-module (gnu packages admin)
|
#:use-module (gnu packages admin)
|
||||||
#:use-module ((gnu packages linux)
|
#: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 bash)
|
||||||
#:use-module ((gnu packages base)
|
#:use-module ((gnu packages base)
|
||||||
#:select (coreutils glibc glibc-utf8-locales tar))
|
#:select (coreutils glibc glibc-utf8-locales tar))
|
||||||
|
@ -64,7 +66,10 @@ (define-module (gnu services base)
|
||||||
#:autoload (gnu packages hurd) (hurd)
|
#:autoload (gnu packages hurd) (hurd)
|
||||||
#:use-module (gnu packages package-management)
|
#:use-module (gnu packages package-management)
|
||||||
#:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
|
#: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 packages terminals)
|
||||||
#:use-module ((gnu build file-systems)
|
#:use-module ((gnu build file-systems)
|
||||||
#:select (mount-flags->bit-mask
|
#:select (mount-flags->bit-mask
|
||||||
|
@ -86,6 +91,7 @@ (define-module (gnu services base)
|
||||||
#:export (fstab-service-type
|
#:export (fstab-service-type
|
||||||
root-file-system-service
|
root-file-system-service
|
||||||
file-system-service-type
|
file-system-service-type
|
||||||
|
file-system-utilities
|
||||||
swap-service
|
swap-service
|
||||||
host-name-service
|
host-name-service
|
||||||
%default-console-font
|
%default-console-font
|
||||||
|
@ -488,6 +494,31 @@ (define (file-system-fstab-entries file-systems)
|
||||||
(memq 'bind-mount (file-system-flags file-system))))
|
(memq 'bind-mount (file-system-flags file-system))))
|
||||||
file-systems))
|
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
|
(define file-system-service-type
|
||||||
(service-type (name 'file-systems)
|
(service-type (name 'file-systems)
|
||||||
(extensions
|
(extensions
|
||||||
|
@ -495,6 +526,8 @@ (define file-system-service-type
|
||||||
file-system-shepherd-services)
|
file-system-shepherd-services)
|
||||||
(service-extension fstab-service-type
|
(service-extension fstab-service-type
|
||||||
file-system-fstab-entries)
|
file-system-fstab-entries)
|
||||||
|
(service-extension profile-service-type
|
||||||
|
file-system-utilities)
|
||||||
|
|
||||||
;; Have 'user-processes' depend on 'file-systems'.
|
;; Have 'user-processes' depend on 'file-systems'.
|
||||||
(service-extension user-processes-service-type
|
(service-extension user-processes-service-type
|
||||||
|
|
|
@ -575,6 +575,14 @@ (define (add-dependencies fs)
|
||||||
(service file-system-service-type
|
(service file-system-service-type
|
||||||
(map add-dependencies file-systems)))
|
(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)
|
(define (mapped-device-users device file-systems)
|
||||||
"Return the subset of FILE-SYSTEMS that use DEVICE."
|
"Return the subset of FILE-SYSTEMS that use DEVICE."
|
||||||
(let ((targets (map (cut string-append "/dev/mapper/" <>)
|
(let ((targets (map (cut string-append "/dev/mapper/" <>)
|
||||||
|
@ -720,13 +728,14 @@ (define (operating-system-default-essential-services os)
|
||||||
(define known-fs
|
(define known-fs
|
||||||
(map file-system-mount-point (operating-system-file-systems os)))
|
(map file-system-mount-point (operating-system-file-systems os)))
|
||||||
|
|
||||||
(let* ((mappings (device-mapping-services os))
|
(let* ((mappings (device-mapping-services os))
|
||||||
(root-fs (root-file-system-service))
|
(root-fs (root-file-system-service))
|
||||||
(other-fs (non-boot-file-system-service os))
|
(boot-fs (boot-file-system-service os))
|
||||||
(swaps (swap-services os))
|
(non-boot-fs (non-boot-file-system-service os))
|
||||||
(procs (service user-processes-service-type))
|
(swaps (swap-services os))
|
||||||
(host-name (host-name-service (operating-system-host-name os)))
|
(procs (service user-processes-service-type))
|
||||||
(entries (operating-system-directory-base-entries os)))
|
(host-name (host-name-service (operating-system-host-name os)))
|
||||||
|
(entries (operating-system-directory-base-entries os)))
|
||||||
(cons* (service system-service-type entries)
|
(cons* (service system-service-type entries)
|
||||||
(service linux-builder-service-type
|
(service linux-builder-service-type
|
||||||
(linux-builder-configuration
|
(linux-builder-configuration
|
||||||
|
@ -757,7 +766,7 @@ (define known-fs
|
||||||
(operating-system-setuid-programs os))
|
(operating-system-setuid-programs os))
|
||||||
(service profile-service-type
|
(service profile-service-type
|
||||||
(operating-system-packages os))
|
(operating-system-packages os))
|
||||||
other-fs
|
boot-fs non-boot-fs
|
||||||
(append mappings swaps
|
(append mappings swaps
|
||||||
|
|
||||||
;; Add the firmware service.
|
;; Add the firmware service.
|
||||||
|
@ -887,8 +896,9 @@ (define %base-packages-networking
|
||||||
iw wireless-tools))
|
iw wireless-tools))
|
||||||
|
|
||||||
(define %base-packages-disk-utilities
|
(define %base-packages-disk-utilities
|
||||||
;; A well-rounded set of packages for interacting with disks, partitions
|
;; A well-rounded set of packages for interacting with disks,
|
||||||
;; and filesystems.
|
;; partitions and filesystems, included with the Guix installation
|
||||||
|
;; image.
|
||||||
(list parted gptfdisk ddrescue
|
(list parted gptfdisk ddrescue
|
||||||
;; We used to provide fdisk from GNU fdisk, but as of version 2.0.0a
|
;; 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
|
;; it pulls Guile 1.8, which takes unreasonable space; furthermore
|
||||||
|
@ -903,8 +913,7 @@ (define %base-packages-disk-utilities
|
||||||
(define %base-packages
|
(define %base-packages
|
||||||
;; Default set of packages globally visible. It should include anything
|
;; Default set of packages globally visible. It should include anything
|
||||||
;; required for basic administrator tasks.
|
;; required for basic administrator tasks.
|
||||||
(append (list e2fsprogs)
|
(append %base-packages-artwork
|
||||||
%base-packages-artwork
|
|
||||||
%base-packages-interactive
|
%base-packages-interactive
|
||||||
%base-packages-linux
|
%base-packages-linux
|
||||||
%base-packages-networking
|
%base-packages-networking
|
||||||
|
|
Loading…
Reference in a new issue