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.
This commit is contained in:
parent
32747aa987
commit
6edd5c546c
|
@ -65,10 +65,13 @@ from OS that are needed on the bare metal and not in a container."
|
||||||
files)))
|
files)))
|
||||||
base)))
|
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
|
"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
|
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
|
(define user-file-systems
|
||||||
(remove (lambda (fs)
|
(remove (lambda (fs)
|
||||||
(let ((target (file-system-mount-point fs))
|
(let ((target (file-system-mount-point fs))
|
||||||
|
@ -96,19 +99,6 @@ containerized OS."
|
||||||
(list nscd-service-type)
|
(list nscd-service-type)
|
||||||
(list))))
|
(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
|
(operating-system
|
||||||
(inherit os)
|
(inherit os)
|
||||||
(swap-devices '()) ; disable swap
|
(swap-devices '()) ; disable swap
|
||||||
|
@ -118,23 +108,32 @@ containerized OS."
|
||||||
(memq (service-kind service)
|
(memq (service-kind service)
|
||||||
useless-services))
|
useless-services))
|
||||||
(operating-system-user-services os)))
|
(operating-system-user-services os)))
|
||||||
(file-systems (append (map mapping->fs
|
(file-systems (append (map mapping->fs mappings)
|
||||||
(cons %store-mapping
|
extra-file-systems
|
||||||
(append mappings
|
|
||||||
(if shared-network?
|
|
||||||
shared-network-file-mappings
|
|
||||||
(list)))))
|
|
||||||
%container-file-systems
|
|
||||||
user-file-systems))))
|
user-file-systems))))
|
||||||
|
|
||||||
(define* (container-script os #:key (mappings '()) shared-network?)
|
(define* (container-script os #:key (mappings '()) shared-network?)
|
||||||
"Return a derivation of a script that runs OS as a Linux container.
|
"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
|
MAPPINGS is a list of <file-system> objects that specify the files/directories
|
||||||
that will be shared with the host system."
|
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
|
(let* ((os (containerized-operating-system
|
||||||
os
|
os
|
||||||
mappings
|
(cons %store-mapping
|
||||||
#:shared-network? shared-network?))
|
(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?
|
(file-systems (filter file-system-needed-for-boot?
|
||||||
(operating-system-file-systems os)))
|
(operating-system-file-systems os)))
|
||||||
(specs (map file-system->spec file-systems)))
|
(specs (map file-system->spec file-systems)))
|
||||||
|
|
Loading…
Reference in New Issue