aboutsummaryrefslogtreecommitdiff
path: root/gnu/system/linux-container.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-02-03 00:20:40 +0100
committerLudovic Courtès <ludo@gnu.org>2017-02-03 00:23:28 +0100
commitd2a5e6982ddcbe1e5479bda62a72b3a94570855a (patch)
treeafc74823fd2f8b40570593e61d05196ef2df8063 /gnu/system/linux-container.scm
parent0f31d4f07f8203305c486da76cdeee57ae8a4efc (diff)
downloadguix-d2a5e6982ddcbe1e5479bda62a72b3a94570855a.tar
guix-d2a5e6982ddcbe1e5479bda62a72b3a94570855a.tar.gz
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.
Diffstat (limited to 'gnu/system/linux-container.scm')
-rw-r--r--gnu/system/linux-container.scm21
1 files changed, 3 insertions, 18 deletions
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index 24e61c3ead..bceea41332 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 <davet@gnu.org>
-;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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)