guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

02/02: file-systems: Add 'file-system-mapping->bind-mount'.


From: Ludovic Courtès
Subject: 02/02: file-systems: Add 'file-system-mapping->bind-mount'.
Date: Thu, 2 Feb 2017 23:23:43 +0000 (UTC)

civodul pushed a commit to branch master
in repository guix.

commit d2a5e6982ddcbe1e5479bda62a72b3a94570855a
Author: Ludovic Courtès <address@hidden>
Date:   Fri Feb 3 00:20:40 2017 +0100

    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 +++++++++++++++++
 gnu/system/linux-container.scm |   21 +++------------------
 guix/scripts/environment.scm   |    3 ++-
 3 files changed, 22 insertions(+), 19 deletions(-)

diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index fa56853..b2721f2 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
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index 24e61c3..bceea41 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <address@hidden>
-;;; Copyright © 2016 Ludovic Courtès <address@hidden>
+;;; Copyright © 2016, 2017 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,25 +30,10 @@
   #:use-module (gnu services)
   #:use-module (gnu system)
   #:use-module (gnu system file-systems)
-  #:export (mapping->file-system
-            system-container
+  #:export (system-container
             containerized-operating-system
             container-script))
 
-(define (mapping->file-system mapping)
-  "Return a file system that realizes MAPPING."
-  (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 (containerized-operating-system os mappings)
   "Return an operating system based on OS for use in a Linux container
 environment.  MAPPINGS is a list of <file-system-mapping> to realize in the
@@ -66,7 +51,7 @@ containerized OS."
             (operating-system-file-systems os)))
 
   (define (mapping->fs fs)
-    (file-system (inherit (mapping->file-system fs))
+    (file-system (inherit (file-system-mapping->bind-mount fs))
       (needed-for-boot? #t)))
 
   (operating-system (inherit os)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 8a3a935..0a1205d 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -433,7 +433,8 @@ host file systems to mount inside the container."
                              (writable? #f)))
                           reqs)))
             (file-systems (append %container-file-systems
-                                  (map mapping->file-system mappings))))
+                                  (map file-system-mapping->bind-mount
+                                       mappings))))
        (exit/status
         (call-with-container file-systems
           (lambda ()



reply via email to

[Prev in Thread] Current Thread [Next in Thread]