file-systems: 'mount-file-system' now takes a <file-system> object.

* gnu/build/file-systems.scm (mount-file-system): Rename 'spec' to 'fs'
and assume it's a <file-system>.
* gnu/build/linux-boot.scm (boot-system): Assume MOUNTS is a list of
<file-system> and adjust accordingly.
* gnu/build/linux-container.scm (mount-file-systems): Remove
'file-system->spec' call.
* gnu/services/base.scm (file-system-shepherd-service): Add
'spec->file-system' call.  Add (gnu system file-systems) to 'modules'.
* gnu/system/linux-initrd.scm (raw-initrd): Use (gnu system
file-systems).  Add 'spec->file-system' call for #:mounts.

3 files changed, 47 insertions, 47 deletions

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 140bcb414b..bcb0c53628 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -20,9 +20,11 @@
 
 (define-module (gnu build file-systems)
   #:use-module (gnu system uuid)
+  #:use-module (gnu system file-systems)
   #:use-module (guix build utils)
   #:use-module (guix build bournish)
-  #:use-module (guix build syscalls)
+  #:use-module ((guix build syscalls)
+                #:hide (file-system-type))
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
@@ -552,11 +554,8 @@ corresponds to the symbols listed in FLAGS."
       (()
        0))))
 
-(define* (mount-file-system spec #:key (root "/root"))
-  "Mount the file system described by SPEC under ROOT.  SPEC must have the
-form:
-
-  (DEVICE TITLE MOUNT-POINT TYPE (FLAGS ...) OPTIONS CHECK?)
+(define* (mount-file-system fs #:key (root "/root"))
+  "Mount the file system described by FS, a <file-system> object, under ROOT.
 
 DEVICE, MOUNT-POINT, and TYPE must be strings; OPTIONS can be a string or #f;
 FLAGS must be a list of symbols.  CHECK? is a Boolean indicating whether to
@@ -582,34 +581,36 @@ run a file system check."
                             (if options
                                 (string-append "," options)
                                 "")))))
-  (match spec
-    ((source title mount-point type (flags ...) options check?)
-     (let ((source      (canonicalize-device-spec source title))
-           (mount-point (string-append root "/" mount-point))
-           (flags       (mount-flags->bit-mask flags)))
-       (when check?
-         (check-file-system source type))
-
-       ;; 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.
-       (if (and (= MS_BIND (logand flags MS_BIND))
-                (not (file-is-directory? source)))
-           (unless (file-exists? mount-point)
-             (mkdir-p (dirname mount-point))
-             (call-with-output-file mount-point (const #t)))
-           (mkdir-p mount-point))
-
-       (cond
-        ((string-prefix? "nfs" type)
-         (mount-nfs source mount-point type flags options))
-        (else
-         (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.
-       (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)))))))
+  (let ((type        (file-system-type fs))
+        (options     (file-system-options fs))
+        (source      (canonicalize-device-spec (file-system-device fs)
+                                               (file-system-title fs)))
+        (mount-point (string-append root "/"
+                                    (file-system-mount-point fs)))
+        (flags       (mount-flags->bit-mask (file-system-flags fs))))
+    (when (file-system-check? fs)
+      (check-file-system source type))
+
+    ;; 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.
+    (if (and (= MS_BIND (logand flags MS_BIND))
+             (not (file-is-directory? source)))
+        (unless (file-exists? mount-point)
+          (mkdir-p (dirname mount-point))
+          (call-with-output-file mount-point (const #t)))
+        (mkdir-p mount-point))
+
+    (cond
+     ((string-prefix? "nfs" type)
+      (mount-nfs source mount-point type flags options))
+     (else
+      (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.
+    (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)))))
 
 ;;; file-systems.scm ends here
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 360ef3faed..3712abe910 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -27,9 +27,11 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 ftw)
   #:use-module (guix build utils)
-  #:use-module (guix build syscalls)
+  #:use-module ((guix build syscalls)
+                #:hide (file-system-type))
   #:use-module (gnu build linux-modules)
   #:use-module (gnu build file-systems)
+  #:use-module (gnu system file-systems)
   #:export (mount-essential-file-systems
             linux-command-line
             find-long-option
@@ -349,19 +351,17 @@ supports kernel command-line options '--load', '--root', and '--repl'.
 Mount the root file system, specified by the '--root' command-line argument,
 if any.
 
-MOUNTS must be a list suitable for 'mount-file-system'.
+MOUNTS must be a list of <file-system> objects.
 
 When VOLATILE-ROOT? is true, the root file system is writable but any changes
 to it are lost."
-  (define root-mount-point?
-    (match-lambda
-     ((device _ "/" _ ...) #t)
-     (_ #f)))
+  (define (root-mount-point? fs)
+    (string=? (file-system-mount-point fs) "/"))
 
   (define root-fs-type
-    (or (any (match-lambda
-              ((device _ "/" type _ ...) type)
-              (_ #f))
+    (or (any (lambda (fs)
+               (and (root-mount-point? fs)
+                    (file-system-type fs)))
              mounts)
         "ext4"))
 
diff --git a/gnu/build/linux-container.scm b/gnu/build/linux-container.scm
index 95bfd92dde..70e789403f 100644
--- a/gnu/build/linux-container.scm
+++ b/gnu/build/linux-container.scm
@@ -152,8 +152,7 @@ for the process."
 
   ;; Mount user-specified file systems.
   (for-each (lambda (file-system)
-              (mount-file-system (file-system->spec file-system)
-                                 #:root root))
+              (mount-file-system file-system #:root root))
             mounts)
 
   ;; Jail the process inside the container's root file system.