Subject: [PATCH] gnu: linux-container: Inherit essential services.

From: Leo Nikkilä <[email-masked]>
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 <[email-masked]>
 ;;; Copyright © 2023 Pierre Langlois <[email-masked]>
+;;; Copyright © 2024 Leo Nikkilä <[email-masked]>
 ;;;
 ;;; 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