summaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-05-10 18:16:45 +0200
committerLudovic Courtès <ludo@gnu.org>2019-05-15 16:36:21 +0200
commit6edd5c546c7c1bb5ee45436a0441a9daf1e5509c (patch)
treedf58794499e3ba22c85bff5192fe3fd76d4cedc5 /gnu/system
parent32747aa987bd921bc8aadc1c1d4b4da6d9bcc306 (diff)
linux-container: Do not add %CONTAINER-FILE-SYSTEMS to Docker image OSes.
Previously, 'guix system docker-image' would end up providing an OS that would try to mount all of %CONTAINER-FILE-SYSTEMS as well as /gnu/store, which is bound to fail in unprivileged Docker. This patch makes it so that 'guix system container' still gets those file systems, but 'guix system docker-image' doesn't. * gnu/system/linux-container.scm (containerized-operating-system): Add #:extra-file-systems parameter and honor it. Do not include %STORE-MAPPING and SHARED-NETWORK-FILE-MAPPINGS. (container-script): Add %STORE-MAPPING and optionally NETWORK-MAPPINGS to MAPPINGS and pass #:extra-file-systems.
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/linux-container.scm47
1 files changed, 23 insertions, 24 deletions
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index ce786e39b2..0cfd7efd99 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -65,10 +65,13 @@ from OS that are needed on the bare metal and not in a container."
files)))
base)))
-(define* (containerized-operating-system os mappings #:key shared-network?)
+(define* (containerized-operating-system os mappings
+ #:key
+ shared-network?
+ (extra-file-systems '()))
"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
-containerized OS."
+containerized OS. EXTRA-FILE-SYSTEMS is a list of file systems to add to OS."
(define user-file-systems
(remove (lambda (fs)
(let ((target (file-system-mount-point fs))
@@ -96,19 +99,6 @@ containerized OS."
(list nscd-service-type)
(list))))
- (define shared-network-file-mappings
- ;; Files to map if network is to be shared with the host
- (append %network-file-mappings
- (let ((nscd-run-directory "/var/run/nscd"))
- (if (file-exists? nscd-run-directory)
- (list (file-system-mapping
- (source nscd-run-directory)
- (target nscd-run-directory)))
- (list)))))
-
- ;; (write shared-network-file-mappings)
- ;; (newline)
-
(operating-system
(inherit os)
(swap-devices '()) ; disable swap
@@ -118,23 +108,32 @@ containerized OS."
(memq (service-kind service)
useless-services))
(operating-system-user-services os)))
- (file-systems (append (map mapping->fs
- (cons %store-mapping
- (append mappings
- (if shared-network?
- shared-network-file-mappings
- (list)))))
- %container-file-systems
+ (file-systems (append (map mapping->fs mappings)
+ extra-file-systems
user-file-systems))))
(define* (container-script os #:key (mappings '()) shared-network?)
"Return a derivation of a script that runs OS as a Linux container.
MAPPINGS is a list of <file-system> objects that specify the files/directories
that will be shared with the host system."
+ (define network-mappings
+ ;; Files to map if network is to be shared with the host
+ (append %network-file-mappings
+ (let ((nscd-run-directory "/var/run/nscd"))
+ (if (file-exists? nscd-run-directory)
+ (list (file-system-mapping
+ (source nscd-run-directory)
+ (target nscd-run-directory)))
+ '()))))
+
(let* ((os (containerized-operating-system
os
- mappings
- #:shared-network? shared-network?))
+ (cons %store-mapping
+ (if shared-network?
+ (append network-mappings mappings)
+ mappings))
+ #:shared-network? shared-network?
+ #:extra-file-systems %container-file-systems))
(file-systems (filter file-system-needed-for-boot?
(operating-system-file-systems os)))
(specs (map file-system->spec file-systems)))