01/02: build: file-systems: Allow for bind mounting regular files.

[David Thompson]

davexunit pushed a commit to branch master
in repository guix.

commit 8c812f2aeeed8398a27f1594c20914031d97db58
Author: David Thompson <address@hidden>
Date:   Sat Aug 1 13:43:33 2015 -0400

    build: file-systems: Allow for bind mounting regular files.
    
    * gnu/build/file-systems.scm (regular-file?): New procedure.
      (mount-file-system): Create a regular file instead of a directory when 
bind
      mounting a regular file.
---
 gnu/build/file-systems.scm |   15 ++++++++++++++-
 1 files changed, 14 insertions(+), 1 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index c58d23c..377bec2 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -323,6 +323,10 @@ corresponds to the symbols listed in FLAGS."
       (()
        0))))
 
+(define (regular-file? file-name)
+  "Return #t if FILE-NAME is a regular file."
+  (eq? (stat:type (stat file-name)) 'regular))
+
 (define* (mount-file-system spec #:key (root "/root"))
   "Mount the file system described by SPEC under ROOT.  SPEC must have the
 form:
@@ -339,7 +343,16 @@ run a file system check."
            (flags       (mount-flags->bit-mask flags)))
        (when check?
          (check-file-system source type))
-       (mkdir-p mount-point)
+
+       ;; Create the mount point.  Most of the time this is a directory, but
+       ;; in the case of a bind mount, a regular file may be needed.
+       (if (and (= MS_BIND (logand flags MS_BIND))
+                (regular-file? source))
+           (begin
+             (mkdir-p (dirname mount-point))
+             (call-with-output-file mount-point (const #t)))
+           (mkdir-p mount-point))
+
        (mount source mount-point type flags options)
 
        ;; For read-only bind mounts, an extra remount is needed, as per