file-systems: Add a 'mount?' field.

Fixes <http://bugs.gnu.org/22176>.
Reported by Florian Paul Schmidt <mista.tapas@gmx.net>.

* gnu/system/file-systems.scm (<file-system>)[mount?]: New field.
(file-system->spec): Adjust accordingly.
* gnu/services/base.scm (file-system-dmd-service): Return the empty list
when FILE-SYSTEM has 'mount?' set to false.
(user-processes-service): Select the subset of FILE-SYSTEMS that matches
'file-system-mount?'.
* doc/guix.texi (File Systems): Document it.

2 files changed, 59 insertions, 53 deletions

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 67eeecdf17..25143c80a6 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -222,57 +222,60 @@ FILE-SYSTEM."
         (check?  (file-system-check? file-system))
         (create? (file-system-create-mount-point? file-system))
         (dependencies (file-system-dependencies file-system)))
-    (list (dmd-service
-           (provision (list (file-system->dmd-service-name file-system)))
-           (requirement `(root-file-system
-                          ,@(map dependency->dmd-service-name dependencies)))
-           (documentation "Check, mount, and unmount the given file system.")
-           (start #~(lambda args
-                      ;; FIXME: Use or factorize with 'mount-file-system'.
-                      (let ((device (canonicalize-device-spec #$device '#$title))
-                            (flags  #$(mount-flags->bit-mask
-                                       (file-system-flags file-system))))
-                        #$(if create?
-                              #~(mkdir-p #$target)
-                              #~#t)
-                        #$(if check?
-                              #~(begin
-                                  ;; Make sure fsck.ext2 & co. can be found.
-                                  (setenv "PATH"
-                                          (string-append
-                                           #$e2fsprogs "/sbin:"
-                                           "/run/current-system/profile/sbin:"
-                                           (getenv "PATH")))
-                                  (check-file-system device #$type))
-                              #~#t)
-
-                        (mount device #$target #$type flags
-                               #$(file-system-options file-system))
-
-                        ;; For read-only bind mounts, an extra remount is needed,
-                        ;; as per <http://lwn.net/Articles/281157/>, which still
-                        ;; applies to Linux 4.0.
-                        (when (and (= MS_BIND (logand flags MS_BIND))
-                                   (= MS_RDONLY (logand flags MS_RDONLY)))
-                          (mount device #$target #$type
-                                 (logior MS_BIND MS_REMOUNT MS_RDONLY))))
-                      #t))
-           (stop #~(lambda args
-                     ;; Normally there are no processes left at this point, so
-                     ;; TARGET can be safely unmounted.
-
-                     ;; Make sure PID 1 doesn't keep TARGET busy.
-                     (chdir "/")
-
-                     (umount #$target)
-                     #f))
-
-           ;; We need an additional module.
-           (modules `(((gnu build file-systems)
-                       #:select (check-file-system canonicalize-device-spec))
-                      ,@%default-modules))
-           (imported-modules `((gnu build file-systems)
-                               ,@%default-imported-modules))))))
+    (if (file-system-mount? file-system)
+        (list
+         (dmd-service
+          (provision (list (file-system->dmd-service-name file-system)))
+          (requirement `(root-file-system
+                         ,@(map dependency->dmd-service-name dependencies)))
+          (documentation "Check, mount, and unmount the given file system.")
+          (start #~(lambda args
+                     ;; FIXME: Use or factorize with 'mount-file-system'.
+                     (let ((device (canonicalize-device-spec #$device '#$title))
+                           (flags  #$(mount-flags->bit-mask
+                                      (file-system-flags file-system))))
+                       #$(if create?
+                             #~(mkdir-p #$target)
+                             #~#t)
+                       #$(if check?
+                             #~(begin
+                                 ;; Make sure fsck.ext2 & co. can be found.
+                                 (setenv "PATH"
+                                         (string-append
+                                          #$e2fsprogs "/sbin:"
+                                          "/run/current-system/profile/sbin:"
+                                          (getenv "PATH")))
+                                 (check-file-system device #$type))
+                             #~#t)
+
+                       (mount device #$target #$type flags
+                              #$(file-system-options file-system))
+
+                       ;; For read-only bind mounts, an extra remount is
+                       ;; needed, as per <http://lwn.net/Articles/281157/>,
+                       ;; which still applies to Linux 4.0.
+                       (when (and (= MS_BIND (logand flags MS_BIND))
+                                  (= MS_RDONLY (logand flags MS_RDONLY)))
+                         (mount device #$target #$type
+                                (logior MS_BIND MS_REMOUNT MS_RDONLY))))
+                     #t))
+          (stop #~(lambda args
+                    ;; Normally there are no processes left at this point, so
+                    ;; TARGET can be safely unmounted.
+
+                    ;; Make sure PID 1 doesn't keep TARGET busy.
+                    (chdir "/")
+
+                    (umount #$target)
+                    #f))
+
+          ;; We need an additional module.
+          (modules `(((gnu build file-systems)
+                      #:select (check-file-system canonicalize-device-spec))
+                     ,@%default-modules))
+          (imported-modules `((gnu build file-systems)
+                              ,@%default-imported-modules))))
+        '())))
 
 (define file-system-service-type
   ;; TODO(?): Make this an extensible service that takes <file-system> objects
@@ -416,7 +419,7 @@ services corresponding to FILE-SYSTEMS.
 All the services that spawn processes must depend on this one so that they are
 stopped before 'kill' is called."
   (service user-processes-service-type
-           (list file-systems grace-delay)))
+           (list (filter file-system-mount? file-systems) grace-delay)))
 
 
 ;;;
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 0a4b385fe3..47a3dbc1e8 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -35,6 +35,7 @@
             file-system-needed-for-boot?
             file-system-flags
             file-system-options
+            file-system-mount?
             file-system-check?
             file-system-create-mount-point?
             file-system-dependencies
@@ -93,6 +94,8 @@
                     (default '()))
   (options          file-system-options           ; string or #f
                     (default #f))
+  (mount?           file-system-mount?            ; Boolean
+                    (default #t))
   (needed-for-boot? %file-system-needed-for-boot? ; Boolean
                     (default #f))
   (check?           file-system-check?            ; Boolean
@@ -112,7 +115,7 @@ file system."
   "Return a list corresponding to file-system FS that can be passed to the
 initrd code."
   (match fs
-    (($ <file-system> device title mount-point type flags options _ check?)
+    (($ <file-system> device title mount-point type flags options _ _ check?)
      (list device title mount-point type flags options check?))))
 
 (define %uuid-rx