aboutsummaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2019-05-01 23:11:41 +0200
committerMarius Bakke <mbakke@fastmail.com>2019-05-01 23:11:41 +0200
commit3b458d5462e6bbd852c2dc5c6670d5655abf53f5 (patch)
tree4f3ccec0de1c355134369333c17e948e3258d546 /gnu/system
parent2ca3fdc2db1aef96fbf702a2f26f5e18ce832038 (diff)
parent14da3daafc8dd92fdabd3367694c930440fd72cb (diff)
downloadpatches-3b458d5462e6bbd852c2dc5c6670d5655abf53f5.tar
patches-3b458d5462e6bbd852c2dc5c6670d5655abf53f5.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/accounts.scm7
-rw-r--r--gnu/system/examples/asus-c201.tmpl60
-rw-r--r--gnu/system/examples/bare-bones.tmpl3
-rw-r--r--gnu/system/examples/beaglebone-black.tmpl3
-rw-r--r--gnu/system/examples/desktop.tmpl23
-rw-r--r--gnu/system/examples/docker-image.tmpl3
-rw-r--r--gnu/system/examples/lightweight-desktop.tmpl3
-rw-r--r--gnu/system/examples/vm-image.tmpl116
-rw-r--r--gnu/system/install.scm131
-rw-r--r--gnu/system/keyboard.scm98
-rw-r--r--gnu/system/linux-container.scm68
-rw-r--r--gnu/system/linux-initrd.scm26
-rw-r--r--gnu/system/shadow.scm5
-rw-r--r--gnu/system/vm.scm57
14 files changed, 475 insertions, 128 deletions
diff --git a/gnu/system/accounts.scm b/gnu/system/accounts.scm
index eb18fb5e43..586cff1842 100644
--- a/gnu/system/accounts.scm
+++ b/gnu/system/accounts.scm
@@ -67,7 +67,8 @@
(supplementary-groups user-account-supplementary-groups
(default '())) ; list of strings
(comment user-account-comment (default ""))
- (home-directory user-account-home-directory)
+ (home-directory user-account-home-directory (thunked)
+ (default (default-home-directory this-record)))
(create-home-directory? user-account-create-home-directory? ;Boolean
(default #t))
(shell user-account-shell ; gexp
@@ -84,6 +85,10 @@
(system? user-group-system? ; Boolean
(default #f)))
+(define (default-home-directory account)
+ "Return the default home directory for ACCOUNT."
+ (string-append "/home/" (user-account-name account)))
+
(define (sexp->user-group sexp)
"Take SEXP, a tuple as returned by 'user-group->gexp', and turn it into a
user-group record."
diff --git a/gnu/system/examples/asus-c201.tmpl b/gnu/system/examples/asus-c201.tmpl
new file mode 100644
index 0000000000..098958f4a2
--- /dev/null
+++ b/gnu/system/examples/asus-c201.tmpl
@@ -0,0 +1,60 @@
+;; This is an operating system configuration template
+;; for a "bare bones" setup for an ASUS C201PA.
+
+(use-modules (gnu) (gnu bootloader depthcharge))
+(use-service-modules networking ssh)
+(use-package-modules linux screen)
+
+(operating-system
+ (host-name "komputilo")
+ (timezone "Europe/Berlin")
+ (locale "en_US.utf8")
+
+ ;; Assuming /dev/mmcblk0p1 is the kernel partition, and
+ ;; "my-root" is the label of the target root file system.
+ (bootloader (bootloader-configuration
+ (bootloader depthcharge-bootloader)
+ (target "/dev/mmcblk0p1")))
+
+ ;; The ASUS C201PA requires a very particular kernel to boot,
+ ;; as well as the following arguments.
+ (kernel linux-libre-arm-veyron)
+ (kernel-arguments '("console=tty1"))
+
+ ;; We do not need any special modules for initrd, and the
+ ;; PrawnOS kernel does not include many of the normal ones.
+ (initrd-modules '())
+
+ (file-systems (cons (file-system
+ (device (file-system-label "my-root"))
+ (mount-point "/")
+ (type "ext4"))
+ %base-file-systems))
+
+ ;; This is where user accounts are specified. The "root"
+ ;; account is implicit, and is initially created with the
+ ;; empty password.
+ (users (cons (user-account
+ (name "alice")
+ (comment "Bob's sister")
+ (group "users")
+
+ ;; Adding the account to the "wheel" group
+ ;; makes it a sudoer. Adding it to "audio"
+ ;; and "video" allows the user to play sound
+ ;; and access the webcam.
+ (supplementary-groups '("wheel"
+ "audio" "video"))
+ (home-directory "/home/alice"))
+ %base-user-accounts))
+
+ ;; Globally-installed packages.
+ (packages (cons screen %base-packages))
+
+ ;; Add services to the baseline: a DHCP client and
+ ;; an SSH server.
+ (services (append (list (service dhcp-client-service-type)
+ (service openssh-service-type
+ (openssh-configuration
+ (port-number 2222))))
+ %base-services)))
diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl
index a88bab034f..4f30a5b756 100644
--- a/gnu/system/examples/bare-bones.tmpl
+++ b/gnu/system/examples/bare-bones.tmpl
@@ -35,8 +35,7 @@
;; and "video" allows the user to play sound
;; and access the webcam.
(supplementary-groups '("wheel"
- "audio" "video"))
- (home-directory "/home/alice"))
+ "audio" "video")))
%base-user-accounts))
;; Globally-installed packages.
diff --git a/gnu/system/examples/beaglebone-black.tmpl b/gnu/system/examples/beaglebone-black.tmpl
index 11678063b2..def05e807d 100644
--- a/gnu/system/examples/beaglebone-black.tmpl
+++ b/gnu/system/examples/beaglebone-black.tmpl
@@ -38,8 +38,7 @@
;; and "video" allows the user to play sound
;; and access the webcam.
(supplementary-groups '("wheel"
- "audio" "video"))
- (home-directory "/home/alice"))
+ "audio" "video")))
%base-user-accounts))
;; Globally-installed packages.
diff --git a/gnu/system/examples/desktop.tmpl b/gnu/system/examples/desktop.tmpl
index c59bf92681..3931bad60d 100644
--- a/gnu/system/examples/desktop.tmpl
+++ b/gnu/system/examples/desktop.tmpl
@@ -3,7 +3,7 @@
;; root partition is encrypted with LUKS.
(use-modules (gnu) (gnu system nss))
-(use-service-modules desktop)
+(use-service-modules desktop xorg)
(use-package-modules certs gnome)
(operating-system
@@ -11,11 +11,16 @@
(timezone "Europe/Paris")
(locale "en_US.utf8")
+ ;; Choose US English keyboard layout. The "altgr-intl"
+ ;; variant provides dead keys for accented characters.
+ (keyboard-layout (keyboard-layout "us" "altgr-intl"))
+
;; Use the UEFI variant of GRUB with the EFI System
;; Partition mounted on /boot/efi.
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (target "/boot/efi")))
+ (target "/boot/efi")
+ (keyboard-layout keyboard-layout)))
;; Specify a mapped device for the encrypted root partition.
;; The UUID is that returned by 'cryptsetup luksUUID'.
@@ -42,8 +47,7 @@
(comment "Alice's brother")
(group "users")
(supplementary-groups '("wheel" "netdev"
- "audio" "video"))
- (home-directory "/home/bob"))
+ "audio" "video")))
%base-user-accounts))
;; This is where we specify system-wide packages.
@@ -54,12 +58,15 @@
gvfs)
%base-packages))
- ;; Add GNOME and/or Xfce---we can choose at the log-in
- ;; screen with F1. Use the "desktop" services, which
+ ;; Add GNOME and Xfce---we can choose at the log-in screen
+ ;; by clicking the gear. Use the "desktop" services, which
;; include the X11 log-in service, networking with
;; NetworkManager, and more.
- (services (append (list (gnome-desktop-service)
- (xfce-desktop-service))
+ (services (append (list (service gnome-desktop-service-type)
+ (service xfce-desktop-service-type)
+ (set-xorg-configuration
+ (xorg-configuration
+ (keyboard-layout keyboard-layout))))
%desktop-services))
;; Allow resolution of '.local' host names with mDNS.
diff --git a/gnu/system/examples/docker-image.tmpl b/gnu/system/examples/docker-image.tmpl
index 9690d651c1..ca633cc838 100644
--- a/gnu/system/examples/docker-image.tmpl
+++ b/gnu/system/examples/docker-image.tmpl
@@ -15,8 +15,7 @@
(comment "Bob's sister")
(group "users")
(supplementary-groups '("wheel"
- "audio" "video"))
- (home-directory "/home/alice"))
+ "audio" "video")))
%base-user-accounts))
;; Globally-installed packages.
diff --git a/gnu/system/examples/lightweight-desktop.tmpl b/gnu/system/examples/lightweight-desktop.tmpl
index a234badd2b..45d9bf447f 100644
--- a/gnu/system/examples/lightweight-desktop.tmpl
+++ b/gnu/system/examples/lightweight-desktop.tmpl
@@ -35,8 +35,7 @@
(comment "Bob's sister")
(group "users")
(supplementary-groups '("wheel" "netdev"
- "audio" "video"))
- (home-directory "/home/alice"))
+ "audio" "video")))
%base-user-accounts))
;; Add a bunch of window managers; we can choose one at
diff --git a/gnu/system/examples/vm-image.tmpl b/gnu/system/examples/vm-image.tmpl
index 6dc67b0901..a140082c0b 100644
--- a/gnu/system/examples/vm-image.tmpl
+++ b/gnu/system/examples/vm-image.tmpl
@@ -1,58 +1,106 @@
-;;; This is an operating system configuration template for a "bare-bones" setup,
-;;; suitable for booting in a virtualized environment, including virtual private
-;;; servers (VPS).
+;; This is an operating system configuration for a VM image.
+;; Modify it as you see fit and instantiate the changes by running:
+;;
+;; guix system reconfigure /etc/config.scm
+;;
-(use-modules (gnu))
-(use-package-modules bootloaders disk nvi)
+(use-modules (gnu) (srfi srfi-1))
+(use-service-modules desktop networking ssh xorg)
+(use-package-modules bootloaders certs fonts nvi wget xorg)
(define vm-image-motd (plain-file "motd" "
-This is the GNU system. Welcome!
+\x1b[1;37mThis is the GNU system. Welcome!\x1b[0m
-This instance of Guix System is a bare-bones template for virtualized environments.
+This instance of Guix is a template for virtualized environments.
+You can reconfigure the whole system by adjusting /etc/config.scm
+and running:
-You will probably want to do these things first if you booted in a virtual
-private server (VPS):
+ guix system reconfigure /etc/config.scm
+
+Run '\x1b[1;37minfo guix\x1b[0m' to browse documentation.
+
+\x1b[1;33mConsider setting a password for the 'root' and 'guest' \
+accounts.\x1b[0m
+"))
+
+(define this-file
+ (local-file (basename (assoc-ref (current-source-location) 'filename))
+ "config.scm"))
-* Set a password for 'root'.
-* Set up networking.
-* Expand the root partition to fill the space available by 0) deleting and
-recreating the partition with fdisk, 1) reloading the partition table with
-partprobe, and then 2) resizing the filesystem with resize2fs.\n"))
(operating-system
(host-name "gnu")
(timezone "Etc/UTC")
(locale "en_US.utf8")
+ (keyboard-layout (keyboard-layout "us" "altgr-intl"))
(firmware '())
- ;; Assuming /dev/sdX is the target hard disk, and "my-root" is
- ;; the label of the target root file system.
+ ;; Below we assume /dev/vda is the VM's hard disk.
+ ;; Adjust as needed.
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (target "/dev/sda")
+ (target "/dev/vda")
(terminal-outputs '(console))))
(file-systems (cons (file-system
- (device (file-system-label "my-root"))
(mount-point "/")
+ (device "/dev/vda1")
(type "ext4"))
%base-file-systems))
- ;; This is where user accounts are specified. The "root"
- ;; account is implicit, and is initially created with the
- ;; empty password.
- (users %base-user-accounts)
-
- ;; Globally-installed packages.
- (packages (append (list nvi fdisk
- ;; mostly so xrefs to its manual work
- grub
- ;; partprobe
- parted)
+ (users (cons (user-account
+ (name "guest")
+ (comment "GNU Guix Live")
+ (password "") ;no password
+ (group "users")
+ (supplementary-groups '("wheel" "netdev"
+ "audio" "video")))
+ %base-user-accounts))
+
+ ;; Our /etc/sudoers file. Since 'guest' initially has an empty password,
+ ;; allow for password-less sudo.
+ (sudoers-file (plain-file "sudoers" "\
+root ALL=(ALL) ALL
+%wheel ALL=NOPASSWD: ALL\n"))
+
+ (packages (append (list font-bitstream-vera nss-certs nvi wget)
%base-packages))
- (services (modify-services %base-services
- (login-service-type config =>
- (login-configuration
- (inherit config)
- (motd vm-image-motd))))))
+ (services
+ (append (list (service xfce-desktop-service-type)
+
+ ;; Copy this file to /etc/config.scm in the OS.
+ (simple-service 'config-file etc-service-type
+ `(("config.scm" ,this-file)))
+
+ ;; Choose SLiM, which is lighter than the default GDM.
+ (service slim-service-type
+ (slim-configuration
+ (auto-login? #t)
+ (default-user "guest")
+ (xorg-configuration
+ (xorg-configuration
+ (keyboard-layout keyboard-layout)))))
+
+ ;; Uncomment the line below to add an SSH server.
+ ;;(service openssh-service-type)
+
+ ;; Use the DHCP client service rather than NetworkManager.
+ (service dhcp-client-service-type))
+
+ ;; Remove GDM, NetworkManager, and wpa-supplicant, which don't make
+ ;; sense in a VM.
+ (remove (lambda (service)
+ (let ((type (service-kind service)))
+ (memq type (list gdm-service-type
+ wpa-supplicant-service-type
+ cups-pk-helper-service-type
+ network-manager-service-type))))
+ (modify-services %desktop-services
+ (login-service-type config =>
+ (login-configuration
+ (inherit config)
+ (motd vm-image-motd)))))))
+
+ ;; Allow resolution of '.local' host names with mDNS.
+ (name-service-switch %mdns-host-lookup-nss))
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index bad318d06b..45c6051732 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -27,6 +27,7 @@
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
+ #:use-module ((guix packages) #:select (package-version))
#:use-module ((guix store) #:select (%store-prefix))
#:use-module (gnu installer)
#:use-module (gnu services dbus)
@@ -73,19 +74,94 @@
;;; Code:
-(define (log-to-info)
+;;;
+;;; Documentation service.
+;;;
+
+(define %installation-node-names
+ ;; Translated name of the "System Installation" node of the manual. Ideally
+ ;; we'd extract it from the 'guix-manual' gettext domain, but that one is
+ ;; usually not available at run time, hence this hack.
+ '(("de" . "Systeminstallation")
+ ("en" . "System Installation")
+ ("es" . "Instalación del sistema")
+ ("fr" . "Installation du système")))
+
+(define (log-to-info tty user)
"Return a script that spawns the Info reader on the right section of the
manual."
(program-file "log-to-info"
- #~(begin
+ #~(let* ((tty (open-file #$(string-append "/dev/" tty)
+ "r0+"))
+ (locale (cadr (command-line)))
+ (language (string-take locale
+ (string-index locale #\_)))
+ (infodir "/run/current-system/profile/share/info")
+ (per-lang (string-append infodir "/guix." language
+ ".info.gz"))
+ (file (if (file-exists? per-lang)
+ per-lang
+ (string-append infodir "/guix.info")))
+ (node (or (assoc-ref '#$%installation-node-names
+ language)
+ "System Installation")))
+ (redirect-port tty (current-output-port))
+ (redirect-port tty (current-error-port))
+ (redirect-port tty (current-input-port))
+
+ (let ((pw (getpwnam #$user)))
+ (setgid (passwd:gid pw))
+ (setuid (passwd:uid pw)))
+
;; 'gunzip' is needed to decompress the doc.
(setenv "PATH" (string-append #$gzip "/bin"))
- (execl (string-append #$info-reader "/bin/info") "info"
- "-d" "/run/current-system/profile/share/info"
- "-f" (string-append #$guix "/share/info/guix.info")
- "-n" "System Installation"))))
+ ;; Change this process' locale so that command-line
+ ;; arguments to 'info' are properly encoded.
+ (catch #t
+ (lambda ()
+ (setlocale LC_ALL locale)
+ (setenv "LC_ALL" locale))
+ (lambda _
+ ;; Sometimes LOCALE itself is not available. In that
+ ;; case pick the one UTF-8 locale that's known to work
+ ;; instead of failing.
+ (setlocale LC_ALL "en_US.utf8")
+ (setenv "LC_ALL" "en_US.utf8")))
+
+ (execl #$(file-append info-reader "/bin/info")
+ "info" "-d" infodir "-f" file "-n" node))))
+
+(define (documentation-shepherd-service tty)
+ (list (shepherd-service
+ (provision (list (symbol-append 'term- (string->symbol tty))))
+ (requirement '(user-processes host-name udev virtual-terminal))
+ (start #~(lambda* (#:optional (locale "en_US.utf8"))
+ (fork+exec-command
+ (list #$(log-to-info tty "documentation") locale)
+ #:environment-variables
+ `("GUIX_LOCPATH=/run/current-system/locale"
+ "TERM=linux"))))
+ (stop #~(make-kill-destructor)))))
+
+(define %documentation-users
+ ;; User account for the Info viewer.
+ (list (user-account (name "documentation")
+ (system? #t)
+ (group "nogroup")
+ (home-directory "/var/empty"))))
+
+(define documentation-service-type
+ ;; Documentation viewer service.
+ (service-type (name 'documentation)
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ documentation-shepherd-service)
+ (service-extension account-service-type
+ (const %documentation-users))))
+ (description "Run the Info reader on a tty.")))
+
(define %backing-directory
;; Sub-directory used as the backing store for copy-on-write.
"/tmp/guix-inst")
@@ -212,13 +288,11 @@ the user's target storage device rather than on the RAM disk."
(define %installation-services
;; List of services of the installation system.
(let ((motd (plain-file "motd" "
-\x1b[1;37mWelcome to the installation of the Guix System Distribution!\x1b[0m
-
-\x1b[2mThere is NO WARRANTY, to the extent permitted by law. In particular, you may
-LOSE ALL YOUR DATA as a side effect of the installation process. Furthermore,
-it is 'beta' software, so it may contain bugs.
+\x1b[1;37mWelcome to the installation of GNU Guix!\x1b[0m
-You have been warned. Thanks for being so brave.\x1b[0m
+\x1b[2m\
+Using this shell, you can carry out the installation process \"manually.\"
+Access documentation at any time by pressing Alt-F2.\x1b[0m
")))
(define (normal-tty tty)
(mingetty-service (mingetty-configuration (tty tty)
@@ -241,10 +315,7 @@ You have been warned. Thanks for being so brave.\x1b[0m
;; Documentation. The manual is in UTF-8, but
;; 'console-font-service' sets up Unicode support and loads a font
;; with all the useful glyphs like em dash and quotation marks.
- (mingetty-service (mingetty-configuration
- (tty "tty2")
- (auto-login "guest")
- (login-program (log-to-info))))
+ (service documentation-service-type "tty2")
;; Documentation add-on.
%configuration-template-service
@@ -273,12 +344,18 @@ You have been warned. Thanks for being so brave.\x1b[0m
;; since it takes the installation directory as an argument.
(cow-store-service)
- ;; Install Unicode support and a suitable font. Use a font that
- ;; doesn't have more than 256 glyphs so that we can use colors with
- ;; varying brightness levels (see note in setfont(8)).
+ ;; Install Unicode support and a suitable font.
(service console-font-service-type
- (map (lambda (tty)
- (cons tty "lat9u-16"))
+ (map (match-lambda
+ ("tty2"
+ ;; Use a font that contains characters such as
+ ;; curly quotes as found in the manual.
+ '("tty2" . "LatGrkCyr-8x16"))
+ (tty
+ ;; Use a font that doesn't have more than 256
+ ;; glyphs so that we can use colors with varying
+ ;; brightness levels (see note in setfont(8)).
+ `(,tty . "lat9u-16")))
'("tty1" "tty2" "tty3" "tty4" "tty5" "tty6")))
;; To facilitate copy/paste.
@@ -348,6 +425,15 @@ You have been warned. Thanks for being so brave.\x1b[0m
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
(target "/dev/sda")))
+ (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.
@@ -379,8 +465,7 @@ You have been warned. Thanks for being so brave.\x1b[0m
(group "users")
(supplementary-groups '("wheel")) ; allow use of sudo
(password "")
- (comment "Guest of GNU")
- (home-directory "/home/guest"))))
+ (comment "Guest of GNU"))))
(issue %issue)
(services %installation-services)
diff --git a/gnu/system/keyboard.scm b/gnu/system/keyboard.scm
new file mode 100644
index 0000000000..cd3ab37b27
--- /dev/null
+++ b/gnu/system/keyboard.scm
@@ -0,0 +1,98 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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 keyboard)
+ #:use-module (guix gexp)
+ #:use-module ((gnu packages xorg)
+ #:select (xkeyboard-config console-setup))
+ #:use-module (srfi srfi-9 gnu)
+ #:use-module (ice-9 match)
+ #:export (keyboard-layout?
+ keyboard-layout
+ keyboard-layout-name
+ keyboard-layout-variant
+ keyboard-layout-model
+ keyboard-layout-options
+
+ keyboard-layout->console-keymap))
+
+;;; Commentary:
+;;;
+;;; This module provides a data structure to represent keyboard layouts
+;;; according to the XKB naming and classification (see the 'xkeyboard-config'
+;;; package).
+;;;
+;;; Code:
+
+(define-immutable-record-type <keyboard-layout>
+ (%keyboard-layout name variant model options)
+ keyboard-layout?
+ (name keyboard-layout-name) ;string
+ (variant keyboard-layout-variant) ;#f | string
+ (model keyboard-layout-model) ;#f | string
+ (options keyboard-layout-options)) ;list of strings
+
+(define* (keyboard-layout name #:optional variant
+ #:key model (options '()))
+ "Return a new keyboard layout with the given NAME and VARIANT.
+
+NAME must be a string such as \"fr\"; VARIANT must be a string such as
+\"bepo\" or \"nodeadkeys\". See the 'xkeyboard-config' package for valid
+options."
+ (%keyboard-layout name variant model options))
+
+(define* (keyboard-layout->console-keymap layout
+ #:key
+ (xkeyboard-config xkeyboard-config))
+ "Return a Linux console keymap file for LAYOUT, a <keyboard-layout> record.
+Layout information is taken from the XKEYBOARD-CONFIG package."
+ (define build
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 popen)
+ (ice-9 match))
+
+ (define pipe
+ (open-pipe* OPEN_READ
+ #+(file-append console-setup "/bin/ckbcomp")
+ (string-append "-I"
+ #+(file-append xkeyboard-config
+ "/share/X11/xkb"))
+ "-rules" "base"
+ #$@(match (keyboard-layout-model layout)
+ (#f '())
+ (model `("-model" ,model)))
+ #$(keyboard-layout-name layout)
+ #$(or (keyboard-layout-variant layout)
+ "")
+ #$(string-join (keyboard-layout-options layout) ",")))
+
+ (call-with-output-file #$output
+ (lambda (output)
+ (dump-port pipe output)))
+
+ ;; Note: ckbcomp errors out when the layout name is unknown, but
+ ;; merely emits a warning when the variant is unknown.
+ (unless (zero? (close-pipe pipe))
+ (error "failed to create console keymap for keyboard layout"
+ #$(keyboard-layout-name layout))))))
+
+ (computed-file (string-append "console-keymap."
+ (keyboard-layout-name layout))
+ build))
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index 3fe3482d7f..149c3d08a3 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -35,6 +35,24 @@
containerized-operating-system
container-script))
+(define (container-essential-services os)
+ "Return a list of essential services corresponding to OS, a
+non-containerized OS. This procedure essentially strips essential services
+from OS that are needed on the bare metal and not in a container."
+ (define base
+ (remove (lambda (service)
+ (memq (service-kind service)
+ (list (service-kind %linux-bare-metal-service)
+ firmware-service-type
+ system-service-type)))
+ (operating-system-essential-services os)))
+
+ (cons (service system-service-type
+ (let ((locale (operating-system-locale-directory os)))
+ (with-monad %store-monad
+ (return `(("locale" ,locale))))))
+ base))
+
(define (containerized-operating-system os mappings)
"Return an operating system based on OS for use in a Linux container
environment. MAPPINGS is a list of <file-system-mapping> to realize in the
@@ -62,8 +80,10 @@ containerized OS."
mingetty-service-type
agetty-service-type))
- (operating-system (inherit os)
+ (operating-system
+ (inherit os)
(swap-devices '()) ; disable swap
+ (essential-services (container-essential-services os))
(services (remove (lambda (service)
(memq (service-kind service)
useless-services))
@@ -81,30 +101,26 @@ that will be shared with the host system."
(operating-system-file-systems os)))
(specs (map file-system->spec file-systems)))
- (mlet* %store-monad ((os-drv (operating-system-derivation
- os
- #:container? #t)))
-
- (define script
- (with-imported-modules (source-module-closure
- '((guix build utils)
- (gnu build linux-container)))
- #~(begin
- (use-modules (gnu build linux-container)
- (gnu system file-systems) ;spec->file-system
- (guix build utils))
+ (define script
+ (with-imported-modules (source-module-closure
+ '((guix build utils)
+ (gnu build linux-container)))
+ #~(begin
+ (use-modules (gnu build linux-container)
+ (gnu system file-systems) ;spec->file-system
+ (guix build utils))
- (call-with-container (map spec->file-system '#$specs)
- (lambda ()
- (setenv "HOME" "/root")
- (setenv "TMPDIR" "/tmp")
- (setenv "GUIX_NEW_SYSTEM" #$os-drv)
- (for-each mkdir-p '("/run" "/bin" "/etc" "/home" "/var"))
- (primitive-load (string-append #$os-drv "/boot")))
- ;; A range of 65536 uid/gids is used to cover 16 bits worth of
- ;; users and groups, which is sufficient for most cases.
- ;;
- ;; See: http://www.freedesktop.org/software/systemd/man/systemd-nspawn.html#--private-users=
- #:host-uids 65536))))
+ (call-with-container (map spec->file-system '#$specs)
+ (lambda ()
+ (setenv "HOME" "/root")
+ (setenv "TMPDIR" "/tmp")
+ (setenv "GUIX_NEW_SYSTEM" #$os)
+ (for-each mkdir-p '("/run" "/bin" "/etc" "/home" "/var"))
+ (primitive-load (string-append #$os "/boot")))
+ ;; A range of 65536 uid/gids is used to cover 16 bits worth of
+ ;; users and groups, which is sufficient for most cases.
+ ;;
+ ;; See: http://www.freedesktop.org/software/systemd/man/systemd-nspawn.html#--private-users=
+ #:host-uids 65536))))
- (gexp->script "run-container" script))))
+ (gexp->script "run-container" script)))
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 983c6d81c8..656afd1ddb 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -31,10 +31,13 @@
#:use-module (gnu packages disk)
#:use-module (gnu packages linux)
#:use-module (gnu packages guile)
+ #:use-module ((gnu packages xorg)
+ #:select (console-setup xkeyboard-config))
#:use-module ((gnu packages make-bootstrap)
#:select (%guile-static-stripped))
#:use-module (gnu system file-systems)
#:use-module (gnu system mapped-devices)
+ #:use-module (gnu system keyboard)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 vlist)
@@ -139,6 +142,7 @@ MODULES and taken from LINUX."
(linux linux-libre)
(linux-modules '())
(mapped-devices '())
+ (keyboard-layout #f)
(helper-packages '())
qemu-networking?
volatile-root?
@@ -152,6 +156,11 @@ mappings to realize before FILE-SYSTEMS are mounted.
HELPER-PACKAGES is a list of packages to be copied in the initrd. It may include
e2fsck/static or other packages needed by the initrd to check root partition.
+When true, KEYBOARD-LAYOUT is a <keyboard-layout> record denoting the desired
+console keyboard layout. This is done before MAPPED-DEVICES are set up and
+before FILE-SYSTEMS are mounted such that, should the user need to enter a
+passphrase or use the REPL, this happens using the intended keyboard layout.
+
When QEMU-NETWORKING? is true, set up networking with the standard QEMU
parameters.
@@ -206,6 +215,8 @@ upon error."
(and #$@device-mapping-commands))
#:linux-modules '#$linux-modules
#:linux-module-directory '#$kodir
+ #:keymap-file #+(and=> keyboard-layout
+ keyboard-layout->console-keymap)
#:qemu-guest-networking? #$qemu-networking?
#:volatile-root? '#$volatile-root?
#:on-error '#$on-error)))
@@ -290,6 +301,7 @@ FILE-SYSTEMS."
(linux linux-libre)
(linux-modules '())
(mapped-devices '())
+ (keyboard-layout #f)
qemu-networking?
volatile-root?
(extra-modules '()) ;deprecated
@@ -300,6 +312,11 @@ mounted by the initrd, possibly in addition to the root file system specified
on the kernel command line via '--root'. MAPPED-DEVICES is a list of device
mappings to realize before FILE-SYSTEMS are mounted.
+When true, KEYBOARD-LAYOUT is a <keyboard-layout> record denoting the desired
+console keyboard layout. This is done before MAPPED-DEVICES are set up and
+before FILE-SYSTEMS are mounted such that, should the user need to enter a
+passphrase or use the REPL, this happens using the intended keyboard layout.
+
QEMU-NETWORKING? and VOLATILE-ROOT? behaves as in raw-initrd.
The initrd is automatically populated with all the kernel modules necessary
@@ -316,13 +333,18 @@ loaded at boot time in the order in which they appear."
,@extra-modules))
(define helper-packages
- (file-system-packages file-systems #:volatile-root? volatile-root?))
+ (append (file-system-packages file-systems
+ #:volatile-root? volatile-root?)
+ (if keyboard-layout
+ (list loadkeys-static)
+ '())))
(raw-initrd file-systems
#:linux linux
#:linux-modules linux-modules*
#:mapped-devices mapped-devices
#:helper-packages helper-packages
+ #:keyboard-layout keyboard-layout
#:qemu-networking? qemu-networking?
#:volatile-root? volatile-root?
#:on-error on-error))
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index 7dc36f4a45..13b8b14095 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -323,6 +323,7 @@ accounts among ACCOUNTS+GROUPS."
(list (shepherd-service
(requirement '(file-systems))
(provision '(user-homes))
+ (one-shot? #t)
(modules '((gnu build activation)
(gnu system accounts)))
(start (with-imported-modules (source-module-closure
@@ -332,9 +333,7 @@ accounts among ACCOUNTS+GROUPS."
(activate-user-home
(map sexp->user-account
(list #$@(map user-account->gexp accounts))))
- #f))) ;stop
- (stop #~(const #f))
- (respawn? #f)
+ #t))) ;success
(documentation "Create user home directories."))))
(define (shells-file shells)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 55cddb1a4b..92b03b01ad 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -58,6 +58,7 @@
#:use-module (gnu bootloader grub)
#:use-module (gnu system shadow)
#:use-module (gnu system pam)
+ #:use-module (gnu system linux-container)
#:use-module (gnu system linux-initrd)
#:use-module (gnu bootloader)
#:use-module (gnu system file-systems)
@@ -93,6 +94,12 @@
(define %linux-vm-file-systems
;; File systems mounted for 'derivation-in-linux-vm'. These are shared with
;; the host over 9p.
+ ;;
+ ;; The 9p documentation says that cache=loose is "intended for exclusive,
+ ;; read-only mounts", without additional details. It's much faster than the
+ ;; default cache=none, especially when copying and registering store items.
+ ;; Thus, use cache=loose, except for /xchg where we want to ensure
+ ;; consistency.
(list (file-system
(mount-point (%store-prefix))
(device "store")
@@ -101,18 +108,12 @@
(flags '(read-only))
(options "trans=virtio,cache=loose")
(check? #f))
-
- ;; The 9p documentation says that cache=loose is "intended for
- ;; exclusive, read-only mounts", without additional details. In
- ;; practice it seems to work well for these, and it's much faster than
- ;; the default cache=none, especially when copying and registering
- ;; store items.
(file-system
(mount-point "/xchg")
(device "xchg")
(type "9p")
(needed-for-boot? #t)
- (options "trans=virtio,cache=loose")
+ (options "trans=virtio")
(check? #f))
(file-system
(mount-point "/tmp")
@@ -320,7 +321,10 @@ INPUTS is a list of inputs (as for packages)."
#:make-disk-image? #f
#:single-file-output? #t
- #:references-graphs inputs))
+ #:references-graphs inputs
+
+ ;; Xorriso seems to be quite memory-hungry, so increase the VM's RAM size.
+ #:memory-size 512))
(define* (qemu-image #:key
(name "qemu-image")
@@ -473,9 +477,9 @@ should set REGISTER-CLOSURES? to #f."
(local-file (search-path %load-path
"guix/store/schema.sql"))))
- (mlet %store-monad ((os-drv (operating-system-derivation os #:container? #t))
- (name -> (string-append name ".tar.gz"))
- (graph -> "system-graph"))
+ (let ((os (containerized-operating-system os '()))
+ (name (string-append name ".tar.gz"))
+ (graph "system-graph"))
(define build
(with-extensions (cons guile-json ;for (guix docker)
gcrypt-sqlite3&co) ;for (guix store database)
@@ -505,7 +509,7 @@ should set REGISTER-CLOSURES? to #f."
(initialize (root-partition-initializer
#:closures '(#$graph)
#:register-closures? #$register-closures?
- #:system-directory #$os-drv
+ #:system-directory #$os
;; De-duplication would fail due to
;; cross-device link errors, so don't do it.
#:deduplicate? #f))
@@ -523,18 +527,15 @@ should set REGISTER-CLOSURES? to #f."
(call-with-input-file
(string-append "/xchg/" #$graph)
read-reference-graph)))
- #$os-drv
+ #$os
#:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
#:creation-time (make-time time-utc 0 1)
- #:transformations `((,root-directory -> "")))
-
- ;; Make sure the tarball is fully written before rebooting.
- (sync))))))
+ #:transformations `((,root-directory -> ""))))))))
(expression->derivation-in-linux-vm
name build
#:make-disk-image? #f
#:single-file-output? #t
- #:references-graphs `((,graph ,os-drv)))))
+ #:references-graphs `((,graph ,os)))))
;;;
@@ -616,7 +617,7 @@ to USB sticks meant to be read-only."
;; Volume name of the root file system.
(normalize-label "Guix_image"))
- (define root-uuid
+ (define (root-uuid os)
;; UUID of the root file system, computed in a deterministic fashion.
;; This is what we use to locate the root file system so it has to be
;; different from the user's own file system UUIDs.
@@ -646,17 +647,26 @@ to USB sticks meant to be read-only."
(bootloader grub-mkrescue-bootloader))
(operating-system-bootloader os)))
- ;; Force our own root file system.
+ ;; Force our own root file system. (We need a "/" file system
+ ;; to call 'root-uuid'.)
(file-systems (cons (file-system
(mount-point "/")
- (device root-uuid)
+ (device "/dev/placeholder")
+ (type file-system-type))
+ file-systems-to-keep))))
+ (uuid (root-uuid os))
+ (os (operating-system
+ (inherit os)
+ (file-systems (cons (file-system
+ (mount-point "/")
+ (device uuid)
(type file-system-type))
file-systems-to-keep))))
(bootcfg (operating-system-bootcfg os)))
(if (string=? "iso9660" file-system-type)
(iso9660-image #:name name
#:file-system-label root-label
- #:file-system-uuid root-uuid
+ #:file-system-uuid uuid
#:os os
#:register-closures? #t
#:bootcfg-drv bootcfg
@@ -673,7 +683,7 @@ to USB sticks meant to be read-only."
#:disk-image-format "raw"
#:file-system-type file-system-type
#:file-system-label root-label
- #:file-system-uuid root-uuid
+ #:file-system-uuid uuid
#:copy-inputs? #t
#:register-closures? #t
#:inputs `(("system" ,os)
@@ -790,6 +800,7 @@ environment with the store shared with the host. MAPPINGS is a list of
;; force the traditional i386/BIOS method.
;; See <https://bugs.gnu.org/28768>.
(bootloader (bootloader-configuration
+ (inherit (operating-system-bootloader os))
(bootloader grub-bootloader)
(target "/dev/vda")))