summaryrefslogtreecommitdiff
path: root/gnu/build
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2015-08-01 13:43:33 -0400
committerDavid Thompson <dthompson2@worcester.edu>2015-08-08 14:04:00 -0400
commit8c812f2aeeed8398a27f1594c20914031d97db58 (patch)
tree4ba54eb9e3120a5220df0d177adac9ac6a041680 /gnu/build
parent014cbde612f89bc9101e6932f64113415230e9f9 (diff)
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.
Diffstat (limited to 'gnu/build')
-rw-r--r--gnu/build/file-systems.scm15
1 files changed, 14 insertions, 1 deletions
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index c58d23cfbd..377bec278e 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