From aa1145df8d43187f3e92aa505298cdeca4fb1191 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 21 Aug 2016 18:50:14 +0200 Subject: [PATCH] services: Make a single extensible 'file-systems' service. Previously we would create one 'file-system-service-type' instead per file system. Now, we create only one instance for all the file systems. * gnu/services/base.scm (fstab-service-type)[compose]: Change to CONCATENATE. (file-system-shepherd-service): Change to return either one or #f. (file-system-service-type): Pluralize 'name'. Adjust SHEPHERD-ROOT-SERVICE-TYPE extension to above changes. Add 'compose' and 'extend'. (file-system-service): Remove. * gnu/system.scm (other-file-system-services): Rename to... (non-boot-file-system-service): ... this. Change to return a single FILE-SYSTEM-SERVICE-TYPE instance. (essential-services): Adjust accordingly. --- gnu/services/base.scm | 34 +++++++++++++++------------------- gnu/system.scm | 16 +++++++++------- 2 files changed, 24 insertions(+), 26 deletions(-) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 3b4c22f8a2..f3f6408687 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -49,7 +49,7 @@ (define-module (gnu services base) #:use-module (ice-9 format) #:export (fstab-service-type root-file-system-service - file-system-service + file-system-service-type user-unmount-service swap-service user-processes-service @@ -164,7 +164,7 @@ (define fstab-service-type (extensions (list (service-extension etc-service-type file-systems->fstab))) - (compose identity) + (compose concatenate) (extend append))) (define %root-file-system-shepherd-service @@ -230,7 +230,8 @@ (define dependency->shepherd-service-name (file-system->shepherd-service-name fs)))) (define (file-system-shepherd-service file-system) - "Return a list containing the shepherd service for @var{file-system}." + "Return the shepherd service for @var{file-system}, or @code{#f} if +@var{file-system} is not auto-mounted upon boot." (let ((target (file-system-mount-point file-system)) (device (file-system-device file-system)) (type (file-system-type file-system)) @@ -238,10 +239,9 @@ (define (file-system-shepherd-service file-system) (check? (file-system-check? file-system)) (create? (file-system-create-mount-point? file-system)) (dependencies (file-system-dependencies file-system))) - (if (file-system-mount? file-system) - (with-imported-modules '((gnu build file-systems) - (guix build bournish)) - (list + (and (file-system-mount? file-system) + (with-imported-modules '((gnu build file-systems) + (guix build bournish)) (shepherd-service (provision (list (file-system->shepherd-service-name file-system))) (requirement `(root-file-system @@ -290,23 +290,19 @@ (define (file-system-shepherd-service file-system) ;; We need an additional module. (modules `(((gnu build file-systems) #:select (check-file-system canonicalize-device-spec)) - ,@%default-modules))))) - '()))) + ,@%default-modules))))))) (define file-system-service-type - ;; TODO(?): Make this an extensible service that takes objects - ;; and returns a list of . - (service-type (name 'file-system) + (service-type (name 'file-systems) (extensions (list (service-extension shepherd-root-service-type - file-system-shepherd-service) + (lambda (file-systems) + (filter-map file-system-shepherd-service + file-systems))) (service-extension fstab-service-type - identity))))) - -(define* (file-system-service file-system) - "Return a service that mounts @var{file-system}, a @code{} -object." - (service file-system-service-type file-system)) + identity))) + (compose concatenate) + (extend append))) (define user-unmount-service-type (shepherd-service-type diff --git a/gnu/system.scm b/gnu/system.scm index d6bf6c413c..080201011c 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -178,9 +178,9 @@ (define-record-type* operating-system ;;; Services. ;;; -(define (other-file-system-services os) - "Return file system services for the file systems of OS that are not marked -as 'needed-for-boot'." +(define (non-boot-file-system-service os) + "Return the file system service for the file systems of OS that are not +marked as 'needed-for-boot'." (define file-systems (remove file-system-needed-for-boot? (operating-system-file-systems os))) @@ -204,7 +204,8 @@ (define (add-dependencies fs) (file-system-dependencies fs)) eq?)))) - (map (compose file-system-service add-dependencies) file-systems)) + (service file-system-service-type + (map add-dependencies file-systems))) (define (mapped-device-user device file-systems) "Return a file system among FILE-SYSTEMS that uses DEVICE, or #f." @@ -270,11 +271,11 @@ (define known-fs (let* ((mappings (device-mapping-services os)) (root-fs (root-file-system-service)) - (other-fs (other-file-system-services os)) + (other-fs (non-boot-file-system-service os)) (unmount (user-unmount-service known-fs)) (swaps (swap-services os)) (procs (user-processes-service - (map service-parameters other-fs))) + (service-parameters other-fs))) (host-name (host-name-service (operating-system-host-name os))) (entries (operating-system-directory-base-entries os #:container? container?))) @@ -302,7 +303,8 @@ (define known-fs (operating-system-setuid-programs os)) (service profile-service-type (operating-system-packages os)) - (append other-fs mappings swaps + other-fs + (append mappings swaps ;; Add the firmware service, unless we are building for a ;; container.