me
/
guix
Archived
1
0
Fork 0
Code

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

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.
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

23
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 @@ FILE-SYSTEM."
(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,7 +333,8 @@ FILE-SYSTEM."
#~(mkdir-p #$target) #~(mkdir-p #$target)
#t) #t)
(let (($PATH (getenv "PATH"))) #$(if mount?
#~(let (($PATH (getenv "PATH")))
;; Make sure fsck.ext2 & co. can be found. ;; Make sure fsck.ext2 & co. can be found.
(dynamic-wind (dynamic-wind
(lambda () (lambda ()
@ -345,8 +350,9 @@ FILE-SYSTEM."
'#$(file-system->spec file-system)) '#$(file-system->spec file-system))
#:root "/")) #:root "/"))
(lambda () (lambda ()
(setenv "PATH" $PATH))) (setenv "PATH" $PATH))))
#t))) #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 @@ 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))