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

[guix-commits]

This is an automated email from the git hooks/post-receive script.

apteryx pushed a commit to branch master
in repository guix.

The following commit(s) were added to refs/heads/master by this push:
     new 8ad6624  services: base: Honor file-system-create-mount-point? at all 
times.
8ad6624 is described below

commit 8ad6624b96b31c2eeaf9a17309da2d2c6fdcf1d9
Author: Maxim Cournoyer <maxim.cournoyer@gmail.com>
AuthorDate: Thu Aug 5 14:16:50 2021 -0400

    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.
---
 gnu/services/base.scm | 53 ++++++++++++++++++++++++++++++---------------------
 1 file changed, 31 insertions(+), 22 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index c784d31..5086505 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -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))