On Sun, Aug 2, 2015 at 8:10 AM, Alex Kost <[email protected]> wrote: > David Thompson (2015-08-01 22:17 +0300) wrote: > >> diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm >> index c58d23c..f0d6f70 100644 >> --- a/gnu/build/file-systems.scm >> +++ b/gnu/build/file-systems.scm >> @@ -305,6 +305,10 @@ the following: >> fsck code device) >> (start-repl))))) >> >> +(define (regular-file? file-name) >> + "Return #t if FILE-NAME is a regular file." >> + (eq? (stat:type (stat file-name)) 'regular)) > > There are similar procedures in (guix build utils): 'directory-exists?', > 'executable-file?' and 'symbolic-link?'. So I think it is better to put > 'regular-file?' there. WDYT?
Sure, that makes sense. Done. - Dave
From 1b2413bd06b1e769edfbe4d170de41398015a67d Mon Sep 17 00:00:00 2001 From: David Thompson <[email protected]> Date: Sat, 1 Aug 2015 13:43:33 -0400 Subject: [PATCH] build: file-systems: Allow for bind mounting regular files. * guix/build/utils.scm (regular-file?): New procedure. * gnu/build/file-systems.scm (mount-file-system): Create a regular file instead of a directory when bind mounting a regular file. --- gnu/build/file-systems.scm | 11 ++++++++++- guix/build/utils.scm | 5 +++++ 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index c58d23c..f0b4b79 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -339,7 +339,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 diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 676a012..b9543ed 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -38,6 +38,7 @@ directory-exists? executable-file? symbolic-link? + regular-file? call-with-ascii-input-file elf-file? ar-file? @@ -110,6 +111,10 @@ "Return #t if FILE is a symbolic link (aka. \"symlink\".)" (eq? (stat:type (lstat file)) 'symlink)) +(define (regular-file? file-name) + "Return #t if FILE-NAME is a regular file." + (eq? (stat:type (stat file-name)) 'regular)) + (define (call-with-ascii-input-file file proc) "Open FILE as an ASCII or binary file, and pass the resulting port to PROC. FILE is closed when PROC's dynamic extent is left. Return the -- 2.4.3
