system: Initialize console keyboard layout in the initrd.

Partially fixes <https://bugs.gnu.org/25453>.

* gnu/system.scm (<operating-system>)[keyboard-layout]: New field.
(operating-system-initrd-file): Pass #:keyboard-layout to MAKE-INITRD.
* gnu/system/linux-initrd.scm (raw-initrd): Add #:keyboard-layout.
Pass #:keymap-file to 'boot-system'.
(base-initrd): Add #:keyboard-layout.
[helper-packages]: Add LOADKEYS-STATIC when KEYBOARD-LAYOUT is true.
Pass #:keyboard-layout to 'raw-initrd'.
* gnu/build/linux-boot.scm (boot-system): Add #:keymap-file and honor
it.
* doc/guix.texi (operating-system Reference): Document the
'keyboard-layout' field.
(Initial RAM Disk): Update 'raw-initrd' and 'base-initrd' documentation.

3 files changed, 42 insertions, 6 deletions

diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 44b3506284..a35d18ad7c 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.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 © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -437,6 +437,7 @@ bailing out.~%root contents: ~s~%" (scandir "/"))
 (define* (boot-system #:key
                       (linux-modules '())
                       linux-module-directory
+                      keymap-file
                       qemu-guest-networking?
                       volatile-root?
                       pre-mount
@@ -444,7 +445,8 @@ bailing out.~%root contents: ~s~%" (scandir "/"))
                       (on-error 'debug))
   "This procedure is meant to be called from an initrd.  Boot a system by
 first loading LINUX-MODULES (a list of module names) from
-LINUX-MODULE-DIRECTORY, then setting up QEMU guest networking if
+LINUX-MODULE-DIRECTORY, then installing KEYMAP-FILE with 'loadkeys' (if
+KEYMAP-FILE is true), then setting up QEMU guest networking if
 QEMU-GUEST-NETWORKING? is true, calling PRE-MOUNT, mounting the file systems
 specified in MOUNTS, and finally booting into the new root if any.  The initrd
 supports kernel command-line options '--load', '--root', and '--repl'.
@@ -491,6 +493,15 @@ upon error."
                       #:lookup-module lookup-module)
                  (map lookup-module linux-modules))
 
+       (when keymap-file
+         (let ((status (system* "loadkeys" keymap-file)))
+           (unless (zero? status)
+             ;; Emit a warning rather than abort when we cannot load
+             ;; KEYMAP-FILE.
+             (format (current-error-port)
+                     "warning: 'loadkeys' exited with status ~a~%"
+                     status))))
+
        (when qemu-guest-networking?
          (unless (configure-qemu-networking)
            (display "network interface is DOWN\n")))
diff --git a/gnu/system.scm b/gnu/system.scm
index 6bccdaa8c2..035bbd82a1 100644
--- a/gnu/system.scm
+++ b/gnu/system.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 © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
@@ -157,6 +157,8 @@
                     (default '()))                ; list of gexps/strings
   (bootloader operating-system-bootloader)        ; <bootloader-configuration>
 
+  (keyboard-layout operating-system-keyboard-layout ;#f | <keyboard-layout>
+                   (default #f))
   (initrd operating-system-initrd                 ; (list fs) -> file-like
           (default base-initrd))
   (initrd-modules operating-system-initrd-modules ; list of strings
@@ -878,7 +880,8 @@ hardware-related operations as necessary when booting a Linux container."
                #:linux (operating-system-kernel os)
                #:linux-modules
                (operating-system-initrd-modules os)
-               #:mapped-devices mapped-devices))
+               #:mapped-devices mapped-devices
+               #:keyboard-layout (operating-system-keyboard-layout os)))
 
 (define (locale-name->definition* name)
   "Variant of 'locale-name->definition' that raises an error upon failure."
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))