@@ -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-builder
(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-builder
(gnu services herd)
(guix i18n)
(guix build utils)
+ (guix utils)
((system repl debug)
#:select (terminal-width))
(ice-9 match)
@@ -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,12 @@ (define (assert-exit x)
"/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"
+ "--skip-checks")
+ '()))
options
(list (%installer-configuration-file)
(%installer-target-dir))))
new file mode 100644
@@ -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))
+ '()))
@@ -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)
new file mode 100644
@@ -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))
@@ -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)
@@ -147,6 +148,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 +770,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.")
@@ -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")
@@ -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))
@@ -1053,7 +1057,7 @@ (define* (auto-partition! disk
(size new-esp-size)
(mount-point (default-esp-mount-point))))
(user-partition
- (fs-type 'ext4)
+ (fs-type (if (target-hurd?) 'ext2 'ext4))
(bootable? #t)
(bios-grub? #t)
(size bios-grub-size))))
@@ -1065,13 +1069,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 +1087,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 +1109,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 +1190,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 +1304,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 +1480,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 +1492,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 +1514,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))
@@ -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)
@@ -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
@@ -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
@@ -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))
@@ -862,6 +862,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 \
@@ -880,6 +881,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 \
@@ -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
@@ -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-syntax-rule (marionette-eval* exp 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?)