nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

linux-container: Compute essential services for THIS-OPERATING-SYSTEM. 

Previously, the 'essential-services' would correspond to the initial,
non-containerized OS.  Thus, all the file systems removed in
'container-essential-services' would actually still be there because the
essential services would be computed on the non-containerized OS.

This is a followup to 69cae3d335.

* gnu/system/linux-container.scm (container-essential-services): Call
'operating-system-default-essential-services' to get the baseline
services.
(containerized-operating-system): Pass THIS-OPERATING-SYSTEM, not OS, to
'container-essential-services'.
Add a dummy root file system to 'file-systems'.
(container-script)[mountable-file-system?]: New procedure.
Use it.
This commit is contained in:
Ludovic Courtès 2019-05-10 22:07:55 +02:00
parent 6edd5c546c
commit 3f9bed04f0
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 17 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -46,7 +46,7 @@ from OS that are needed on the bare metal and not in a container."
(list (service-kind %linux-bare-metal-service) (list (service-kind %linux-bare-metal-service)
firmware-service-type firmware-service-type
system-service-type))) system-service-type)))
(operating-system-essential-services os))) (operating-system-default-essential-services os)))
(cons (service system-service-type (cons (service system-service-type
(let ((locale (operating-system-locale-directory os))) (let ((locale (operating-system-locale-directory os)))
@ -103,14 +103,22 @@ containerized OS. EXTRA-FILE-SYSTEMS is a list of file systems to add to OS."
(inherit os) (inherit os)
(swap-devices '()) ; disable swap (swap-devices '()) ; disable swap
(essential-services (container-essential-services (essential-services (container-essential-services
os #:shared-network? shared-network?)) this-operating-system
#:shared-network? shared-network?))
(services (remove (lambda (service) (services (remove (lambda (service)
(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 mappings) (file-systems (append (map mapping->fs mappings)
extra-file-systems extra-file-systems
user-file-systems)))) user-file-systems
;; Provide a dummy root file system so we can create
;; a 'boot-parameters' file.
(list (file-system
(mount-point "/")
(device "nothing")
(type "dummy")))))))
(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.
@ -126,6 +134,11 @@ that will be shared with the host system."
(target nscd-run-directory))) (target nscd-run-directory)))
'())))) '()))))
(define (mountable-file-system? file-system)
;; Return #t if FILE-SYSTEM should be mounted in the container.
(and (not (string=? "/" (file-system-mount-point file-system)))
(file-system-needed-for-boot? file-system)))
(let* ((os (containerized-operating-system (let* ((os (containerized-operating-system
os os
(cons %store-mapping (cons %store-mapping
@ -134,7 +147,7 @@ that will be shared with the host system."
mappings)) mappings))
#:shared-network? shared-network? #:shared-network? shared-network?
#:extra-file-systems %container-file-systems)) #:extra-file-systems %container-file-systems))
(file-systems (filter file-system-needed-for-boot? (file-systems (filter mountable-file-system?
(operating-system-file-systems os))) (operating-system-file-systems os)))
(specs (map file-system->spec file-systems))) (specs (map file-system->spec file-systems)))