From d2a5e6982ddcbe1e5479bda62a72b3a94570855a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 3 Feb 2017 00:20:40 +0100
Subject: file-systems: Add 'file-system-mapping->bind-mount'.

* gnu/system/file-systems.scm (file-system-mapping->bind-mount): New
procedure.
* gnu/system/linux-container.scm (mapping->file-system): Remove.
(containerized-operating-system)[mapping->fs]: Use
'file-system-mapping->bind-mount' instead of 'mapping->file-system'.
* guix/scripts/environment.scm (launch-environment/container): Likewise.
---
 gnu/system/file-systems.scm | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)

(limited to 'gnu/system/file-systems.scm')

diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index fa56853fd1..b2721f2389 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -63,6 +63,8 @@
             file-system-mapping-target
             file-system-mapping-writable?
 
+            file-system-mapping->bind-mount
+
             %store-mapping))
 
 ;;; Commentary:
@@ -352,6 +354,21 @@ TARGET in the other system."
   (writable? file-system-mapping-writable?        ;Boolean
              (default #f)))
 
+(define (file-system-mapping->bind-mount mapping)
+  "Return a file system that realizes MAPPING, a <file-system-mapping>, using
+a bind mount."
+  (match mapping
+    (($ <file-system-mapping> source target writable?)
+     (file-system
+       (mount-point target)
+       (device source)
+       (type "none")
+       (flags (if writable?
+                  '(bind-mount)
+                  '(bind-mount read-only)))
+       (check? #f)
+       (create-mount-point? #t)))))
+
 (define %store-mapping
   ;; Mapping of the host's store into the guest.
   (file-system-mapping
-- 
cgit v1.2.3