file-system: Add mount-may-fail? option.

* gnu/system/file-systems.scm (<file-system>): Add a mount-may-fail? field.
(file-system->spec): adapt accordingly,
(spec->file-system): ditto.
* gnu/build/file-systems.scm (mount-file-system): If 'system-error is raised
and mount-may-fail? is true, ignore it. Otherwise, re-raise the exception.

Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>

gnu/build/file-systems.scm

@@ -814,8 +814,11 @@ corresponds to the symbols listed in FLAGS."
     (when (file-system-check? fs)
       (check-file-system source type))
 
+    (catch 'system-error
+      (lambda ()
         ;; Create the mount point.  Most of the time this is a directory, but
-    ;; in the case of a bind mount, a regular file or socket may be needed.
+        ;; in the case of a bind mount, a regular file or socket may be
+        ;; needed.
         (if (and (= MS_BIND (logand flags MS_BIND))
                  (not (file-is-directory? source)))
             (unless (file-exists? mount-point)
@@ -830,10 +833,14 @@ corresponds to the symbols listed in FLAGS."
           (mount source mount-point type flags options)))
 
         ;; For read-only bind mounts, an extra remount is needed, as per
-    ;; <http://lwn.net/Articles/281157/>, which still applies to Linux 4.0.
+        ;; <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)))
           (let ((flags (logior MS_BIND MS_REMOUNT MS_RDONLY)))
-        (mount source mount-point type flags #f)))))
+            (mount source mount-point type flags #f))))
+      (lambda args
+        (or (file-system-mount-may-fail? fs)
+            (apply throw args))))))
 
 ;;; file-systems.scm ends here

gnu/system/file-systems.scm

@@ -48,6 +48,7 @@
             alist->file-system-options
 
             file-system-mount?
+            file-system-mount-may-fail?
             file-system-check?
             file-system-create-mount-point?
             file-system-dependencies
@@ -114,6 +115,8 @@
                     (default #f))
   (mount?           file-system-mount?            ; Boolean
                     (default #t))
+  (mount-may-fail?  file-system-mount-may-fail?   ; Boolean
+                    (default #f))
   (needed-for-boot? %file-system-needed-for-boot? ; Boolean
                     (default #f))
   (check?           file-system-check?            ; Boolean
@@ -301,18 +304,19 @@ store--e.g., if FS is the root file system."
   "Return a list corresponding to file-system FS that can be passed to the
 initrd code."
   (match fs
-    (($ <file-system> device mount-point type flags options _ _ check?)
+    (($ <file-system> device mount-point type flags options mount?
+                      mount-may-fail? needed-for-boot? check?)
      (list (cond ((uuid? device)
                   `(uuid ,(uuid-type device) ,(uuid-bytevector device)))
                  ((file-system-label? device)
                   `(file-system-label ,(file-system-label->string device)))
                  (else device))
-           mount-point type flags options check?))))
+           mount-point type flags options mount-may-fail? check?))))
 
 (define (spec->file-system sexp)
   "Deserialize SEXP, a list, to the corresponding <file-system> object."
   (match sexp
-    ((device mount-point type flags options check?)
+    ((device mount-point type flags options mount-may-fail? check?)
      (file-system
        (device (match device
                  (('uuid (? symbol? type) (? bytevector? bv))
@@ -323,6 +327,7 @@ initrd code."
                   device)))
        (mount-point mount-point) (type type)
        (flags flags) (options options)
+       (mount-may-fail? mount-may-fail?)
        (check? check?)))))
 
 (define (specification->file-system-mapping spec writable?)