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

53
gnu/services/base.scm
View File

@ -15,6 +15,7 @@
;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
;;; Copyright © 2021 qblade <qblade@protonmail.com>
;;; Copyright © 2021 Hui Lu <luhuins@163.com>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -311,17 +312,20 @@ FILE-SYSTEM."
(define (file-system-shepherd-service file-system)
"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))
(create? (file-system-create-mount-point? file-system))
(mount? (file-system-mount? file-system))
(dependencies (file-system-dependencies 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
'((gnu build file-systems)))
(shepherd-service
(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)))
(documentation "Check, mount, and unmount the given file system.")
(start #~(lambda args
@ -329,24 +333,26 @@ FILE-SYSTEM."
#~(mkdir-p #$target)
#t)
(let (($PATH (getenv "PATH")))
;; Make sure fsck.ext2 & co. can be found.
(dynamic-wind
(lambda ()
;; Don’t display the PATH settings.
(with-output-to-port (%make-void-port "w")
(lambda ()
(set-path-environment-variable "PATH"
'("bin" "sbin")
'#$packages))))
(lambda ()
(mount-file-system
(spec->file-system
'#$(file-system->spec file-system))
#:root "/"))
(lambda ()
(setenv "PATH" $PATH)))
#t)))
#$(if mount?
#~(let (($PATH (getenv "PATH")))
;; Make sure fsck.ext2 & co. can be found.
(dynamic-wind
(lambda ()
;; Don’t display the PATH settings.
(with-output-to-port (%make-void-port "w")
(lambda ()
(set-path-environment-variable "PATH"
'("bin" "sbin")
'#$packages))))
(lambda ()
(mount-file-system
(spec->file-system
'#$(file-system->spec file-system))
#:root "/"))
(lambda ()
(setenv "PATH" $PATH))))
#t)
#t))
(stop #~(lambda args
;; Normally there are no processes left at this point, so
;; TARGET can be safely unmounted.
@ -365,7 +371,10 @@ FILE-SYSTEM."
(define (file-system-shepherd-services 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
(shepherd-service
(provision '(file-systems))