unofficial mirror of guix-devel@gnu.org 
 help / color / mirror / code / Atom feed
* [PATCH] build: file-systems: Allow for bind mounting regular files.
@ 2015-08-01 19:17 David Thompson
  2015-08-02 12:10 ` Alex Kost
  2015-08-08 18:28 ` Thompson, David
  0 siblings, 2 replies; 11+ messages in thread
From: David Thompson @ 2015-08-01 19:17 UTC (permalink / raw)
  To: guix-devel

[-- Attachment #1: Type: text/plain, Size: 210 bytes --]

As I was working on my container implementation I noticed that
'mount-file-system' doesn't support bind mounting regular files because
it assumes that all mount points are directories.  This patch fixes
that.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-build-file-systems-Allow-for-bind-mounting-regular-f.patch --]
[-- Type: text/x-patch, Size: 1799 bytes --]

From f94fec6cde3826f20c0d69a45c2aa1928c1d0a78 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 1 Aug 2015 13:43:33 -0400
Subject: [PATCH] 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 file changed, 14 insertions(+), 1 deletion(-)

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))
+
 (define (mount-flags->bit-mask flags)
   "Return the number suitable for the 'flags' argument of 'mount' that
 corresponds to the symbols listed in FLAGS."
@@ -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
-- 
2.4.3


[-- Attachment #3: Type: text/plain, Size: 38 bytes --]


-- 
David Thompson
GPG Key: 0FF1D807

^ permalink raw reply related	[flat|nested] 11+ messages in thread

end of thread, other threads:[~2015-08-18 16:43 UTC | newest]

Thread overview: 11+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2015-08-01 19:17 [PATCH] build: file-systems: Allow for bind mounting regular files David Thompson
2015-08-02 12:10 ` Alex Kost
2015-08-02 12:43   ` Thompson, David
2015-08-02 12:51     ` Thompson, David
2015-08-02 13:31       ` Andreas Enge
2015-08-03 12:47       ` Alex Kost
2015-08-06 12:22         ` Thompson, David
2015-08-07  7:06           ` Alex Kost
2015-08-18 15:52     ` Ludovic Courtès
2015-08-18 16:43       ` Thompson, David
2015-08-08 18:28 ` Thompson, David

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).