From: Janneke Nieuwenhuizen <janneke@gnu.org>
To: 73927@debbugs.gnu.org
Cc: "Josselin Poiret" <dev@jpoiret.xyz>,
"Ludovic Courtès" <ludo@gnu.org>,
"Mathieu Othacehe" <othacehe@gnu.org>
Subject: [bug#73927] [PATCH 14/16] installer: Add "Kernel" page to select the Hurd.
Date: Mon, 21 Oct 2024 10:17:10 +0200 [thread overview]
Message-ID: <ab12f68704ce3983a6d5c1888e1cc2aeaa2c8867.1729494414.git.janneke@gnu.org> (raw)
In-Reply-To: <cover.1729494414.git.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-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 (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.
Change-Id: Ifafb27b8a2f933944c77223a27ec151757237e36
* gnu/installer/services.scm (%system-services):
Change-Id: I15d535a7a8a917e5f3492f8c01d922d652c32ee5
geert none
Change-Id: Ib6c5665638018f59a2690f603fad0702e042fb8b
Change-Id: I01b854390240be60ce9fef8c9510a90bc6843ef3
geert
Change-Id: Ibb7205443969fc92d4fe62d4dfb4f956d03229b9
---
gnu/installer.scm | 14 ++++++++
gnu/installer/final.scm | 10 ++++--
gnu/installer/kernel.scm | 34 ++++++++++++++++++
gnu/installer/newt.scm | 5 +++
gnu/installer/newt/kernel.scm | 45 +++++++++++++++++++++++
gnu/installer/newt/partition.scm | 9 ++++-
gnu/installer/newt/services.scm | 31 +++++++++-------
gnu/installer/parted.scm | 62 +++++++++++++++++++++++---------
gnu/installer/record.scm | 3 ++
gnu/installer/services.scm | 46 ++++++++++++++++++------
gnu/installer/steps.scm | 14 +++++---
gnu/local.mk | 2 ++
gnu/system/hurd.scm | 3 ++
13 files changed, 231 insertions(+), 47 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..64f6273c55 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -281,6 +281,18 @@ (define* (installer-steps #:key dry-run?)
((installer-hostname-page current-installer))))
(configuration-formatter hostname->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?))))
+
;; Provide an interface above connmanctl, so that the user can select
;; a network susceptible to acces Internet.
(installer-step
@@ -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..5fcf223315 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,12 @@ (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"
+ "--skip-checks")
+ '()))
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..059659ec75
--- /dev/null
+++ b/gnu/installer/kernel.scm
@@ -0,0 +1,34 @@
+;;; 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)
+ #:export (kernel->configuration))
+
+(define (kernel->configuration kernel dry-run?)
+ (if (equal? kernel "Hurd")
+ `((kernel %hurd-default-operating-system-kernel)
+ (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..b88393405b 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)
@@ -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.")
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..e9a0cc36d0 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?
@@ -228,6 +228,7 @@ (define (efi-installation?)
(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 +241,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 +257,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 +299,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 +1056,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 +1068,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 +1086,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 +1108,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 +1189,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 +1303,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 +1479,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 +1491,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 +1513,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/local.mk b/gnu/local.mk
index 6d0c20f5be..8d35272bc8 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -859,6 +859,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 \
@@ -877,6 +878,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
--
2.46.0
next prev parent reply other threads:[~2024-10-21 8:19 UTC|newest]
Thread overview: 24+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-10-21 8:13 [bug#73927] [PATCH 00/16] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
2024-10-21 8:16 ` [bug#73927] [PATCH 01/16] system: hurd: Remove qemu networking from %base-services/hurd Janneke Nieuwenhuizen
2024-10-21 8:16 ` [bug#73927] [PATCH 02/16] gnu: hurd: Support system init in /libexec/runsystem Janneke Nieuwenhuizen
2024-10-21 8:16 ` [bug#73927] [PATCH 03/16] hurd-boot: Support system init: Create essential device nodes Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 04/16] system: hurd: Add swap-services to hurd-default-essential-services Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 05/16] gnu: hurd: Support second boot Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 06/16] hurd-boot: " Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 07/16] maint: Add installer dependencies to the manifest Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 08/16] installer: Remove unused (newt) imports Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 09/16] installer: Align comments Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 10/16] installer: Use "partitioning-page" consistently Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 11/16] installer: Fix file-name typos Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 12/16] installer: Use `%' for parameter %run-command-in-installer Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 13/16] installer: Add dry-run? Janneke Nieuwenhuizen
2024-10-21 8:17 ` Janneke Nieuwenhuizen [this message]
2024-10-21 18:14 ` [bug#73927] [PATCH 14/16] installer: Add "Kernel" page to select the Hurd Mathieu Othacehe
2024-10-22 8:53 ` janneke
2024-10-22 14:34 ` janneke
2024-10-22 18:06 ` Mathieu Othacehe
2024-10-22 19:18 ` [bug#73927] [PATCH v2 " janneke
2024-10-21 8:17 ` [bug#73927] [PATCH 15/16] installer: Add static-networking template Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 16/16] DRAFT installer: Support dry-run from Guile via store Janneke Nieuwenhuizen
2024-10-21 18:18 ` Mathieu Othacehe
2024-10-22 8:21 ` janneke
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=ab12f68704ce3983a6d5c1888e1cc2aeaa2c8867.1729494414.git.janneke@gnu.org \
--to=janneke@gnu.org \
--cc=73927@debbugs.gnu.org \
--cc=dev@jpoiret.xyz \
--cc=ludo@gnu.org \
--cc=othacehe@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).