aboutsummaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
authorMaxim Cournoyer <maxim.cournoyer@gmail.com>2020-10-19 12:51:57 -0400
committerMaxim Cournoyer <maxim.cournoyer@gmail.com>2020-10-19 13:11:40 -0400
commit5e2140511c1ad9ccd731438b74d61b62111da1e6 (patch)
treea4ff748ad26e121b88469b5d921001ef1382be8f /gnu/system
parent9e3a5ee417ea7fe9721be8804ff047e80c4f22ed (diff)
parent353bdae32f72b720c7ddd706576ccc40e2b43f95 (diff)
downloadguix-5e2140511c1ad9ccd731438b74d61b62111da1e6.tar.gz
guix-5e2140511c1ad9ccd731438b74d61b62111da1e6.zip
Merge branch 'staging'
Conflicts: gnu/packages/admin.scm gnu/packages/commencement.scm gnu/packages/gdb.scm gnu/packages/llvm.scm gnu/packages/package-management.scm gnu/packages/tls.scm
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/examples/bare-hurd.tmpl9
-rw-r--r--gnu/system/examples/lightweight-desktop.tmpl4
-rw-r--r--gnu/system/file-systems.scm8
-rw-r--r--gnu/system/hurd.scm25
-rw-r--r--gnu/system/image.scm155
-rw-r--r--gnu/system/images/hurd.scm32
-rw-r--r--gnu/system/images/pine64.scm66
-rw-r--r--gnu/system/install.scm43
-rw-r--r--gnu/system/linux-container.scm59
9 files changed, 305 insertions, 96 deletions
diff --git a/gnu/system/examples/bare-hurd.tmpl b/gnu/system/examples/bare-hurd.tmpl
index 414a9379c8..e4b795ff27 100644
--- a/gnu/system/examples/bare-hurd.tmpl
+++ b/gnu/system/examples/bare-hurd.tmpl
@@ -40,15 +40,20 @@
%base-file-systems))
(host-name "guixygnu")
(timezone "Europe/Amsterdam")
+ (users (cons (user-account
+ (name "guix")
+ (comment "Anonymous Hurd Hacker")
+ (group "users")
+ (supplementary-groups '("wheel")))
+ %base-user-accounts))
(packages (cons openssh-sans-x %base-packages/hurd))
(services (cons (service openssh-service-type
(openssh-configuration
(openssh openssh-sans-x)
- (use-pam? #f)
(port-number 2222)
(permit-root-login #t)
(allow-empty-passwords? #t)
(password-authentication? #t)))
- %base-services/hurd))))
+ %base-services/hurd))))
%hurd-os
diff --git a/gnu/system/examples/lightweight-desktop.tmpl b/gnu/system/examples/lightweight-desktop.tmpl
index b4037d4f79..d5a63dc457 100644
--- a/gnu/system/examples/lightweight-desktop.tmpl
+++ b/gnu/system/examples/lightweight-desktop.tmpl
@@ -4,7 +4,8 @@
(use-modules (gnu) (gnu system nss))
(use-service-modules desktop)
-(use-package-modules bootloaders certs ratpoison suckless wm xorg)
+(use-package-modules bootloaders certs emacs emacs-xyz ratpoison suckless wm
+ xorg)
(operating-system
(host-name "antelope")
@@ -43,6 +44,7 @@
(packages (append (list
;; window managers
ratpoison i3-wm i3status dmenu
+ emacs emacs-exwm emacs-desktop-environment
;; terminal emulator
xterm
;; for HTTPS access
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 5c02dfac93..464e87cb18 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Google LLC
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
@@ -590,11 +591,8 @@ a bind mount."
;; XXX: On some GNU/Linux systems, /etc/resolv.conf is a
;; symlink to a file in a tmpfs which, for an unknown reason,
;; cannot be bind mounted read-only within the container.
- ;; The same goes with /var/run/nscd, as discussed in
- ;; <https://bugs.gnu.org/37967>.
- (writable? (or (string=? file "/etc/resolv.conf")
- (string=? file "/var/run/nscd")))))
- (cons "/var/run/nscd" %network-configuration-files)))
+ (writable? (string=? file "/etc/resolv.conf"))))
+ %network-configuration-files))
(define (file-system-type-predicate type)
"Return a predicate that, when passed a file system, returns #t if that file
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index 80fffe8e45..8b46e65e31 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -26,8 +26,10 @@
#:use-module (gnu packages admin)
#:use-module (gnu packages base)
#:use-module (gnu packages bash)
+ #:use-module (gnu packages compression)
#:use-module (gnu packages cross-base)
#:use-module (gnu packages file)
+ #:use-module (gnu packages gawk)
#:use-module (gnu packages guile)
#:use-module (gnu packages guile-xyz)
#:use-module (gnu packages hurd)
@@ -42,7 +44,8 @@
#:export (%base-packages/hurd
%base-services/hurd
%hurd-default-operating-system
- %hurd-default-operating-system-kernel))
+ %hurd-default-operating-system-kernel
+ %setuid-programs/hurd))
;;; Commentary:
;;;
@@ -61,8 +64,9 @@
(define %base-packages/hurd
(list hurd bash coreutils file findutils grep sed
- guile-3.0 guile-colorized guile-readline
- net-base inetutils less shepherd which))
+ diffutils patch gawk tar gzip bzip2 xz lzip
+ guile-3.0-latest guile-colorized guile-readline
+ net-base inetutils less shadow shepherd sudo which))
(define %base-services/hurd
(list (service hurd-console-service-type
@@ -86,6 +90,17 @@
`(("/bin/sh" ,(file-append bash "/bin/sh"))
("/usr/bin/env" ,(file-append coreutils "/bin/env"))))))
+(define %setuid-programs/hurd
+ ;; Default set of setuid-root programs.
+ (list (file-append shadow "/bin/passwd")
+ (file-append shadow "/bin/sg")
+ (file-append shadow "/bin/su")
+ (file-append shadow "/bin/newgrp")
+ (file-append shadow "/bin/newuidmap")
+ (file-append shadow "/bin/newgidmap")
+ (file-append sudo "/bin/sudo")
+ (file-append sudo "/bin/sudoedit")))
+
(define %hurd-default-operating-system
(operating-system
(kernel %hurd-default-operating-system-kernel)
@@ -103,6 +118,4 @@
(timezone "GNUrope")
(name-service-switch #f)
(essential-services (hurd-default-essential-services this-operating-system))
- (pam-services '())
- (setuid-programs '())
- (sudoers-file #f)))
+ (setuid-programs %setuid-programs/hurd)))
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index 97c7021454..bc6610b14c 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -18,6 +18,8 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system image)
+ #:use-module (guix diagnostics)
+ #:use-module (guix discovery)
#:use-module (guix gexp)
#:use-module (guix modules)
#:use-module (guix monads)
@@ -47,11 +49,14 @@
#:use-module (gnu packages hurd)
#:use-module (gnu packages linux)
#:use-module (gnu packages mtools)
+ #:use-module (gnu packages virtualization)
#:use-module ((srfi srfi-1) #:prefix srfi-1:)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (rnrs bytevectors)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (root-offset
root-label
@@ -61,10 +66,20 @@
efi-disk-image
iso9660-image
+ arm64-disk-image
- find-image
+ image-with-os
+ raw-image-type
+ qcow2-image-type
+ iso-image-type
+ uncompressed-iso-image-type
+ arm64-image-type
+
+ image-with-label
system-image
- image-with-label))
+
+ %image-types
+ lookup-image-type-by-name))
;;;
@@ -111,6 +126,64 @@
(label "GUIX_IMAGE")
(flags '(boot)))))))
+(define arm64-disk-image
+ (image
+ (format 'disk-image)
+ (target "aarch64-linux-gnu")
+ (partitions
+ (list (partition
+ (inherit root-partition)
+ (offset root-offset))))
+ ;; FIXME: Deleting and creating "/var/run" and "/tmp" on the overlayfs
+ ;; fails.
+ (volatile-root? #f)))
+
+
+;;;
+;;; Images types.
+;;;
+
+(define-syntax-rule (image-with-os base-image os)
+ "Return an image inheriting from BASE-IMAGE, with the operating-system field
+set to the given OS."
+ (image
+ (inherit base-image)
+ (operating-system os)))
+
+(define raw-image-type
+ (image-type
+ (name 'raw)
+ (constructor (cut image-with-os efi-disk-image <>))))
+
+(define qcow2-image-type
+ (image-type
+ (name 'qcow2)
+ (constructor (cut image-with-os
+ (image
+ (inherit efi-disk-image)
+ (name 'image.qcow2)
+ (format 'compressed-qcow2))
+ <>))))
+
+(define iso-image-type
+ (image-type
+ (name 'iso9660)
+ (constructor (cut image-with-os iso9660-image <>))))
+
+(define uncompressed-iso-image-type
+ (image-type
+ (name 'uncompressed-iso9660)
+ (constructor (cut image-with-os
+ (image
+ (inherit iso9660-image)
+ (compression? #f))
+ <>))))
+
+(define arm64-image-type
+ (image-type
+ (name 'arm)
+ (constructor (cut image-with-os arm64-disk-image <>))))
+
;;
;; Helpers.
@@ -149,6 +222,7 @@
(with-imported-modules `(,@(source-module-closure
'((gnu build vm)
(gnu build image)
+ (gnu build bootloader)
(gnu build hurd-boot)
(gnu build linux-boot)
(guix store database))
@@ -157,6 +231,7 @@
#~(begin
(use-modules (gnu build vm)
(gnu build image)
+ (gnu build bootloader)
(gnu build hurd-boot)
(gnu build linux-boot)
(guix store database)
@@ -207,8 +282,8 @@ used in the image."
(define (format->image-type format)
;; Return the genimage format corresponding to FORMAT. For now, only
;; the hdimage format (raw disk-image) is supported.
- (case format
- ((disk-image) "hdimage")
+ (cond
+ ((memq format '(disk-image compressed-qcow2)) "hdimage")
(else
(raise (condition
(&message
@@ -306,25 +381,24 @@ image ~a {
(name (if image-name
(symbol->string image-name)
name))
+ (format (image-format image))
(substitutable? (image-substitutable? image))
(builder
(with-imported-modules*
- (let ((inputs '#+(list genimage coreutils findutils))
+ (let ((inputs '#+(list genimage coreutils findutils qemu-minimal))
(bootloader-installer
- #+(bootloader-disk-image-installer bootloader)))
+ #+(bootloader-disk-image-installer bootloader))
+ (out-image (string-append "images/" #$genimage-name)))
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
- (genimage #$(image->genimage-cfg image) #$output)
+ (genimage #$(image->genimage-cfg image))
;; Install the bootloader directly on the disk-image.
(when bootloader-installer
(bootloader-installer
#+(bootloader-package bootloader)
#$(root-partition-index image)
- (string-append #$output "/" #$genimage-name))))))
- (image-dir (computed-file "image-dir" builder)))
- (computed-file name
- #~(symlink
- (string-append #$image-dir "/" #$genimage-name)
- #$output)
+ out-image))
+ (convert-disk-image out-image '#$format #$output)))))
+ (computed-file name builder
#:options `(#:substitutable? ,substitutable?))))
@@ -340,7 +414,7 @@ image ~a {
(define* (system-iso9660-image image
#:key
- (name "iso9660-image")
+ (name "image.iso")
bootcfg
bootloader
register-closures?
@@ -441,7 +515,7 @@ returns an image record where the first partition's label is set to <label>."
image-size)
(else root-size))))
-(define* (image-with-os base-image os)
+(define* (image-with-os* base-image os)
"Return an image based on BASE-IMAGE but with the operating-system field set
to OS. Also set the UUID and the size of the root partition."
(define root-file-system
@@ -522,20 +596,21 @@ image, depending on IMAGE format."
(with-parameters ((%current-target-system target))
(let* ((os (operating-system-for-image image))
- (image* (image-with-os image os))
+ (image* (image-with-os* image os))
+ (image-format (image-format image))
(register-closures? (has-guix-service-type? os))
(bootcfg (operating-system-bootcfg os))
(bootloader (bootloader-configuration-bootloader
(operating-system-bootloader os))))
- (case (image-format image)
- ((disk-image)
+ (cond
+ ((memq image-format '(disk-image compressed-qcow2))
(system-disk-image image*
#:bootcfg bootcfg
#:bootloader bootloader
#:register-closures? register-closures?
#:inputs `(("system" ,os)
("bootcfg" ,bootcfg))))
- ((iso9660)
+ ((memq image-format '(iso9660))
(system-iso9660-image
image*
#:bootcfg bootcfg
@@ -554,18 +629,34 @@ image, depending on IMAGE format."
#:grub-mkrescue-environment
'(("MKRESCUE_SED_MODE" . "mbr_only"))))))))
-(define (find-image file-system-type target)
- "Find and return an image built that could match the given FILE-SYSTEM-TYPE,
-built for TARGET. This is useful to adapt to interfaces written before the
-addition of the <image> record."
- (match file-system-type
- ("iso9660" iso9660-image)
- (_ (cond
- ((and target
- (hurd-triplet? target))
- (module-ref (resolve-interface '(gnu system images hurd))
- 'hurd-disk-image))
- (else
- efi-disk-image)))))
+
+;;
+;; Image detection.
+;;
+
+(define (image-modules)
+ "Return the list of image modules."
+ (cons (resolve-interface '(gnu system image))
+ (all-modules (map (lambda (entry)
+ `(,entry . "gnu/system/images/"))
+ %load-path)
+ #:warn warn-about-load-error)))
+
+(define %image-types
+ ;; The list of publically-known image types.
+ (delay (fold-module-public-variables (lambda (obj result)
+ (if (image-type? obj)
+ (cons obj result)
+ result))
+ '()
+ (image-modules))))
+
+(define (lookup-image-type-by-name name)
+ "Return the image type called NAME."
+ (or (srfi-1:find (lambda (image-type)
+ (eq? name (image-type-name image-type)))
+ (force %image-types))
+ (raise
+ (formatted-message (G_ "~a: no such image type") name))))
;;; image.scm ends here
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index d87640e8e3..4417952c5d 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -29,9 +29,13 @@
#:use-module (gnu system file-systems)
#:use-module (gnu system hurd)
#:use-module (gnu system image)
+ #:use-module (srfi srfi-26)
#:export (hurd-barebones-os
hurd-disk-image
- hurd-barebones-disk-image))
+ hurd-image-type
+ hurd-qcow2-image-type
+ hurd-barebones-disk-image
+ hurd-barebones-qcow2-image))
(define hurd-barebones-os
(operating-system
@@ -82,8 +86,28 @@
(flags '(boot))
(initializer hurd-initialize-root-partition))))))
+(define hurd-image-type
+ (image-type
+ (name 'hurd-raw)
+ (constructor (cut image-with-os hurd-disk-image <>))))
+
+(define hurd-qcow2-image-type
+ (image-type
+ (name 'hurd-qcow2)
+ (constructor (lambda (os)
+ (image
+ (inherit hurd-disk-image)
+ (format 'compressed-qcow2)
+ (operating-system os))))))
+
(define hurd-barebones-disk-image
(image
- (inherit hurd-disk-image)
- (name 'hurd-barebones-disk-image)
- (operating-system hurd-barebones-os)))
+ (inherit
+ (os->image hurd-barebones-os #:type hurd-image-type))
+ (name 'hurd-barebones-disk-image)))
+
+(define hurd-barebones-qcow2-image
+ (image
+ (inherit
+ (os->image hurd-barebones-os #:type hurd-qcow2-image-type))
+ (name 'hurd-barebones.qcow2)))
diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm
new file mode 100644
index 0000000000..f0b0c3f50d
--- /dev/null
+++ b/gnu/system/images/pine64.scm
@@ -0,0 +1,66 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system images pine64)
+ #:use-module (gnu bootloader)
+ #:use-module (gnu bootloader u-boot)
+ #:use-module (gnu image)
+ #:use-module (gnu packages linux)
+ #:use-module (gnu services)
+ #:use-module (gnu services base)
+ #:use-module (gnu system)
+ #:use-module (gnu system file-systems)
+ #:use-module (gnu system image)
+ #:use-module (srfi srfi-26)
+ #:export (pine64-barebones-os
+ pine64-image-type
+ pine64-barebones-raw-image))
+
+(define pine64-barebones-os
+ (operating-system
+ (host-name "vignemale")
+ (timezone "Europe/Paris")
+ (locale "en_US.utf8")
+ (bootloader (bootloader-configuration
+ (bootloader u-boot-pine64-lts-bootloader)
+ (target "/dev/vda")))
+ (initrd-modules '())
+ (kernel linux-libre-arm64-generic)
+ (file-systems (cons (file-system
+ (device (file-system-label "my-root"))
+ (mount-point "/")
+ (type "ext4"))
+ %base-file-systems))
+ (services (cons (service agetty-service-type
+ (agetty-configuration
+ (extra-options '("-L")) ; no carrier detect
+ (baud-rate "115200")
+ (term "vt100")
+ (tty "ttyS0")))
+ %base-services))))
+
+(define pine64-image-type
+ (image-type
+ (name 'pine64-raw)
+ (constructor (cut image-with-os arm64-disk-image <>))))
+
+(define pine64-barebones-raw-image
+ (image
+ (inherit
+ (os->image pine64-barebones-os #:type pine64-image-type))
+ (name 'pine64-barebones-raw-image)))
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index be5a678cec..7701297411 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -5,6 +5,7 @@
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
+;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -41,18 +42,13 @@
#:use-module (gnu packages bash)
#:use-module (gnu packages bootloaders)
#:use-module (gnu packages certs)
- #:use-module (gnu packages file-systems)
+ #:use-module (gnu packages compression)
#:use-module (gnu packages fonts)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages guile)
#:use-module (gnu packages linux)
- #:use-module (gnu packages ssh)
- #:use-module (gnu packages cryptsetup)
#:use-module (gnu packages package-management)
- #:use-module (gnu packages disk)
#:use-module (gnu packages texinfo)
- #:use-module (gnu packages compression)
- #:use-module (gnu packages nvi)
#:use-module (gnu packages xorg)
#:use-module (ice-9 match)
#:use-module (srfi srfi-26)
@@ -445,6 +441,12 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
(label (string-append "GNU Guix installation "
(package-version guix)))
+ ;; XXX: The AMD Radeon driver is reportedly broken, which makes kmscon
+ ;; non-functional:
+ ;; <https://lists.gnu.org/archive/html/guix-devel/2019-03/msg00441.html>.
+ ;; Thus, blacklist it.
+ (kernel-arguments '("quiet" "modprobe.blacklist=radeon"))
+
(file-systems
;; Note: the disk image build code overrides this root file system with
;; the appropriate one.
@@ -490,27 +492,14 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
;; Explicitly allow for empty passwords.
(base-pam-services #:allow-empty-passwords? #t))
- (packages (cons* glibc ;for 'tzselect' & co.
- parted gptfdisk ddrescue
- fontconfig
- font-dejavu font-gnu-unifont
- grub ;mostly so xrefs to its manual work
- cryptsetup
- mdadm
- dosfstools ;mkfs.fat, for the UEFI boot partition
- btrfs-progs
- f2fs-tools
- jfsutils
- openssh ;we already have sshd, having ssh/scp can help
- wireless-tools iw wpa-supplicant-minimal iproute
- ;; XXX: We used to have GNU fdisk here, but as of version
- ;; 2.0.0a, that pulls Guile 1.8, which takes unreasonable
- ;; space; furthermore util-linux's fdisk is already
- ;; available here, so we keep that.
- bash-completion
- nvi ;:wq!
- nss-certs ; To access HTTPS, use git, etc.
- %base-packages))))
+ (packages (append
+ (list glibc ; for 'tzselect' & co.
+ fontconfig
+ font-dejavu font-gnu-unifont
+ grub ; mostly so xrefs to its manual work
+ nss-certs) ; To access HTTPS, use git, etc.
+ %base-packages-disk-utilities
+ %base-packages))))
(define* (os-with-u-boot os board #:key (bootloader-target "/dev/mmcblk0")
(triplet "arm-linux-gnueabihf"))
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index c5e2e4bf9c..4a9cd0efe2 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2016, 2017, 2019, 2020 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.
;;;
@@ -77,6 +78,15 @@ doing anything.")
(start #~(const #t))))
#f))
+(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
shared-network?
@@ -100,22 +110,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
@@ -124,15 +151,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)