[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 ()