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: I81452487ef1ad01d3fa874c26d93a67d58ce6062master
parent
14210b7f58
commit
841fd4880a
|
@ -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 @@ from OS that are needed on the bare metal and not in a container."
|
||||||
(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 @@ containerized OS. EXTRA-FILE-SYSTEMS is a list of file systems to add to OS."
|
||||||
(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.
|
||||||
|
|
Reference in New Issue