Package: guix-patches;
Reported by: Leo Nikkilä <hello <at> lnikki.la>
Date: Wed, 17 Jan 2024 21:53:02 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Leo Nikkilä <hello <at> lnikki.la> To: guix-patches <at> gnu.org Cc: Leo Nikkilä <hello <at> lnikki.la> Subject: [PATCH] gnu: linux-container: Inherit essential services. Date: Wed, 17 Jan 2024 23:48:35 +0200
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.
---
gnu/system/linux-container.scm | 88 ++++++++++++++++++----------------
1 file changed, 47 insertions(+), 41 deletions(-)
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index 485baea4c5..c780b68fba 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -6,6 +6,7 @@
;;; Copyright © 2020 Google LLC
;;; Copyright © 2022 Ricardo Wurmus <rekado <at> elephly.net>
;;; Copyright © 2023 Pierre Langlois <pierre.langlois <at> gmx.com>
+;;; Copyright © 2024 Leo Nikkilä <hello <at> lnikki.la>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -56,7 +57,7 @@ (define base
(if shared-network?
(list hosts-service-type)
'()))))
- (operating-system-default-essential-services os)))
+ (operating-system-essential-services os)))
(cons (service system-service-type
`(("locale" ,(operating-system-locale-directory os))))
@@ -144,48 +145,53 @@ (define services-to-add
(list (service dummy-networking-service-type))
'()))
+ (define os-with-base-essential-services
+ (operating-system
+ (inherit os)
+ (swap-devices '()) ; disable swap
+ (services
+ (append services-to-add
+ (filter-map (lambda (s)
+ (cond ((memq (service-kind s) services-to-drop)
+ #f)
+ ((eq? nscd-service-type (service-kind s))
+ (service nscd-service-type
+ (nscd-configuration
+ (inherit (service-value s))
+ (caches %nscd-container-caches))))
+ ((eq? guix-service-type (service-kind s))
+ ;; Pass '--disable-chroot' so that
+ ;; guix-daemon can build thing even in
+ ;; Docker without '--privileged'.
+ (service guix-service-type
+ (guix-configuration
+ (inherit (service-value s))
+ (extra-options
+ (cons "--disable-chroot"
+ (guix-configuration-extra-options
+ (service-value s)))))))
+ (else s)))
+ (operating-system-user-services os))))
+ (file-systems (append (map mapping->fs
+ (if shared-network?
+ (append %network-file-mappings mappings)
+ mappings))
+ extra-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")))))))
+
+ ;; `essential-services' is thunked, we need to evaluate it separately.
(operating-system
- (inherit os)
- (swap-devices '()) ; disable swap
+ (inherit os-with-base-essential-services)
(essential-services (container-essential-services
- this-operating-system
- #:shared-network? shared-network?))
- (services
- (append services-to-add
- (filter-map (lambda (s)
- (cond ((memq (service-kind s) services-to-drop)
- #f)
- ((eq? nscd-service-type (service-kind s))
- (service nscd-service-type
- (nscd-configuration
- (inherit (service-value s))
- (caches %nscd-container-caches))))
- ((eq? guix-service-type (service-kind s))
- ;; Pass '--disable-chroot' so that
- ;; guix-daemon can build thing even in
- ;; Docker without '--privileged'.
- (service guix-service-type
- (guix-configuration
- (inherit (service-value s))
- (extra-options
- (cons "--disable-chroot"
- (guix-configuration-extra-options
- (service-value s)))))))
- (else s)))
- (operating-system-user-services os))))
- (file-systems (append (map mapping->fs
- (if shared-network?
- (append %network-file-mappings mappings)
- mappings))
- extra-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")))))))
+ os-with-base-essential-services
+ #:shared-network? shared-network?))))
(define* (container-script os #:key (mappings '()) shared-network?)
"Return a derivation of a script that runs OS as a Linux container.
base-commit: 270570f09030f8888f613ed18e7b78ae6a7156e0
--
2.41.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.