mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-19 05:57:04 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: base: Honor file-system-create-mount-point? at all times.

Browse source 
Fixes <https://issues.guix.gnu.org/40158>.

* gnu/services/base.scm (file-system-shepherd-service): Update doc.  Return a
shepherd service for the mount point when either MOUNT? or CREATE? is true.
[start]: Only mount when MOUNT? is true.
(file-system-shepherd-services): Also consider file systems with
create-mount-point? set to #t.
This commit is contained in:
Maxim Cournoyer 2021-08-05 14:16:50 -04:00
parent 0bc5448cf1
commit 8ad6624b96
No known key found for this signature in database
GPG key ID: 1260E46482E63562
1 changed files with 31 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

53
gnu/services/base.scm
View file

@ -15,6 +15,7 @@
;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re> ;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
;;; Copyright © 2021 qblade <qblade@protonmail.com> ;;; Copyright © 2021 qblade <qblade@protonmail.com>
;;; Copyright © 2021 Hui Lu <luhuins@163.com> ;;; Copyright © 2021 Hui Lu <luhuins@163.com>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -311,17 +312,20 @@ (define dependency->shepherd-service-name
(define (file-system-shepherd-service file-system) (define (file-system-shepherd-service file-system)
"Return the shepherd service for @var{file-system}, or @code{#f} if "Return the shepherd service for @var{file-system}, or @code{#f} if
@var{file-system} is not auto-mounted upon boot." @var{file-system} is not auto-mounted or doesn't have its mount point created
upon boot."
(let ((target (file-system-mount-point file-system)) (let ((target (file-system-mount-point file-system))
(create? (file-system-create-mount-point? file-system)) (create? (file-system-create-mount-point? file-system))
(mount? (file-system-mount? file-system))
(dependencies (file-system-dependencies file-system)) (dependencies (file-system-dependencies file-system))
(packages (file-system-packages (list file-system)))) (packages (file-system-packages (list file-system))))
(and (file-system-mount? file-system) (and (or mount? create?)
(with-imported-modules (source-module-closure (with-imported-modules (source-module-closure
'((gnu build file-systems))) '((gnu build file-systems)))
(shepherd-service (shepherd-service
(provision (list (file-system->shepherd-service-name file-system))) (provision (list (file-system->shepherd-service-name file-system)))
(requirement `(root-file-system udev (requirement `(root-file-system
udev
,@(map dependency->shepherd-service-name dependencies))) ,@(map dependency->shepherd-service-name dependencies)))
(documentation "Check, mount, and unmount the given file system.") (documentation "Check, mount, and unmount the given file system.")
(start #~(lambda args (start #~(lambda args
@ -329,24 +333,26 @@ (define (file-system-shepherd-service file-system)
#~(mkdir-p #$target) #~(mkdir-p #$target)
#t) #t)
(let (($PATH (getenv "PATH"))) #$(if mount?
;; Make sure fsck.ext2 & co. can be found. #~(let (($PATH (getenv "PATH")))
(dynamic-wind ;; Make sure fsck.ext2 & co. can be found.
(lambda () (dynamic-wind
;; Don’t display the PATH settings. (lambda ()
(with-output-to-port (%make-void-port "w") ;; Don’t display the PATH settings.
(lambda () (with-output-to-port (%make-void-port "w")
(set-path-environment-variable "PATH" (lambda ()
'("bin" "sbin") (set-path-environment-variable "PATH"
'#$packages)))) '("bin" "sbin")
(lambda () '#$packages))))
(mount-file-system (lambda ()
(spec->file-system (mount-file-system
'#$(file-system->spec file-system)) (spec->file-system
#:root "/")) '#$(file-system->spec file-system))
(lambda () #:root "/"))
(setenv "PATH" $PATH))) (lambda ()
#t))) (setenv "PATH" $PATH))))
#t)
#t))
(stop #~(lambda args (stop #~(lambda args
;; Normally there are no processes left at this point, so ;; Normally there are no processes left at this point, so
;; TARGET can be safely unmounted. ;; TARGET can be safely unmounted.
@ -365,7 +371,10 @@ (define (file-system-shepherd-service file-system)
(define (file-system-shepherd-services file-systems) (define (file-system-shepherd-services file-systems)
"Return the list of Shepherd services for FILE-SYSTEMS." "Return the list of Shepherd services for FILE-SYSTEMS."
(let* ((file-systems (filter file-system-mount? file-systems))) (let* ((file-systems (filter (lambda (x)
(or (file-system-mount? x)
(file-system-create-mount-point? x)))
file-systems)))
(define sink (define sink
(shepherd-service (shepherd-service
(provision '(file-systems)) (provision '(file-systems))