bug#40158: mount point is not created if mount? is #f

[Maxim Cournoyer <maxim.cournoyer@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 571 bytes --]

Hello,

maxim.cournoyer@gmail.com writes:

> Consider the following file system record:
>
> (file-system
>   (device "some-server:/mnt/scratch/yocto-sstate")"
>   (mount-point "/mnt/scratch/yocto-sstate")
>   (create-mount-point? #t)
>   (type "nfs")
>   (mount? #f)
>   (options "soft")
>   (flags '(no-exec)))
>
> Even though a user would think the mount point would be created, it is
> not, I'm guessing because mount? is #f.
>
> Maxim

I had the "chance" again today to meet this issue, so I took it by the
horns and came up with the attached patch, which fixes it:


[-- Attachment #2: 0001-services-base-Honor-file-system-create-mount-point-a.patch --]
[-- Type: text/x-patch, Size: 5537 bytes --]

From 5f9585e5fd74e192cab8a1e4e3c025cf217f26d3 Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Date: Thu, 5 Aug 2021 14:16:50 -0400
Subject: [PATCH] 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 e206bea5f0..6791dff101 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))
-- 
2.32.0


[-- Attachment #3: Type: text/plain, Size: 16 bytes --]


Thanks,

Maxim