mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-18 13:36:36 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

installer: Add "Kernel" page to select the Hurd.

Browse source 
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
This commit is contained in:
Janneke Nieuwenhuizen 2024-10-20 15:13:16 +02:00 committed by Jan (janneke) Nieuwenhuizen
parent 9aeb8e3dee
commit 687a2ccabc
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
15 changed files with 269 additions and 60 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
gnu/installer.scm
View file

@ -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)

9
gnu/installer/final.scm
View file

@ -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 (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")
'()))
options
(list (%installer-configuration-file)
(%installer-target-dir))))

41
gnu/installer/kernel.scm Normal file
View file

@ -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))
'()))

5
gnu/installer/newt.scm
View file

@ -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)

45
gnu/installer/newt/kernel.scm Normal file
View file

@ -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))

10
gnu/installer/newt/partition.scm
View file

@ -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.")

31
gnu/installer/newt/services.scm
View file

@ -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")

89
gnu/installer/parted.scm
View file

@ -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))

3
gnu/installer/record.scm
View file

@ -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)

46
gnu/installer/services.scm
View file

@ -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

14
gnu/installer/steps.scm
View file

@ -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

11
gnu/installer/tests.scm
View file

@ -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))

2
gnu/local.mk
View file

@ -864,6 +864,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 \
@ -882,6 +883,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 \

3
gnu/system/hurd.scm
View file

@ -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

6
gnu/tests/install.scm
View file

@ -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?)