[bug#73927] [PATCH v4 16/18] installer: Add "Kernel" page to select the Hurd.

[Janneke Nieuwenhuizen <janneke@gnu.org>]

This adds a "Kernel" page to the installer with the option to (cross-) install
the Hurd, if applicable (only available on x86 machines for now).

* gnu/installer/newt.scm (kernel-page): New procedure.
(newt-installer)[kernel-page]: New field.
* gnu/installer/kernel.scm,
gnu/installer/newt/kernel.scm: New files.
* gnu/local.mk (INSTALLER_MODULES): Add them.
* gnu/installer.scm (installer-steps): Use them to select kernel if
applicable.
* gnu/installer/newt/partition.scm (run-label-page): Default to "msdos" when
instaling the Hurd.
(run-fs-type-page): Add ext2 for the hurd.
(run-partitioning-page-partition): Remove `entire-encrypted' option when
installing the Hurd.
* gnu/installer/services.scm (system-services->configuration): Cater for the
Hurd with %base-services/hurd, and with %base-packages/hurd that must always
be set.
(%system-services): Change to procedure.  When installing the the Hurd, do not
recommend `ntp-service-type' and USE `openssh-sans-x' package for
`openssh-service-type'.
(system-service-none): New variable.
* gnu/installer/newt/services.scm (run-network-management-page): Include it
when installing the Hurd.
(run-desktop-environments-cbt-page): When installing the Hurd, recommend to
not select any desktop enviroment.  Update users.
* gnu/installer/parted.scm (efi-installation?): Return #f when installing for
the Hurd.
(create-ext2-file-system): New procedure.
(user-fs-type-name, user-fs-type->mount-type, partition-filesystem-user-type,
format-user-partitions): Support `ext2'.
(<user-partition> partition->user-partition): Use `ext2' when installing the
Hurd.
(auto-partition!): Likewise.  No swap partition when installing the Hurd.
* gnu/installer/final.scm (install-system): Cater for cross installation of
the Hurd.
(bootloader-configuration): Use `grub-minimal-bootloader' when installing the
Hurd.
(user-partition-missing-modules): Cater for empty user-partitions.
(initrd-configuration, user-partitions->configuration): Cater for the Hurd.
* gnu/installer/steps.scm (format-configuration,
configuration->file): Cater for the Hurd.
* gnu/system/hurd.scm (%desktop-services/hurd): New variable.
* gnu/installer/tests.scm (choose-kernel): New procedure.
* gnu/tests/install.scm (gui-test-program): Use it.

Change-Id: Ifafb27b8a2f933944c77223a27ec151757237e36
---
 gnu/installer.scm                | 14 +++++
 gnu/installer/final.scm          |  9 +++-
 gnu/installer/kernel.scm         | 41 +++++++++++++++
 gnu/installer/newt.scm           |  5 ++
 gnu/installer/newt/kernel.scm    | 45 ++++++++++++++++
 gnu/installer/newt/partition.scm | 10 +++-
 gnu/installer/newt/services.scm  | 31 ++++++-----
 gnu/installer/parted.scm         | 89 +++++++++++++++++++++-----------
 gnu/installer/record.scm         |  3 ++
 gnu/installer/services.scm       | 46 +++++++++++++----
 gnu/installer/steps.scm          | 14 +++--
 gnu/installer/tests.scm          | 11 ++++
 gnu/local.mk                     |  2 +
 gnu/system/hurd.scm              |  3 ++
 gnu/tests/install.scm            |  6 ++-
 15 files changed, 269 insertions(+), 60 deletions(-)
 create mode 100644 gnu/installer/kernel.scm
 create mode 100644 gnu/installer/newt/kernel.scm

diff --git a/gnu/installer.scm b/gnu/installer.scm
index 39a83c4455..31c0ff7ff4 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -308,6 +308,18 @@ (define* (installer-steps #:key dry-run?)
                      ((installer-user-page current-installer))))
           (configuration-formatter users->configuration))
 
+         ;; Ask the user to select the kernel for the system,
+         ;; for x86 systems only.
+         (installer-step
+          (id 'kernel)
+          (description (G_ "Kernel"))
+          (compute (lambda _
+                     (if (target-x86?)
+                         ((installer-kernel-page current-installer))
+                         '())))
+          (configuration-formatter (lambda (result)
+                                     (kernel->configuration result #$dry-run?))))
+
          ;; Ask the user to choose one or many desktop environment(s).
          (installer-step
           (id 'services)
@@ -419,6 +431,7 @@ (define* (installer-program #:key dry-run?)
                          (gnu installer dump)
                          (gnu installer final)
                          (gnu installer hostname)
+                         (gnu installer kernel)
                          (gnu installer locale)
                          (gnu installer parted)
                          (gnu installer services)
@@ -431,6 +444,7 @@ (define* (installer-program #:key dry-run?)
                          (gnu services herd)
                          (guix i18n)
                          (guix build utils)
+                         (guix utils)
                          ((system repl debug)
                           #:select (terminal-width))
                          (ice-9 match)
diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm
index 069426a3b8..64c054cd86 100644
--- a/gnu/installer/final.scm
+++ b/gnu/installer/final.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,6 +26,7 @@ (define-module (gnu installer final)
   #:use-module (gnu services herd)
   #:use-module (guix build syscalls)
   #:use-module (guix build utils)
+  #:use-module (guix utils)
   #:use-module (gnu build accounts)
   #:use-module (gnu build install)
   #:use-module (gnu build linux-container)
@@ -164,8 +166,11 @@ (define* (install-system locale #:key (users '()))
                                   "/tmp/installer-system-init-options"
                                 read))
                             (const '())))
-         (install-command (append (list "guix" "system" "init"
-                                        "--fallback")
+         (install-command (append `( "guix" "system" "init"
+                                     "--fallback"
+                                     ,@(if (target-hurd?)
+                                           '("--target=i586-pc-gnu")
+                                           '()))
                                   options
                                   (list (%installer-configuration-file)
                                         (%installer-target-dir))))
diff --git a/gnu/installer/kernel.scm b/gnu/installer/kernel.scm
new file mode 100644
index 0000000000..c82b06fb83
--- /dev/null
+++ b/gnu/installer/kernel.scm
@@ -0,0 +1,41 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@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 installer kernel)
+  #:use-module (gnu system hurd)
+  #:use-module (guix read-print)
+  #:export (kernel->configuration))
+
+(define-syntax-rule (G_ str)
+  ;; In this file, translatable strings are annotated with 'G_' so xgettext
+  ;; catches them, but translation happens later on at run time.
+  str)
+
+(define (kernel->configuration kernel dry-run?)
+  (if (equal? kernel "Hurd")
+      `((kernel %hurd-default-operating-system-kernel)
+        ,(comment (G_ ";; \"noide\" disables the gnumach IDE driver, enabling rumpdisk.\n"))
+        (kernel-arguments '("noide"))
+        (firmware '())
+        (hurd hurd)
+        (locale-libcs (list glibc/hurd))
+        (name-service-switch #f)
+        (essential-services (hurd-default-essential-services this-operating-system))
+        (privileged-programs '())
+        (setuid-programs %setuid-programs/hurd))
+      '()))
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index d53bc058b3..1fe710340f 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -25,6 +25,7 @@ (define-module (gnu installer newt)
   #:use-module (gnu installer newt final)
   #:use-module (gnu installer newt parameters)
   #:use-module (gnu installer newt hostname)
+  #:use-module (gnu installer newt kernel)
   #:use-module (gnu installer newt keymap)
   #:use-module (gnu installer newt locale)
   #:use-module (gnu installer newt menu)
@@ -193,6 +194,9 @@ (define (substitutes-page)
 (define (hostname-page)
   (run-hostname-page))
 
+(define (kernel-page)
+  (run-kernel-page))
+
 (define (user-page)
   (run-user-page))
 
@@ -216,6 +220,7 @@ (define newt-installer
    (exit-error exit-error)
    (final-page final-page)
    (keymap-page keymap-page)
+   (kernel-page kernel-page)
    (locale-page locale-page)
    (menu-page menu-page)
    (network-page network-page)
diff --git a/gnu/installer/newt/kernel.scm b/gnu/installer/newt/kernel.scm
new file mode 100644
index 0000000000..3117247312
--- /dev/null
+++ b/gnu/installer/newt/kernel.scm
@@ -0,0 +1,45 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@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 installer newt kernel)
+  #:use-module (gnu installer newt page)
+  #:use-module (guix i18n)
+  #:use-module (guix utils)
+  #:export (run-kernel-page))
+
+(define (run-kernel-page)
+  (let* ((kernels `(,@(if (target-x86?) '("Hurd") '())
+                    "Linux Libre"))
+         (result
+          (run-listbox-selection-page
+           #:title (G_ "Kernel")
+           #:info-text
+           (G_ "Please select a kernel.  When in doubt, choose \"Linux Libre\".
+The Hurd is offered as a technology preview and development aid; many packages \
+are not yet available in Guix, such as a desktop environment or even a windowing \
+system (X, Wayland).")
+           #:listbox-items kernels
+           #:listbox-item->text identity
+           #:listbox-default-item "Linux Libre"
+           #:button-text (G_ "Back")
+           #:button-callback-procedure
+           (lambda _
+             (abort-to-prompt 'installer-step 'abort)))))
+    (when (equal? result "Hurd")
+      (%current-target-system "i586-pc-gnu"))
+    result))
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index 48dd306080..3a7e679577 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.scm
@@ -26,6 +26,7 @@ (define-module (gnu installer newt partition)
   #:use-module (gnu installer newt page)
   #:use-module (gnu installer newt utils)
   #:use-module (guix i18n)
+  #:use-module (guix utils)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
@@ -115,6 +116,7 @@ (define (run-label-page button-text button-callback)
 Be careful, all data on the disk will be lost.")
        #:title (G_ "Partition table")
        #:listbox-items '("msdos" "gpt")
+       #:listbox-default-item (if (target-hurd?) "msdos" "gpt")
        #:listbox-item->text identity
        #:listbox-callback-procedure
        (run-label-confirmation-page button-callback)
@@ -147,6 +149,8 @@ (define (run-fs-type-page)
    #:title (G_ "File-system type")
    #:listbox-items '(btrfs ext4 jfs xfs
                            swap
+                           ;; This is for the Hurd
+                           ext2
                            ;; These lack basic Unix features.  Their only use
                            ;; on GNU is for interoperation, e.g., with UEFI.
                            fat32 fat16 ntfs)
@@ -767,7 +771,11 @@ (define (run-partitioning-page)
   (define (run-page devices)
     (let* ((items
             `((entire . ,(G_ "Guided - using the entire disk"))
-              (entire-encrypted . ,(G_ "Guided - using the entire disk with encryption"))
+              ,@(if (target-hurd?)
+                    '()
+                    `((entire-encrypted
+                       .
+                       ,(G_ "Guided - using the entire disk with encryption"))))
               (manual . ,(G_ "Manual"))))
            (result (run-listbox-selection-page
                     #:info-text (G_ "Please select a partitioning method.")
diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm
index d1035b6524..848683e8c7 100644
--- a/gnu/installer/newt/services.scm
+++ b/gnu/installer/newt/services.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2021 Leo Famulari <leo@famulari.name>
 ;;;
@@ -26,6 +26,7 @@ (define-module (gnu installer newt services)
   #:use-module (gnu installer newt page)
   #:use-module (gnu installer newt utils)
   #:use-module (guix i18n)
+  #:use-module (guix utils)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:export (run-services-page))
@@ -33,11 +34,13 @@ (define-module (gnu installer newt services)
 (define (run-desktop-environments-cbt-page)
   "Run a page allowing the user to choose between various desktop
 environments."
-  (let ((items (filter desktop-system-service? %system-services)))
+  (let ((items (filter desktop-system-service? (%system-services))))
     (run-checkbox-tree-page
-     #:info-text (G_ "Please select the desktop environment(s) you wish to \
+     #:info-text (if (target-hurd?)
+                     (G_ "Currently, none of these is available for the Hurd.")
+                     (G_ "Please select the desktop environment(s) you wish to \
 install.  If you select multiple desktop environments here, you will be able \
-to choose from them later when you log in.")
+to choose from them later when you log in."))
      #:title (G_ "Desktop environment")
      #:items items
      #:selection (map system-service-recommended? items)
@@ -51,7 +54,7 @@ (define (run-networking-cbt-page)
   "Run a page allowing the user to select networking services."
   (let ((items (filter (lambda (service)
                          (eq? 'networking (system-service-type service)))
-                       %system-services)))
+                       (%system-services))))
     (run-checkbox-tree-page
      #:info-text (G_ "You can now select networking services to run on your \
 system.")
@@ -69,7 +72,7 @@ (define (run-printing-services-cbt-page)
   (let ((items (filter (lambda (service)
                          (eq? 'document
                               (system-service-type service)))
-                       %system-services)))
+                       (%system-services))))
     (run-checkbox-tree-page
      #:info-text (G_ "You can now select the CUPS printing service to run on your \
 system.")
@@ -88,7 +91,7 @@ (define (run-console-services-cbt-page)
   (let ((items (filter (lambda (service)
                          (eq? 'administration
                               (system-service-type service)))
-                       %system-services)))
+                       (%system-services))))
     (run-checkbox-tree-page
       #:title (G_ "Console services")
       #:info-text (G_ "Select miscellaneous services to run on your \
@@ -103,7 +106,11 @@ (define (run-console-services-cbt-page)
 
 (define (run-network-management-page)
   "Run a page to select among several network management methods."
-  (let ((title (G_ "Network management")))
+  (let ((title (G_ "Network management"))
+        (items (filter (lambda (service)
+                         (eq? 'network-management
+                              (system-service-type service)))
+                       (%system-services))))
     (run-listbox-selection-page
      #:title title
      #:info-text (G_ "Choose the method to manage network connections.
@@ -112,10 +119,10 @@ (define (run-network-management-page)
 client may be enough for a server.")
      #:info-textbox-width 70
      #:listbox-height 7
-     #:listbox-items (filter (lambda (service)
-                               (eq? 'network-management
-                                    (system-service-type service)))
-                             %system-services)
+     #:listbox-items `(,@items
+                       ,@(if (target-hurd?)
+                             (list system-service-none)
+                             '()))
      #:listbox-item->text (compose G_ system-service-name)
      #:sort-listbox-items? #f
      #:button-text (G_ "Exit")
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index b36b238d8b..ccddc64f11 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -152,7 +152,7 @@ (define-record-type* <user-partition>
   (crypt-password       user-partition-crypt-password ; <secret>
                         (default #f))
   (fs-type              user-partition-fs-type
-                        (default 'ext4))
+                        (default (if (target-hurd?) 'ext2 'ext4)))
   (bootable?            user-partition-bootable?
                         (default #f))
   (esp?                 user-partition-esp?
@@ -223,11 +223,13 @@ (define default-esp-mount-point
 
 (define (efi-installation?)
   "Return #t if an EFI installation should be performed, #f otherwise."
-  (file-exists? "/sys/firmware/efi"))
+  (and (file-exists? "/sys/firmware/efi")
+       (not (target-hurd?))))
 
 (define (user-fs-type-name fs-type)
   "Return the name of FS-TYPE as specified by libparted."
   (case fs-type
+    ((ext2)  "ext2")
     ((ext4)  "ext4")
     ((btrfs) "btrfs")
     ((fat16) "fat16")
@@ -240,6 +242,7 @@ (define (user-fs-type-name fs-type)
 (define (user-fs-type->mount-type fs-type)
   "Return the mount type of FS-TYPE."
   (case fs-type
+    ((ext2)  "ext2")
     ((ext4)  "ext4")
     ((btrfs) "btrfs")
     ((fat16) "vfat")
@@ -255,6 +258,7 @@ (define (partition-filesystem-user-type partition)
     (and fs-type
          (let ((name (filesystem-type-name fs-type)))
            (cond
+            ((string=? name "ext2") 'ext2)
             ((string=? name "ext4") 'ext4)
             ((string=? name "btrfs") 'btrfs)
             ((string=? name "fat16") 'fat16)
@@ -296,7 +300,7 @@ (define (partition->user-partition partition)
      (file-name (partition-get-path partition))
      (disk-file-name (device-path device))
      (fs-type (or (partition-filesystem-user-type partition)
-                  'ext4))
+                  (if (target-hurd?) 'ext2 'ext4)))
      (mount-point (and (esp-partition? partition)
                        (default-esp-mount-point)))
      (bootable? (boot-partition? partition))
@@ -1045,18 +1049,20 @@ (define* (auto-partition! disk
      non-boot-partitions)
 
     (let* ((start-partition
-            (if (efi-installation?)
-                (and (not esp-partition)
-                     (user-partition
-                      (fs-type 'fat32)
-                      (esp? #t)
-                      (size new-esp-size)
-                      (mount-point (default-esp-mount-point))))
-                (user-partition
-                 (fs-type 'ext4)
-                 (bootable? #t)
-                 (bios-grub? #t)
-                 (size bios-grub-size))))
+            (cond ((target-hurd?) #f)
+                  ((efi-installation?)
+                   (and (not esp-partition)
+                        (user-partition
+                         (fs-type 'fat32)
+                         (esp? #t)
+                         (size new-esp-size)
+                         (mount-point (default-esp-mount-point)))))
+                  (else
+                   (user-partition
+                    (fs-type 'ext4)
+                    (bootable? #t)
+                    (bios-grub? #t)
+                    (size bios-grub-size)))))
            (new-partitions
             (cond
              ((or (eq? scheme 'entire-root)
@@ -1065,13 +1071,13 @@ (define* (auto-partition! disk
                 `(,@(if start-partition
                         `(,start-partition)
                         '())
-                  ,@(if encrypted?
+                  ,@(if (or encrypted? (target-hurd?))
                         '()
                         `(,(user-partition
                             (fs-type 'swap)
                             (size swap-size))))
                   ,(user-partition
-                    (fs-type 'ext4)
+                    (fs-type (if (target-hurd?) 'ext2 'ext4))
                     (bootable? has-extended?)
                     (crypt-label (and encrypted? "cryptroot"))
                     (size "100%")
@@ -1083,7 +1089,7 @@ (define* (auto-partition! disk
                         `(,start-partition)
                         '())
                   ,(user-partition
-                    (fs-type 'ext4)
+                    (fs-type (if (target-hurd?) 'ext2 'ext4))
                     (bootable? has-extended?)
                     (crypt-label (and encrypted? "cryptroot"))
                     (size "33%")
@@ -1105,7 +1111,7 @@ (define* (auto-partition! disk
                     (type (if has-extended?
                               'logical
                               'normal))
-                    (fs-type 'ext4)
+                    (fs-type (if (target-hurd?) 'ext2 'ext4))
                     (crypt-label (and encrypted? "crypthome"))
                     (size "100%")
                     (mount-point "/home")))))))
@@ -1186,6 +1192,15 @@ (define (create-btrfs-file-system partition)
   "Create a btrfs file-system for PARTITION file-name."
    ((%run-command-in-installer) "mkfs.btrfs" "-f" partition))
 
+(define (create-ext2-file-system partition)
+  "Create an ext2 file-system for PARTITION file-name, when TARGET-HURD?,
+for the Hurd."
+  (apply (%run-command-in-installer)
+         `("mkfs.ext2" ,@(if (target-hurd?)
+                             '("-o" "hurd")
+                             '())
+           "-F" ,partition)))
+
 (define (create-ext4-file-system partition)
   "Create an ext4 file-system for PARTITION file-name."
   ;; Enable the 'large_dir' feature so users can have a store of several TiBs.
@@ -1291,6 +1306,10 @@ (define (format-user-partitions user-partitions)
           (and need-formatting?
                (not (eq? type 'extended))
                (create-btrfs-file-system file-name)))
+         ((ext2)
+          (and need-formatting?
+               (not (eq? type 'extended))
+               (create-ext2-file-system file-name)))
          ((ext4)
           (and need-formatting?
                (not (eq? type 'extended))
@@ -1463,7 +1482,11 @@ (define (bootloader-configuration user-partitions)
   "Return the bootloader configuration field for USER-PARTITIONS."
   (let ((root-partition (find root-user-partition? user-partitions)))
     (match user-partitions
-      (() '())
+      (() (if (target-hurd?)
+              '(bootloader-configuration
+                (bootloader grub-minimal-bootloader)
+                (targets "/dev/sdaX"))
+              '()))
       (_
        (let ((root-partition-disk (user-partition-disk-file-name
                                    root-partition)))
@@ -1471,7 +1494,9 @@ (define (bootloader-configuration user-partitions)
             ,@(if (efi-installation?)
                   `((bootloader grub-efi-bootloader)
                     (targets (list ,(default-esp-mount-point))))
-                  `((bootloader grub-bootloader)
+                  `((bootloader ,(if (target-hurd?)
+                                     'grub-minimal-bootloader
+                                     'grub-bootloader))
                     (targets (list ,root-partition-disk))))
 
             ;; XXX: Assume we defined the 'keyboard-layout' field of
@@ -1491,22 +1516,28 @@ (define (user-partition-missing-modules user-partitions)
                      (const '())))
                  (delete-duplicates
                   (map user-partition-file-name
-                       (cons root devices)))))))
+                       (filter identity
+                               (cons root devices))))))))
 
 (define (initrd-configuration user-partitions)
   "Return an 'initrd-modules' field with everything needed for
 USER-PARTITIONS, or return nothing."
-  (match (user-partition-missing-modules user-partitions)
-    (()
-     '())
-    ((modules ...)
-     `((initrd-modules (append ',modules
-                               %base-initrd-modules))))))
+  (if (target-hurd?)
+      '((initrd #f)
+        (initrd-modules '()))
+      (match (user-partition-missing-modules user-partitions)
+        (()
+         '())
+        ((modules ...)
+         `((initrd-modules (append ',modules
+                                   %base-initrd-modules)))))))
 
 (define (user-partitions->configuration user-partitions)
   "Return the configuration field for USER-PARTITIONS."
   (let* ((swap-user-partitions (find-swap-user-partitions user-partitions))
-         (swap-devices (map user-partition-file-name swap-user-partitions))
+         (swap-devices (if (target-hurd?)
+                           '()
+                           (map user-partition-file-name swap-user-partitions)))
          (encrypted-partitions
           (filter user-partition-crypt-label user-partitions)))
     `((bootloader ,@(bootloader-configuration user-partitions))
diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm
index 334af44a0c..22adad279c 100644
--- a/gnu/installer/record.scm
+++ b/gnu/installer/record.scm
@@ -30,6 +30,7 @@ (define-module (gnu installer record)
             installer-exit
             installer-exit-error
             installer-final-page
+            installer-kernel-page
             installer-keymap-page
             installer-locale-page
             installer-menu-page
@@ -69,6 +70,8 @@ (define-record-type* <installer>
   (exit-error installer-exit-error)
   ;; procedure void -> void
   (final-page installer-final-page)
+  ;; procedure void -> void
+  (kernel-page installer-kernel-page)
   ;; procedure (layouts context) -> (list layout variant options)
   (keymap-page installer-keymap-page)
   ;; procedure: (#:key supported-locales iso639-languages iso3166-territories)
diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm
index 1cb9dc579c..d5a382606c 100644
--- a/gnu/installer/services.scm
+++ b/gnu/installer/services.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019, 2022 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2021 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2023 Denys Nykula <vegan@libre.net.ua>
@@ -24,6 +24,7 @@
 (define-module (gnu installer services)
   #:use-module (guix records)
   #:use-module (guix read-print)
+  #:use-module (guix utils)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:export (system-service?
@@ -34,6 +35,7 @@ (define-module (gnu installer services)
             system-service-packages
 
             desktop-system-service?
+            system-service-none
 
             %system-services
             system-services->configuration))
@@ -55,7 +57,13 @@ (define-record-type* <system-service>
   (packages        system-service-packages        ;list of sexps
                    (default '())))
 
-(define %system-services
+(define system-service-none
+  (system-service
+   (name (G_ "None"))
+   (type 'network-management)
+   (snippet '())))
+
+(define (%system-services)
   (let-syntax ((desktop-environment (syntax-rules ()
                                       ((_ fields ...)
                                        (system-service
@@ -105,7 +113,11 @@ (define %system-services
                    (G_ "\
 ;; To configure OpenSSH, pass an 'openssh-configuration'
 ;; record as a second argument to 'service' below.\n"))
-                 (service openssh-service-type))))
+                 ,(if (target-hurd?)
+                      '(service openssh-service-type
+                                (openssh-configuration
+                                 (openssh openssh-sans-x)))
+                      '(service openssh-service-type)))))
      (system-service
       (name (G_ "Tor anonymous network router"))
       (type 'networking)
@@ -115,7 +127,7 @@ (define %system-services
      (system-service
        (name (G_ "Network time service (NTP), to set the clock automatically"))
        (type 'administration)
-       (recommended? #t)
+       (recommended? (not (target-hurd?)))
        (snippet '((service ntp-service-type))))
      (system-service
        (name (G_ "GPM mouse daemon, to use the mouse on the console"))
@@ -154,8 +166,12 @@ (define (system-services->configuration services)
          (packages (append-map system-service-packages services))
          (desktop? (find desktop-system-service? services))
          (base     (if desktop?
-                       '%desktop-services
-                       '%base-services))
+                       (if (target-hurd?)
+                           '%desktop-services/hurd
+                           '%desktop-services)
+                       (if (target-hurd?)
+                           '%base-services/hurd
+                           '%base-services)))
          (native-console-font (match (getenv "LANGUAGE")
                                 ((or "be" "bg" "el" "eo" "kk" "ky"
                                      "mk" "mn" "ru" "sr" "tg" "uk")
@@ -181,18 +197,28 @@ (define (system-services->configuration services)
 
     (if (null? snippets)
         `(,@(if (null? packages)
-                '()
+                (if (target-hurd?)
+                    `(,@package-heading
+                      (packages %base-packages/hurd))
+                    '())
                 `(,@package-heading
                   (packages (append (list ,@packages)
-                                    %base-packages))))
+                                    ,(if (target-hurd?)
+                                         '%base-packages/hurd
+                                         '%base-packages)))))
 
           ,@service-heading
           (services ,services))
         `(,@(if (null? packages)
-                '()
+                (if (target-hurd?)
+                    `(,@package-heading
+                      (packages %base-packages/hurd))
+                    '())
                 `(,@package-heading
                   (packages (append (list ,@packages)
-                                    %base-packages))))
+                                    ,(if (target-hurd?)
+                                         '%base-packages/hurd
+                                         '%base-packages)))))
 
           ,@service-heading
           (services (append (list ,@snippets
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
index de0a852f02..34dd14c9d5 100644
--- a/gnu/installer/steps.scm
+++ b/gnu/installer/steps.scm
@@ -23,6 +23,7 @@ (define-module (gnu installer steps)
   #:use-module (guix build utils)
   #:use-module (guix i18n)
   #:use-module (guix read-print)
+  #:use-module (guix utils)
   #:use-module (gnu installer utils)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
@@ -240,17 +241,20 @@ (define (format-configuration steps results)
                    ,(comment (G_ "\
 ;; Indicate which modules to import to access the variables
 ;; used in this configuration.\n"))
-                   (use-modules (gnu))
+                   ,@(if (target-hurd?)
+                         '((use-modules (gnu) (gnu system hurd))
+                           (use-package-modules hurd ssh))
+                         '((use-modules (gnu))))
                    (use-service-modules cups desktop networking ssh xorg))))
     `(,@modules
       ,(vertical-space 1)
       (operating-system ,@configuration))))
 
 (define* (configuration->file configuration
-                              #:key (filename (%installer-configuration-file)))
-  "Write the given CONFIGURATION to FILENAME."
-  (mkdir-p (dirname filename))
-  (call-with-output-file filename
+                              #:key (file-name (%installer-configuration-file)))
+  "Write the given CONFIGURATION to FILE-NAME."
+  (mkdir-p (dirname file-name))
+  (call-with-output-file file-name
     (lambda (port)
       ;; TRANSLATORS: This is a comment within a Scheme file.  Each line must
       ;; start with ";; " (two semicolons and a space).  Please keep line
diff --git a/gnu/installer/tests.scm b/gnu/installer/tests.scm
index 8785cd9a9f..a9a5d5d988 100644
--- a/gnu/installer/tests.scm
+++ b/gnu/installer/tests.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -35,6 +36,7 @@ (define-module (gnu installer tests)
 
             choose-locale+keyboard
             enter-host-name+passwords
+            choose-kernel
             choose-services
             choose-partitioning
             start-installation
@@ -211,6 +213,15 @@ (define* (enter-host-name+passwords port
                       (password ,password)))
              names passwords))))))
 
+(define* (choose-kernel port #:key (kernel "Linux Libre"))
+  "Converse over PORT with the guided installer to choose the specified
+KERNEL."
+  (converse port
+    ((list-selection (title "Kernel")
+                     (multiple-choices? #f)
+                     (items _))
+     kernel)))
+
 (define* (choose-services port
                           #:key
                           (choose-desktop-environment? (const #f))
diff --git a/gnu/local.mk b/gnu/local.mk
index 872e55eb41..e2392962b4 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -863,6 +863,7 @@ INSTALLER_MODULES =                             \
   %D%/installer/final.scm			\
   %D%/installer/hardware.scm			\
   %D%/installer/hostname.scm			\
+  %D%/installer/kernel.scm			\
   %D%/installer/keymap.scm			\
   %D%/installer/locale.scm			\
   %D%/installer/newt.scm			\
@@ -881,6 +882,7 @@ INSTALLER_MODULES =                             \
   %D%/installer/newt/final.scm  		\
   %D%/installer/newt/parameters.scm		\
   %D%/installer/newt/hostname.scm		\
+  %D%/installer/newt/kernel.scm			\
   %D%/installer/newt/keymap.scm			\
   %D%/installer/newt/locale.scm			\
   %D%/installer/newt/menu.scm			\
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index 283bae6f10..9a351529e8 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -48,6 +48,7 @@ (define-module (gnu system hurd)
   #:export (%base-packages/hurd
             %base-services/hurd
             %base-services+qemu-networking/hurd
+            %desktop-services/hurd
             %hurd-default-operating-system
             %hurd-default-operating-system-kernel
             %setuid-programs/hurd))
@@ -107,6 +108,8 @@ (define %base-services+qemu-networking/hurd
                   %qemu-static-networking))
    %base-services/hurd))
 
+(define %desktop-services/hurd %base-services/hurd)
+
 (define %setuid-programs/hurd
   ;; Default set of setuid-root programs.
   (map file-like->setuid-program
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 36dbd9111f..c8dccd38b0 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -3,7 +3,7 @@
 ;;; Copyright © 2017, 2019, 2021 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
-;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -1869,6 +1869,10 @@ (define* (gui-test-program marionette
                         #$marionette)
       (screenshot "installer-services.ppm")
 
+      (when #$(target-x86?)
+        (marionette-eval* '(choose-kernel installer-socket) #$marionette)
+        (screenshot "installer-kernel.ppm"))
+
       (marionette-eval* '(choose-services installer-socket
                                           #:choose-desktop-environment?
                                           (const #$desktop?)
-- 
Janneke Nieuwenhuizen <janneke@gnu.org>  | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com