From 6edd5c546c7c1bb5ee45436a0441a9daf1e5509c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 10 May 2019 18:16:45 +0200 Subject: 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. --- gnu/system/linux-container.scm | 47 +++++++++++++++++++++--------------------- 1 file 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 @@ (define base 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 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 @@ (define useless-services (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 @@ (define shared-network-file-mappings (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 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))) -- cgit v1.2.3