linux-container: Inherit essential services.

Currently it's not possible to set `essential-services' when building
operating systems for containers, since `container-essential-services'
always uses the defaults.

It's possible to reference `essential-services' from the operating
system that's passed in, but since it's thunked, the operating system
needs to be defined in two passes to avoid an infinite loop.

* gnu/system/linux-container.scm (container-essential-services): Use
operating-system-essential-services instead of the defaults to allow
overriding the base services.
(containerized-operating-system): Update accordingly.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Change-Id: I81452487ef1ad01d3fa874c26d93a67d58ce6062
This commit is contained in:
Leo Nikkilä 2024-01-17 23:48:35 +02:00 committed by Ludovic Courtès
parent 14210b7f58
commit 841fd4880a
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -6,6 +6,7 @@
;;; Copyright © 2020 Google LLC ;;; Copyright © 2020 Google LLC
;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2023 Pierre Langlois <pierre.langlois@gmx.com> ;;; Copyright © 2023 Pierre Langlois <pierre.langlois@gmx.com>
;;; Copyright © 2024 Leo Nikkilä <hello@lnikki.la>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -56,7 +57,7 @@ (define base
(if shared-network? (if shared-network?
(list hosts-service-type) (list hosts-service-type)
'())))) '()))))
(operating-system-default-essential-services os))) (operating-system-essential-services os)))
(cons (service system-service-type (cons (service system-service-type
`(("locale" ,(operating-system-locale-directory os)))) `(("locale" ,(operating-system-locale-directory os))))
@ -144,48 +145,53 @@ (define services-to-add
(list (service dummy-networking-service-type)) (list (service dummy-networking-service-type))
'())) '()))
(operating-system (define os-with-base-essential-services
(inherit os) (operating-system
(swap-devices '()) ; disable swap (inherit os)
(essential-services (container-essential-services (swap-devices '()) ; disable swap
this-operating-system (services
#:shared-network? shared-network?)) (append services-to-add
(services (filter-map (lambda (s)
(append services-to-add (cond ((memq (service-kind s) services-to-drop)
(filter-map (lambda (s) #f)
(cond ((memq (service-kind s) services-to-drop) ((eq? nscd-service-type (service-kind s))
#f) (service nscd-service-type
((eq? nscd-service-type (service-kind s)) (nscd-configuration
(service nscd-service-type (inherit (service-value s))
(nscd-configuration (caches %nscd-container-caches))))
(inherit (service-value s)) ((eq? guix-service-type (service-kind s))
(caches %nscd-container-caches)))) ;; Pass '--disable-chroot' so that
((eq? guix-service-type (service-kind s)) ;; guix-daemon can build thing even in
;; Pass '--disable-chroot' so that ;; Docker without '--privileged'.
;; guix-daemon can build thing even in (service guix-service-type
;; Docker without '--privileged'. (guix-configuration
(service guix-service-type (inherit (service-value s))
(guix-configuration (extra-options
(inherit (service-value s)) (cons "--disable-chroot"
(extra-options (guix-configuration-extra-options
(cons "--disable-chroot" (service-value s)))))))
(guix-configuration-extra-options (else s)))
(service-value s))))))) (operating-system-user-services os))))
(else s))) (file-systems (append (map mapping->fs
(operating-system-user-services os)))) (if shared-network?
(file-systems (append (map mapping->fs (append %network-file-mappings mappings)
(if shared-network? mappings))
(append %network-file-mappings mappings) extra-file-systems
mappings)) user-file-systems
extra-file-systems
user-file-systems
;; Provide a dummy root file system so we can create ;; Provide a dummy root file system so we can create
;; a 'boot-parameters' file. ;; a 'boot-parameters' file.
(list (file-system (list (file-system
(mount-point "/") (mount-point "/")
(device "nothing") (device "nothing")
(type "dummy"))))))) (type "dummy")))))))
;; `essential-services' is thunked, we need to evaluate it separately.
(operating-system
(inherit os-with-base-essential-services)
(essential-services (container-essential-services
os-with-base-essential-services
#:shared-network? shared-network?))))
(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.