;;; 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.
;;;
(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?
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
(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
#: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)
(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
(lowered-gexp-guile lowered))
"/bin/guile")
"guile"
- (append (map (lambda (directory) `("-L" ,directory))
- (lowered-gexp-load-path lowered))
- (map (lambda (directory) `("-C" ,directory))
- (lowered-gexp-load-compiled-path
- lowered))
+ (append (append-map (lambda (directory)
+ `("-L" ,directory))
+ (lowered-gexp-load-path lowered))
+ (append-map (lambda (directory)
+ `("-C" ,directory))
+ (lowered-gexp-load-compiled-path
+ lowered))
(list "-c"
(object->string
(lowered-gexp-sexp lowered))))))))))))
HCoop / jackhill / guix / guix.git / blobdiff