futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

linux-container: Do not add %CONTAINER-FILE-SYSTEMS to Docker image OSes.

Browse Source 
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.
This commit is contained in:
Ludovic Courtès 2019-05-10 18:16:45 +02:00
parent 32747aa987
commit 6edd5c546c
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 23 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
gnu/system/linux-container.scm
View File

@ -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)))