mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-18 21:46:35 +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)))) ((installer-user-page current-installer))))
(configuration-formatter users->configuration)) (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). ;; Ask the user to choose one or many desktop environment(s).
(installer-step (installer-step
(id 'services) (id 'services)
@ -419,6 +431,7 @@ (define installer-builder
(gnu installer dump) (gnu installer dump)
(gnu installer final) (gnu installer final)
(gnu installer hostname) (gnu installer hostname)
(gnu installer kernel)
(gnu installer locale) (gnu installer locale)
(gnu installer parted) (gnu installer parted)
(gnu installer services) (gnu installer services)
@ -431,6 +444,7 @@ (define installer-builder
(gnu services herd) (gnu services herd)
(guix i18n) (guix i18n)
(guix build utils) (guix build utils)
(guix utils)
((system repl debug) ((system repl debug)
#:select (terminal-width)) #:select (terminal-width))
(ice-9 match) (ice-9 match)

9
gnu/installer/final.scm
View file

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -25,6 +26,7 @@ (define-module (gnu installer final)
#:use-module (gnu services herd) #:use-module (gnu services herd)
#:use-module (guix build syscalls) #:use-module (guix build syscalls)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (guix utils)
#:use-module (gnu build accounts) #:use-module (gnu build accounts)
#:use-module (gnu build install) #:use-module (gnu build install)
#:use-module (gnu build linux-container) #:use-module (gnu build linux-container)
@ -164,8 +166,11 @@ (define (assert-exit x)
"/tmp/installer-system-init-options" "/tmp/installer-system-init-options"
read)) read))
(const '()))) (const '())))
(install-command (append (list "guix" "system" "init" (install-command (append `( "guix" "system" "init"
"--fallback") "--fallback"
,@(if (target-hurd?)
'("--target=i586-pc-gnu")
'()))
options options
(list (%installer-configuration-file) (list (%installer-configuration-file)
(%installer-target-dir)))) (%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 final)
#:use-module (gnu installer newt parameters) #:use-module (gnu installer newt parameters)
#:use-module (gnu installer newt hostname) #:use-module (gnu installer newt hostname)
#:use-module (gnu installer newt kernel)
#:use-module (gnu installer newt keymap) #:use-module (gnu installer newt keymap)
#:use-module (gnu installer newt locale) #:use-module (gnu installer newt locale)
#:use-module (gnu installer newt menu) #:use-module (gnu installer newt menu)
@ -193,6 +194,9 @@ (define (substitutes-page)
(define (hostname-page) (define (hostname-page)
(run-hostname-page)) (run-hostname-page))
(define (kernel-page)
(run-kernel-page))
(define (user-page) (define (user-page)
(run-user-page)) (run-user-page))
@ -216,6 +220,7 @@ (define newt-installer
(exit-error exit-error) (exit-error exit-error)
(final-page final-page) (final-page final-page)
(keymap-page keymap-page) (keymap-page keymap-page)
(kernel-page kernel-page)
(locale-page locale-page) (locale-page locale-page)
(menu-page menu-page) (menu-page menu-page)
(network-page network-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 page)
#:use-module (gnu installer newt utils) #:use-module (gnu installer newt utils)
#:use-module (guix i18n) #:use-module (guix i18n)
#:use-module (guix utils)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #: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.") Be careful, all data on the disk will be lost.")
#:title (G_ "Partition table") #:title (G_ "Partition table")
#:listbox-items '("msdos" "gpt") #:listbox-items '("msdos" "gpt")
#:listbox-default-item (if (target-hurd?) "msdos" "gpt")
#:listbox-item->text identity #:listbox-item->text identity
#:listbox-callback-procedure #:listbox-callback-procedure
(run-label-confirmation-page button-callback) (run-label-confirmation-page button-callback)
@ -147,6 +149,8 @@ (define (run-fs-type-page)
#:title (G_ "File-system type") #:title (G_ "File-system type")
#:listbox-items '(btrfs ext4 jfs xfs #:listbox-items '(btrfs ext4 jfs xfs
swap swap
;; This is for the Hurd
ext2
;; These lack basic Unix features. Their only use ;; These lack basic Unix features. Their only use
;; on GNU is for interoperation, e.g., with UEFI. ;; on GNU is for interoperation, e.g., with UEFI.
fat32 fat16 ntfs) fat32 fat16 ntfs)
@ -767,7 +771,11 @@ (define (run-partitioning-page)
(define (run-page devices) (define (run-page devices)
(let* ((items (let* ((items
`((entire . ,(G_ "Guided - using the entire disk")) `((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")))) (manual . ,(G_ "Manual"))))
(result (run-listbox-selection-page (result (run-listbox-selection-page
#:info-text (G_ "Please select a partitioning method.") #: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 ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; 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 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2021 Leo Famulari <leo@famulari.name> ;;; 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 page)
#:use-module (gnu installer newt utils) #:use-module (gnu installer newt utils)
#:use-module (guix i18n) #:use-module (guix i18n)
#:use-module (guix utils)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (srfi srfi-35) #:use-module (srfi srfi-35)
#:export (run-services-page)) #:export (run-services-page))
@ -33,11 +34,13 @@ (define-module (gnu installer newt services)
(define (run-desktop-environments-cbt-page) (define (run-desktop-environments-cbt-page)
"Run a page allowing the user to choose between various desktop "Run a page allowing the user to choose between various desktop
environments." environments."
(let ((items (filter desktop-system-service? %system-services))) (let ((items (filter desktop-system-service? (%system-services))))
(run-checkbox-tree-page (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 \ 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") #:title (G_ "Desktop environment")
#:items items #:items items
#:selection (map system-service-recommended? 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." "Run a page allowing the user to select networking services."
(let ((items (filter (lambda (service) (let ((items (filter (lambda (service)
(eq? 'networking (system-service-type service))) (eq? 'networking (system-service-type service)))
%system-services))) (%system-services))))
(run-checkbox-tree-page (run-checkbox-tree-page
#:info-text (G_ "You can now select networking services to run on your \ #:info-text (G_ "You can now select networking services to run on your \
system.") system.")
@ -69,7 +72,7 @@ (define (run-printing-services-cbt-page)
(let ((items (filter (lambda (service) (let ((items (filter (lambda (service)
(eq? 'document (eq? 'document
(system-service-type service))) (system-service-type service)))
%system-services))) (%system-services))))
(run-checkbox-tree-page (run-checkbox-tree-page
#:info-text (G_ "You can now select the CUPS printing service to run on your \ #:info-text (G_ "You can now select the CUPS printing service to run on your \
system.") system.")
@ -88,7 +91,7 @@ (define (run-console-services-cbt-page)
(let ((items (filter (lambda (service) (let ((items (filter (lambda (service)
(eq? 'administration (eq? 'administration
(system-service-type service))) (system-service-type service)))
%system-services))) (%system-services))))
(run-checkbox-tree-page (run-checkbox-tree-page
#:title (G_ "Console services") #:title (G_ "Console services")
#:info-text (G_ "Select miscellaneous services to run on your \ #: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) (define (run-network-management-page)
"Run a page to select among several network management methods." "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 (run-listbox-selection-page
#:title title #:title title
#:info-text (G_ "Choose the method to manage network connections. #: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.") client may be enough for a server.")
#:info-textbox-width 70 #:info-textbox-width 70
#:listbox-height 7 #:listbox-height 7
#:listbox-items (filter (lambda (service) #:listbox-items `(,@items
(eq? 'network-management ,@(if (target-hurd?)
(system-service-type service))) (list system-service-none)
%system-services) '()))
#:listbox-item->text (compose G_ system-service-name) #:listbox-item->text (compose G_ system-service-name)
#:sort-listbox-items? #f #:sort-listbox-items? #f
#:button-text (G_ "Exit") #:button-text (G_ "Exit")

61
gnu/installer/parted.scm
View file

@ -152,7 +152,7 @@ (define-record-type* <user-partition>
(crypt-password user-partition-crypt-password ; <secret> (crypt-password user-partition-crypt-password ; <secret>
(default #f)) (default #f))
(fs-type user-partition-fs-type (fs-type user-partition-fs-type
(default 'ext4)) (default (if (target-hurd?) 'ext2 'ext4)))
(bootable? user-partition-bootable? (bootable? user-partition-bootable?
(default #f)) (default #f))
(esp? user-partition-esp? (esp? user-partition-esp?
@ -223,11 +223,13 @@ (define default-esp-mount-point
(define (efi-installation?) (define (efi-installation?)
"Return #t if an EFI installation should be performed, #f otherwise." "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) (define (user-fs-type-name fs-type)
"Return the name of FS-TYPE as specified by libparted." "Return the name of FS-TYPE as specified by libparted."
(case fs-type (case fs-type
((ext2) "ext2")
((ext4) "ext4") ((ext4) "ext4")
((btrfs) "btrfs") ((btrfs) "btrfs")
((fat16) "fat16") ((fat16) "fat16")
@ -240,6 +242,7 @@ (define (user-fs-type-name fs-type)
(define (user-fs-type->mount-type fs-type) (define (user-fs-type->mount-type fs-type)
"Return the mount type of FS-TYPE." "Return the mount type of FS-TYPE."
(case fs-type (case fs-type
((ext2) "ext2")
((ext4) "ext4") ((ext4) "ext4")
((btrfs) "btrfs") ((btrfs) "btrfs")
((fat16) "vfat") ((fat16) "vfat")
@ -255,6 +258,7 @@ (define (partition-filesystem-user-type partition)
(and fs-type (and fs-type
(let ((name (filesystem-type-name fs-type))) (let ((name (filesystem-type-name fs-type)))
(cond (cond
((string=? name "ext2") 'ext2)
((string=? name "ext4") 'ext4) ((string=? name "ext4") 'ext4)
((string=? name "btrfs") 'btrfs) ((string=? name "btrfs") 'btrfs)
((string=? name "fat16") 'fat16) ((string=? name "fat16") 'fat16)
@ -296,7 +300,7 @@ (define (partition->user-partition partition)
(file-name (partition-get-path partition)) (file-name (partition-get-path partition))
(disk-file-name (device-path device)) (disk-file-name (device-path device))
(fs-type (or (partition-filesystem-user-type partition) (fs-type (or (partition-filesystem-user-type partition)
'ext4)) (if (target-hurd?) 'ext2 'ext4)))
(mount-point (and (esp-partition? partition) (mount-point (and (esp-partition? partition)
(default-esp-mount-point))) (default-esp-mount-point)))
(bootable? (boot-partition? partition)) (bootable? (boot-partition? partition))
@ -1045,18 +1049,20 @@ (define* (auto-partition! disk
non-boot-partitions) non-boot-partitions)
(let* ((start-partition (let* ((start-partition
(if (efi-installation?) (cond ((target-hurd?) #f)
((efi-installation?)
(and (not esp-partition) (and (not esp-partition)
(user-partition (user-partition
(fs-type 'fat32) (fs-type 'fat32)
(esp? #t) (esp? #t)
(size new-esp-size) (size new-esp-size)
(mount-point (default-esp-mount-point)))) (mount-point (default-esp-mount-point)))))
(else
(user-partition (user-partition
(fs-type 'ext4) (fs-type 'ext4)
(bootable? #t) (bootable? #t)
(bios-grub? #t) (bios-grub? #t)
(size bios-grub-size)))) (size bios-grub-size)))))
(new-partitions (new-partitions
(cond (cond
((or (eq? scheme 'entire-root) ((or (eq? scheme 'entire-root)
@ -1065,13 +1071,13 @@ (define* (auto-partition! disk
`(,@(if start-partition `(,@(if start-partition
`(,start-partition) `(,start-partition)
'()) '())
,@(if encrypted? ,@(if (or encrypted? (target-hurd?))
'() '()
`(,(user-partition `(,(user-partition
(fs-type 'swap) (fs-type 'swap)
(size swap-size)))) (size swap-size))))
,(user-partition ,(user-partition
(fs-type 'ext4) (fs-type (if (target-hurd?) 'ext2 'ext4))
(bootable? has-extended?) (bootable? has-extended?)
(crypt-label (and encrypted? "cryptroot")) (crypt-label (and encrypted? "cryptroot"))
(size "100%") (size "100%")
@ -1083,7 +1089,7 @@ (define* (auto-partition! disk
`(,start-partition) `(,start-partition)
'()) '())
,(user-partition ,(user-partition
(fs-type 'ext4) (fs-type (if (target-hurd?) 'ext2 'ext4))
(bootable? has-extended?) (bootable? has-extended?)
(crypt-label (and encrypted? "cryptroot")) (crypt-label (and encrypted? "cryptroot"))
(size "33%") (size "33%")
@ -1105,7 +1111,7 @@ (define* (auto-partition! disk
(type (if has-extended? (type (if has-extended?
'logical 'logical
'normal)) 'normal))
(fs-type 'ext4) (fs-type (if (target-hurd?) 'ext2 'ext4))
(crypt-label (and encrypted? "crypthome")) (crypt-label (and encrypted? "crypthome"))
(size "100%") (size "100%")
(mount-point "/home"))))))) (mount-point "/home")))))))
@ -1186,6 +1192,15 @@ (define (create-btrfs-file-system partition)
"Create a btrfs file-system for PARTITION file-name." "Create a btrfs file-system for PARTITION file-name."
((%run-command-in-installer) "mkfs.btrfs" "-f" partition)) ((%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) (define (create-ext4-file-system partition)
"Create an ext4 file-system for PARTITION file-name." "Create an ext4 file-system for PARTITION file-name."
;; Enable the 'large_dir' feature so users can have a store of several TiBs. ;; 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? (and need-formatting?
(not (eq? type 'extended)) (not (eq? type 'extended))
(create-btrfs-file-system file-name))) (create-btrfs-file-system file-name)))
((ext2)
(and need-formatting?
(not (eq? type 'extended))
(create-ext2-file-system file-name)))
((ext4) ((ext4)
(and need-formatting? (and need-formatting?
(not (eq? type 'extended)) (not (eq? type 'extended))
@ -1463,7 +1482,11 @@ (define (bootloader-configuration user-partitions)
"Return the bootloader configuration field for USER-PARTITIONS." "Return the bootloader configuration field for USER-PARTITIONS."
(let ((root-partition (find root-user-partition? user-partitions))) (let ((root-partition (find root-user-partition? user-partitions)))
(match 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 (let ((root-partition-disk (user-partition-disk-file-name
root-partition))) root-partition)))
@ -1471,7 +1494,9 @@ (define (bootloader-configuration user-partitions)
,@(if (efi-installation?) ,@(if (efi-installation?)
`((bootloader grub-efi-bootloader) `((bootloader grub-efi-bootloader)
(targets (list ,(default-esp-mount-point)))) (targets (list ,(default-esp-mount-point))))
`((bootloader grub-bootloader) `((bootloader ,(if (target-hurd?)
'grub-minimal-bootloader
'grub-bootloader))
(targets (list ,root-partition-disk)))) (targets (list ,root-partition-disk))))
;; XXX: Assume we defined the 'keyboard-layout' field of ;; XXX: Assume we defined the 'keyboard-layout' field of
@ -1491,22 +1516,28 @@ (define (user-partition-missing-modules user-partitions)
(const '()))) (const '())))
(delete-duplicates (delete-duplicates
(map user-partition-file-name (map user-partition-file-name
(cons root devices))))))) (filter identity
(cons root devices))))))))
(define (initrd-configuration user-partitions) (define (initrd-configuration user-partitions)
"Return an 'initrd-modules' field with everything needed for "Return an 'initrd-modules' field with everything needed for
USER-PARTITIONS, or return nothing." USER-PARTITIONS, or return nothing."
(if (target-hurd?)
'((initrd #f)
(initrd-modules '()))
(match (user-partition-missing-modules user-partitions) (match (user-partition-missing-modules user-partitions)
(() (()
'()) '())
((modules ...) ((modules ...)
`((initrd-modules (append ',modules `((initrd-modules (append ',modules
%base-initrd-modules)))))) %base-initrd-modules)))))))
(define (user-partitions->configuration user-partitions) (define (user-partitions->configuration user-partitions)
"Return the configuration field for USER-PARTITIONS." "Return the configuration field for USER-PARTITIONS."
(let* ((swap-user-partitions (find-swap-user-partitions 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 (encrypted-partitions
(filter user-partition-crypt-label user-partitions))) (filter user-partition-crypt-label user-partitions)))
`((bootloader ,@(bootloader-configuration 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
installer-exit-error installer-exit-error
installer-final-page installer-final-page
installer-kernel-page
installer-keymap-page installer-keymap-page
installer-locale-page installer-locale-page
installer-menu-page installer-menu-page
@ -69,6 +70,8 @@ (define-record-type* <installer>
(exit-error installer-exit-error) (exit-error installer-exit-error)
;; procedure void -> void ;; procedure void -> void
(final-page installer-final-page) (final-page installer-final-page)
;; procedure void -> void
(kernel-page installer-kernel-page)
;; procedure (layouts context) -> (list layout variant options) ;; procedure (layouts context) -> (list layout variant options)
(keymap-page installer-keymap-page) (keymap-page installer-keymap-page)
;; procedure: (#:key supported-locales iso639-languages iso3166-territories) ;; 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 ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2022 Ludovic Courtès <ludo@gnu.org> ;;; 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 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2021 Leo Famulari <leo@famulari.name> ;;; Copyright © 2021 Leo Famulari <leo@famulari.name>
;;; Copyright © 2023 Denys Nykula <vegan@libre.net.ua> ;;; Copyright © 2023 Denys Nykula <vegan@libre.net.ua>
@ -24,6 +24,7 @@
(define-module (gnu installer services) (define-module (gnu installer services)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix read-print) #:use-module (guix read-print)
#:use-module (guix utils)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:export (system-service? #:export (system-service?
@ -34,6 +35,7 @@ (define-module (gnu installer services)
system-service-packages system-service-packages
desktop-system-service? desktop-system-service?
system-service-none
%system-services %system-services
system-services->configuration)) system-services->configuration))
@ -55,7 +57,13 @@ (define-record-type* <system-service>
(packages system-service-packages ;list of sexps (packages system-service-packages ;list of sexps
(default '()))) (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 () (let-syntax ((desktop-environment (syntax-rules ()
((_ fields ...) ((_ fields ...)
(system-service (system-service
@ -105,7 +113,11 @@ (define %system-services
(G_ "\ (G_ "\
;; To configure OpenSSH, pass an 'openssh-configuration' ;; To configure OpenSSH, pass an 'openssh-configuration'
;; record as a second argument to 'service' below.\n")) ;; 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 (system-service
(name (G_ "Tor anonymous network router")) (name (G_ "Tor anonymous network router"))
(type 'networking) (type 'networking)
@ -115,7 +127,7 @@ (define %system-services
(system-service (system-service
(name (G_ "Network time service (NTP), to set the clock automatically")) (name (G_ "Network time service (NTP), to set the clock automatically"))
(type 'administration) (type 'administration)
(recommended? #t) (recommended? (not (target-hurd?)))
(snippet '((service ntp-service-type)))) (snippet '((service ntp-service-type))))
(system-service (system-service
(name (G_ "GPM mouse daemon, to use the mouse on the console")) (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)) (packages (append-map system-service-packages services))
(desktop? (find desktop-system-service? services)) (desktop? (find desktop-system-service? services))
(base (if desktop? (base (if desktop?
'%desktop-services (if (target-hurd?)
'%base-services)) '%desktop-services/hurd
'%desktop-services)
(if (target-hurd?)
'%base-services/hurd
'%base-services)))
(native-console-font (match (getenv "LANGUAGE") (native-console-font (match (getenv "LANGUAGE")
((or "be" "bg" "el" "eo" "kk" "ky" ((or "be" "bg" "el" "eo" "kk" "ky"
"mk" "mn" "ru" "sr" "tg" "uk") "mk" "mn" "ru" "sr" "tg" "uk")
@ -181,18 +197,28 @@ (define (system-services->configuration services)
(if (null? snippets) (if (null? snippets)
`(,@(if (null? packages) `(,@(if (null? packages)
'() (if (target-hurd?)
`(,@package-heading
(packages %base-packages/hurd))
'())
`(,@package-heading `(,@package-heading
(packages (append (list ,@packages) (packages (append (list ,@packages)
%base-packages)))) ,(if (target-hurd?)
'%base-packages/hurd
'%base-packages)))))
,@service-heading ,@service-heading
(services ,services)) (services ,services))
`(,@(if (null? packages) `(,@(if (null? packages)
'() (if (target-hurd?)
`(,@package-heading
(packages %base-packages/hurd))
'())
`(,@package-heading `(,@package-heading
(packages (append (list ,@packages) (packages (append (list ,@packages)
%base-packages)))) ,(if (target-hurd?)
'%base-packages/hurd
'%base-packages)))))
,@service-heading ,@service-heading
(services (append (list ,@snippets (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 build utils)
#:use-module (guix i18n) #:use-module (guix i18n)
#:use-module (guix read-print) #:use-module (guix read-print)
#:use-module (guix utils)
#:use-module (gnu installer utils) #:use-module (gnu installer utils)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -240,17 +241,20 @@ (define (format-configuration steps results)
,(comment (G_ "\ ,(comment (G_ "\
;; Indicate which modules to import to access the variables ;; Indicate which modules to import to access the variables
;; used in this configuration.\n")) ;; 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)))) (use-service-modules cups desktop networking ssh xorg))))
`(,@modules `(,@modules
,(vertical-space 1) ,(vertical-space 1)
(operating-system ,@configuration)))) (operating-system ,@configuration))))
(define* (configuration->file configuration (define* (configuration->file configuration
#:key (filename (%installer-configuration-file))) #:key (file-name (%installer-configuration-file)))
"Write the given CONFIGURATION to FILENAME." "Write the given CONFIGURATION to FILE-NAME."
(mkdir-p (dirname filename)) (mkdir-p (dirname file-name))
(call-with-output-file filename (call-with-output-file file-name
(lambda (port) (lambda (port)
;; TRANSLATORS: This is a comment within a Scheme file. Each line must ;; TRANSLATORS: This is a comment within a Scheme file. Each line must
;; start with ";; " (two semicolons and a space). Please keep line ;; 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 ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -35,6 +36,7 @@ (define-module (gnu installer tests)
choose-locale+keyboard choose-locale+keyboard
enter-host-name+passwords enter-host-name+passwords
choose-kernel
choose-services choose-services
choose-partitioning choose-partitioning
start-installation start-installation
@ -211,6 +213,15 @@ (define* (enter-host-name+passwords port
(password ,password))) (password ,password)))
names passwords)))))) 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 (define* (choose-services port
#:key #:key
(choose-desktop-environment? (const #f)) (choose-desktop-environment? (const #f))

2
gnu/local.mk
View file

@ -864,6 +864,7 @@ INSTALLER_MODULES = \
%D%/installer/final.scm \ %D%/installer/final.scm \
%D%/installer/hardware.scm \ %D%/installer/hardware.scm \
%D%/installer/hostname.scm \ %D%/installer/hostname.scm \
%D%/installer/kernel.scm \
%D%/installer/keymap.scm \ %D%/installer/keymap.scm \
%D%/installer/locale.scm \ %D%/installer/locale.scm \
%D%/installer/newt.scm \ %D%/installer/newt.scm \
@ -882,6 +883,7 @@ INSTALLER_MODULES = \
%D%/installer/newt/final.scm \ %D%/installer/newt/final.scm \
%D%/installer/newt/parameters.scm \ %D%/installer/newt/parameters.scm \
%D%/installer/newt/hostname.scm \ %D%/installer/newt/hostname.scm \
%D%/installer/newt/kernel.scm \
%D%/installer/newt/keymap.scm \ %D%/installer/newt/keymap.scm \
%D%/installer/newt/locale.scm \ %D%/installer/newt/locale.scm \
%D%/installer/newt/menu.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 #:export (%base-packages/hurd
%base-services/hurd %base-services/hurd
%base-services+qemu-networking/hurd %base-services+qemu-networking/hurd
%desktop-services/hurd
%hurd-default-operating-system %hurd-default-operating-system
%hurd-default-operating-system-kernel %hurd-default-operating-system-kernel
%setuid-programs/hurd)) %setuid-programs/hurd))
@ -107,6 +108,8 @@ (define %base-services+qemu-networking/hurd
%qemu-static-networking)) %qemu-static-networking))
%base-services/hurd)) %base-services/hurd))
(define %desktop-services/hurd %base-services/hurd)
(define %setuid-programs/hurd (define %setuid-programs/hurd
;; Default set of setuid-root programs. ;; Default set of setuid-root programs.
(map file-like->setuid-program (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 © 2017, 2019, 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org> ;;; 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> ;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -1869,6 +1869,10 @@ (define-syntax-rule (marionette-eval* exp marionette)
#$marionette) #$marionette)
(screenshot "installer-services.ppm") (screenshot "installer-services.ppm")
(when #$(target-x86?)
(marionette-eval* '(choose-kernel installer-socket) #$marionette)
(screenshot "installer-kernel.ppm"))
(marionette-eval* '(choose-services installer-socket (marionette-eval* '(choose-services installer-socket
#:choose-desktop-environment? #:choose-desktop-environment?
(const #$desktop?) (const #$desktop?)