X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/11da634a6e64afa2904542e2174aa2a185f9ac3a..9f2da0a0613f864aed9002950f4eaac59ae89d77:/gnu/system/linux-container.scm

diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index 2ab679ff3f..e6fd0f1315 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -1,7 +1,9 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
-;;; Copyright © 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2020 Google LLC
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -52,9 +54,7 @@ from OS that are needed on the bare metal and not in a container."
             (operating-system-default-essential-services os)))
 
   (cons (service system-service-type
-                 (let ((locale (operating-system-locale-directory os)))
-                   (with-monad %store-monad
-                     (return `(("locale" ,locale))))))
+                 `(("locale" ,(operating-system-locale-directory os))))
         ;; If network is to be shared with the host, remove network
         ;; configuration files from etc-service.
         (if shared-network?
@@ -76,7 +76,19 @@ from OS that are needed on the bare metal and not in a container."
 doing anything.")
            (provision '(loopback networking))
            (start #~(const #t))))
-   #f))
+   #f
+   (description "Provide loopback and networking without actually doing
+anything.  This service is used by guest systems running in containers, where
+networking support is provided by the host.")))
+
+(define %nscd-container-caches
+  ;; Similar to %nscd-default-caches but with smaller cache sizes. This allows
+  ;; many containers to coexist on the same machine without exhausting RAM.
+  (map (lambda (cache)
+         (nscd-cache
+          (inherit cache)
+          (max-database-size (expt 2 18)))) ;256KiB
+       %nscd-default-caches))
 
 (define* (containerized-operating-system os mappings
                                          #:key
@@ -101,22 +113,39 @@ containerized OS.  EXTRA-FILE-SYSTEMS is a list of file systems to add to OS."
     (file-system (inherit (file-system-mapping->bind-mount fs))
       (needed-for-boot? #t)))
 
-  (define useless-services
-    ;; Services that make no sense in a container.  Those that attempt to
-    ;; access /dev/tty[0-9] in particular cannot work in a container.
+  (define services-to-drop
+    ;; Service types to filter from the original operating-system. Some of
+    ;; these make no sense in a container (e.g., those that access
+    ;; /dev/tty[0-9]), while others just need to be reinstantiated with
+    ;; different configs that are better suited to containers.
     (append (list console-font-service-type
                   mingetty-service-type
-                  agetty-service-type)
-            ;; Remove nscd service if network is shared with the host.
+                  agetty-service-type
+                  ;; Reinstantiated below with smaller caches.
+                  nscd-service-type)
             (if shared-network?
-                (list nscd-service-type
-                      static-networking-service-type
-                      dhcp-client-service-type
-                      network-manager-service-type
-                      connman-service-type
-                      wicd-service-type)
+                ;; Replace these with dummy-networking-service-type below.
+                (list
+                 static-networking-service-type
+                 dhcp-client-service-type
+                 network-manager-service-type
+                 connman-service-type
+                 wicd-service-type)
                 (list))))
 
+  (define services-to-add
+    (append
+     ;; Many Guix services depend on a 'networking' shepherd
+     ;; service, so make sure to provide a dummy 'networking'
+     ;; service when we are sure that networking is already set up
+     ;; in the host and can be used.  That prevents double setup.
+     (if shared-network?
+         (list (service dummy-networking-service-type))
+         '())
+     (list
+      (nscd-service (nscd-configuration
+                     (caches %nscd-container-caches))))))
+
   (operating-system
     (inherit os)
     (swap-devices '()) ; disable swap
@@ -125,15 +154,9 @@ containerized OS.  EXTRA-FILE-SYSTEMS is a list of file systems to add to OS."
                          #:shared-network? shared-network?))
     (services (append (remove (lambda (service)
                                 (memq (service-kind service)
-                                      useless-services))
+                                      services-to-drop))
                               (operating-system-user-services os))
-                      ;; Many Guix services depend on a 'networking' shepherd
-                      ;; service, so make sure to provide a dummy 'networking'
-                      ;; service when we are sure that networking is already set up
-                      ;; in the host and can be used.  That prevents double setup.
-                      (if shared-network?
-                          (list (service dummy-networking-service-type))
-                          '())))
+                      services-to-add))
     (file-systems (append (map mapping->fs
                                (if shared-network?
                                    (append %network-file-mappings mappings)
@@ -194,11 +217,13 @@ that will be shared with the host system."
             (define (explain pid)
               ;; XXX: We can't quite call 'bindtextdomain' so there's actually
               ;; no i18n.
+              ;; XXX: Should we really give both options? 'guix container exec'
+              ;; is a more verbose command.  Hard to fail to enter the container
+              ;; when we list two options.
               (info (G_ "system container is running as PID ~a~%") pid)
-              ;; XXX: Should we recommend 'guix container exec'?  It's more
-              ;; verbose and doesn't bring much.
-              (info (G_ "Run 'sudo nsenter -a -t ~a' to get a shell into it.~%")
+              (info (G_ "Run 'sudo guix container exec ~a /run/current-system/profile/bin/bash --login'\n")
                     pid)
+              (info (G_ "or run 'sudo nsenter -a -t ~a' to get a shell into it.~%") pid)
               (newline (guix-warning-port)))
 
             (call-with-container file-systems