diff options
author | David Thompson <dthompson2@worcester.edu> | 2015-08-01 13:43:33 -0400 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2015-08-08 14:04:00 -0400 |
commit | 8c812f2aeeed8398a27f1594c20914031d97db58 (patch) | |
tree | 4ba54eb9e3120a5220df0d177adac9ac6a041680 | |
parent | 014cbde612f89bc9101e6932f64113415230e9f9 (diff) | |
download | guix-8c812f2aeeed8398a27f1594c20914031d97db58.tar guix-8c812f2aeeed8398a27f1594c20914031d97db58.tar.gz |
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.
-rw-r--r-- | 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 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 |