01/08: linux-container: Inherit essential services.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 841fd4880a03d04bf20cc51fcc1a4c956d28d74c
Author: Leo Nikkilä <hello@lnikki.la>
AuthorDate: Wed Jan 17 23:48:35 2024 +0200

    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
---
 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@elephly.net>
 ;;; Copyright © 2023 Pierre Langlois <pierre.langlois@gmx.com>
+;;; Copyright © 2024 Leo Nikkilä <hello@lnikki.la>
 ;;;
 ;;; 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?
                                (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 @@ containerized OS.  EXTRA-FILE-SYSTEMS is a list of file 
systems to add to OS."
         (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.