* [bug#73927] [PATCH 00/16] Installer support for (cross) installing the Hurd.
@ 2024-10-21 8:13 Janneke Nieuwenhuizen
2024-10-21 8:16 ` [bug#73927] [PATCH 01/16] system: hurd: Remove qemu networking from %base-services/hurd Janneke Nieuwenhuizen
` (17 more replies)
0 siblings, 18 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-21 8:13 UTC (permalink / raw)
To: 73927
Cc: othacehe, ludo, dev, Josselin Poiret, Ludovic Courtès,
Mathieu Othacehe
Hi!
This patch set adds initial support for installing and running the Hurd on
real iron. Writing a draft blog post on all the Hurd work that we've done
last year and describing the clumsy way to install a Hurd system inspired me
to have another look at the installer.
I've dusted off some old patches to fix booting a Hurd installation more than
once, then there's some preliminary (installer) work and then it adds a
"Kernel" selection page where you can optionally select "Hurd" next to the
default "Linux Libre".
If you select "Hurd", some defaults are changed such as using an ext2 file
system, some options are disabled such as creating an encrypted partition or a
swap partition, and some menus have a warning about availability of packages.
Finally a fully functional "config.scm" is created for installing the Hurd.
It is using the regular GNU/Linux installer for now and the Hurd system is
being cross installed. It might be nice to have a Hurd based installer image
some time, maybe when we have better networking support (rumpnet? ;).
I've updated the `hurd-team' branch with this patch set. To build the
installer, do something like
--8<---------------cut here---------------start------------->8---
./pre-inst-env guix system image -t iso9660 gnu/system/install.scm
or
./pre-inst-env guix system image -t iso9660 --system=i686-linux gnu/system/install.scm
--8<---------------cut here---------------end--------------->8---
(note that the 32bit version using linux-libre-6.10.13 panics for me, I've had
success with linux-libre-5.15 (see <https://git.savannah.gnu.org/cgit/guix.git/commit/?id=80f8ef0a01f2cf39deebfecc344e5f04d87d4bd4>).
The last, but not unimportant feature, are patches to run the installer in
dry-run mode and especially to run it directly from Guile, i.e., without
building the (current-guix) guix derivation for the `hurd-team' branch and
whatnot.
To run the installer (semi-) directly, do something like:
--8<---------------cut here---------------start------------->8---
/pre-inst-env guile -c '((@ (gnu installer) run-installer) #:dry-run? #t)'
or
sudo -E ./pre-inst-env guile -c '((@ (gnu installer) run-installer))'
--8<---------------cut here---------------end--------------->8---
BE VERY CAREFUL WHEN NOT USING #:DRY-RUN #T!
It feels a bit clumsy because it still builds a lightweight installer script
in the store. We could avoid going via the store and factor-out the gexp'ed
installer steps list from the `installer-steps' procedure. This is
problematic because it then needs (newt), (parted), and (webutils) modules to
build the installer OS. We could just add guile-newt, guile-parted,
guile-webutils to the guix package's dependencies but I figured, also from how
the installer was written, that we really don't want this.
I also tried using #:autoload (see
<https://git.savannah.gnu.org/cgit/guix.git/commit/?id=841b0f00afcc57442e348cdec7ca4fcae8372afb>),
but #:autoload seems to fail on record predicates like `disk?'
--8<---------------cut here---------------start------------->8---
Wrong type to apply (#<syntax-transformer disk?>).
--8<---------------cut here---------------end--------------->8---
and also tried adding an extra indirection
(see <https://git.savannah.gnu.org/cgit/guix.git/commit/?id=29a65fa3d251fe1cffea6db5231a0eb7c339987b>)
in the hope to avoid having to use #:autoload for (parted), but as yet to no
avail.
Greetings,
Janneke
Janneke Nieuwenhuizen (16):
system: hurd: Remove qemu networking from %base-services/hurd.
gnu: hurd: Support system init in /libexec/runsystem.
hurd-boot: Support system init: Create essential device nodes.
system: hurd: Add swap-services to hurd-default-essential-services.
gnu: hurd: Support second boot.
hurd-boot: Support second boot.
maint: Add installer dependencies to the manifest.
installer: Remove unused (newt) imports.
installer: Align comments.
installer: Use "partitioning-page" consistently.
installer: Fix file-name typos.
installer: Use `%' for parameter %run-command-in-installer.
installer: Add dry-run?
installer: Add "Kernel" page to select the Hurd.
installer: Add static-networking template.
DRAFT installer: Support dry-run from Guile via store.
gnu/build/hurd-boot.scm | 35 ++--
gnu/installer.scm | 206 ++++++++++++++++++------
gnu/installer/final.scm | 10 +-
gnu/installer/kernel.scm | 34 ++++
gnu/installer/newt.scm | 24 ++-
gnu/installer/newt/ethernet.scm | 1 -
gnu/installer/newt/final.scm | 20 ++-
gnu/installer/newt/kernel.scm | 45 ++++++
gnu/installer/newt/keymap.scm | 6 +-
gnu/installer/newt/locale.scm | 7 +-
gnu/installer/newt/page.scm | 7 +-
gnu/installer/newt/parameters.scm | 1 -
gnu/installer/newt/partition.scm | 10 +-
gnu/installer/newt/services.scm | 32 ++--
gnu/installer/parted.scm | 114 ++++++++-----
gnu/installer/record.scm | 8 +-
gnu/installer/services.scm | 68 ++++++--
gnu/installer/steps.scm | 30 ++--
gnu/installer/utils.scm | 17 +-
gnu/local.mk | 3 +
gnu/packages/hurd.scm | 8 +-
gnu/packages/patches/hurd-startup.patch | 82 ++++++++++
gnu/services/base.scm | 20 ++-
gnu/services/virtualization.scm | 4 +-
gnu/system.scm | 13 +-
gnu/system/examples/bare-hurd.tmpl | 10 +-
gnu/system/hurd.scm | 26 +--
gnu/system/images/hurd.scm | 2 +-
manifest.scm | 7 +-
29 files changed, 661 insertions(+), 189 deletions(-)
create mode 100644 gnu/installer/kernel.scm
create mode 100644 gnu/installer/newt/kernel.scm
create mode 100644 gnu/packages/patches/hurd-startup.patch
base-commit: aaa12db63270c487e3be1963b0fdfe93fdb2544d
--
2.46.0
^ permalink raw reply [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 01/16] system: hurd: Remove qemu networking from %base-services/hurd.
2024-10-21 8:13 [bug#73927] [PATCH 00/16] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
@ 2024-10-21 8:16 ` Janneke Nieuwenhuizen
2024-10-21 8:16 ` [bug#73927] [PATCH 02/16] gnu: hurd: Support system init in /libexec/runsystem Janneke Nieuwenhuizen
` (16 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-21 8:16 UTC (permalink / raw)
To: 73927
This allows us to use %base-services/hurd for services in a Hurd config for a
real machine without removing static-networking.
* gnu/system/hurd.scm (%base-services/hurd): Factor networking out to...
(%base-services+qemu-networking/hurd): ..this new variable.
* gnu/system/examples/bare-hurd.tmpl (%hurd-os): Use it.
* gnu/services/virtualization.scm (%hurd-vm-operating-system): Use it.
* gnu/system/images/hurd.scm (hurd-barebones-os): Use it. Add comment about
QEMU and networking for a real machine.
Change-Id: I777a63410383b9bf8b5740e4513dbc1e9fb0fd41
---
gnu/services/virtualization.scm | 4 ++--
gnu/system/examples/bare-hurd.tmpl | 10 ++++++++--
gnu/system/hurd.scm | 23 ++++++++++++++---------
gnu/system/images/hurd.scm | 2 +-
4 files changed, 25 insertions(+), 14 deletions(-)
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index d87e494348..d33dfa6ca7 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com>
;;; Copyright © 2018, 2020-2024 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2020, 2021, 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2021, 2023, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Timotej Lazar <timotej.lazar@araneo.si>
;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2022 Leo Nikkilä <hello@lnikki.la>
@@ -1643,7 +1643,7 @@ (define %hurd-vm-operating-system
;; /etc/guix/acl file in the childhurd. Thus, clear
;; 'authorize-key?' so that it's not overridden at activation
;; time.
- (modify-services %base-services/hurd
+ (modify-services %base-services+qemu-networking/hurd
(guix-service-type config =>
(guix-configuration
(inherit config)
diff --git a/gnu/system/examples/bare-hurd.tmpl b/gnu/system/examples/bare-hurd.tmpl
index 463c7ee798..68c6d3c166 100644
--- a/gnu/system/examples/bare-hurd.tmpl
+++ b/gnu/system/examples/bare-hurd.tmpl
@@ -1,7 +1,7 @@
;; -*-scheme-*-
;; This is an operating system configuration template
-;; for a "bare bones" setup, with no X11 display server.
+;; for a "bare bones" QEMU setup, with no X11 display server.
;; To build a disk image for a virtual machine, do
;;
@@ -54,6 +54,12 @@
(permit-root-login #t)
(allow-empty-passwords? #t)
(password-authentication? #t)))
- %base-services/hurd))))
+ ;; For installing on a real (non-QEMU) machine, use:
+ ;; (static-networking-service-type
+ ;; (list %loopback-static-networking
+ ;; (static-networking
+ ;; ...)))
+ ;; %base-services/hurd
+ %base-services+qemu-networking/hurd))))
%hurd-os
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index 6d6a20cf57..283bae6f10 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020-2024 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2020, 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2023, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -47,6 +47,7 @@ (define-module (gnu system hurd)
#:use-module (gnu system vm)
#:export (%base-packages/hurd
%base-services/hurd
+ %base-services+qemu-networking/hurd
%hurd-default-operating-system
%hurd-default-operating-system-kernel
%setuid-programs/hurd))
@@ -79,14 +80,6 @@ (define %base-packages/hurd
(define %base-services/hurd
(append (list (service hurd-console-service-type
(hurd-console-configuration (hurd hurd)))
- (service static-networking-service-type
- (list %loopback-static-networking
-
- ;; QEMU user-mode networking. To get "eth0", you need
- ;; QEMU to emulate a device for which Mach has an
- ;; in-kernel driver, for instance with:
- ;; --device rtl8139,netdev=net0 --netdev user,id=net0
- %qemu-static-networking))
(service guix-service-type
(guix-configuration
(extra-options '("--disable-chroot"
@@ -102,6 +95,18 @@ (define %base-services/hurd
(tty (string-append "tty" (number->string n))))))
(iota 6 1))))
+(define %base-services+qemu-networking/hurd
+ (cons
+ (service static-networking-service-type
+ (list %loopback-static-networking
+
+ ;; QEMU user-mode networking. To get "eth0", you need
+ ;; QEMU to emulate a device for which Mach has an
+ ;; in-kernel driver, for instance with:
+ ;; --device rtl8139,netdev=net0 --netdev user,id=net0
+ %qemu-static-networking))
+ %base-services/hurd))
+
(define %setuid-programs/hurd
;; Default set of setuid-root programs.
(map file-like->setuid-program
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index 9b618f7dc6..01c422a54f 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -60,7 +60,7 @@ (define hurd-barebones-os
(permit-root-login #t)
(allow-empty-passwords? #t)
(password-authentication? #t)))
- %base-services/hurd))))
+ %base-services+qemu-networking/hurd))))
(define hurd-initialize-root-partition
#~(lambda* (#:rest args)
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 02/16] gnu: hurd: Support system init in /libexec/runsystem.
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 ` Janneke Nieuwenhuizen
2024-10-21 8:16 ` [bug#73927] [PATCH 03/16] hurd-boot: Support system init: Create essential device nodes Janneke Nieuwenhuizen
` (15 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-21 8:16 UTC (permalink / raw)
To: 73927
This is the first step to support booting after guix system init, which does
not create /servers.
* gnu/packages/hurd.scm (hurd)[arguments]: In stage create-runsystem, do not
assume /servers/socket/ exists, remove any existing /servers/socket/1.
Change-Id: Ib61af08dd7b9c5659c938697671f69908bb7e20f
---
gnu/packages/hurd.scm | 2 ++
1 file changed, 2 insertions(+)
diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm
index 3d2a37a1e2..e6ea920714 100644
--- a/gnu/packages/hurd.scm
+++ b/gnu/packages/hurd.scm
@@ -383,6 +383,8 @@ (define-public hurd
fsck --yes --force /
fsysopts / --writable
+mkdir -p /servers/socket
+rm -f /servers/socket/1
# Note: this /hurd/ gets substituted
settrans --create /servers/socket/1 /hurd/pflocal
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 03/16] hurd-boot: Support system init: Create essential device nodes.
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 ` Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 04/16] system: hurd: Add swap-services to hurd-default-essential-services Janneke Nieuwenhuizen
` (14 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-21 8:16 UTC (permalink / raw)
To: 73927
* gnu/build/hurd-boot.scm (make-hurd-device-nodes): Cater for existing
directories (dev, servers).
(set-hurd-device-translators): Remove /servers/socket/1, that is created by
libexec/console-run. Cater for nonexistent /dev/console.
(boot-hurd-system): Call make-hurd-device-nodes on initial run.
---
gnu/build/hurd-boot.scm | 14 ++++++++++----
1 file changed, 10 insertions(+), 4 deletions(-)
diff --git a/gnu/build/hurd-boot.scm b/gnu/build/hurd-boot.scm
index 4407284acb..daf4fb41ab 100644
--- a/gnu/build/hurd-boot.scm
+++ b/gnu/build/hurd-boot.scm
@@ -79,13 +79,13 @@ (define* (make-hurd-device-nodes #:optional (root "/"))
(define (scope dir)
(string-append root (if (string-suffix? "/" root) "" "/") dir))
- (mkdir (scope "dev"))
+ (mkdir-p (scope "dev"))
;; Don't create /dev/null etc just yet; the store
;; messes-up the permission bits.
;; Don't create /dev/console, /dev/vcs, etc.: they are created by
;; console-run on first boot.
- (mkdir (scope "servers"))
+ (mkdir-p (scope "servers"))
(for-each (lambda (file)
(call-with-output-file (scope (string-append "servers/" file))
(lambda (port)
@@ -100,7 +100,8 @@ (define* (make-hurd-device-nodes #:optional (root "/"))
"kill"
"suspend"))
- (mkdir (scope "servers/socket"))
+ (mkdir-p (scope "servers/socket"))
+
;; Don't create /servers/socket/1 & co: runsystem does that on first boot.
;; TODO: Set the 'gnu.translator' extended attribute for passive translator
@@ -279,7 +280,8 @@ (define* (set-hurd-device-translators #:optional (root "/"))
(for-each scope-set-translator servers)
(mkdir* "dev/vcs/1")
(mkdir* "dev/vcs/2")
- (rename-file (scope "dev/console") (scope "dev/console-"))
+ (when (file-exists? (scope "dev/console"))
+ (rename-file (scope "dev/console") (scope "dev/console-")))
(for-each scope-set-translator devices)
(false-if-EEXIST (symlink "/dev/random" (scope "dev/urandom")))
@@ -326,6 +328,10 @@ (define* (boot-hurd-system #:key (on-error 'debug))
(let ((hurd/hurd (readlink* (string-append system "/profile/hurd"))))
(symlink hurd/hurd "/hurd"))
+ (unless (file-exists? "/servers/startup")
+ (format #t "Creating essential device nodes...\n")
+ (make-hurd-device-nodes))
+
(format #t "Setting-up essential translators...\n")
(setenv "PATH" (string-append system "/profile/bin"))
(set-hurd-device-translators)
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 04/16] system: hurd: Add swap-services to hurd-default-essential-services.
2024-10-21 8:13 [bug#73927] [PATCH 00/16] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (2 preceding siblings ...)
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 ` Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 05/16] gnu: hurd: Support second boot Janneke Nieuwenhuizen
` (13 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-21 8:17 UTC (permalink / raw)
To: 73927
* gnu/services/base.scm (swap-service-type): Do not include 'udev' requirement
for the Hurd. Use system* with "swapon", "swapoff" for the Hurd.
* gnu/system.scm (hurd-default-essential-services): Add swap-services.
* gnu/services/base.scm (swap-service-type):
---
gnu/services/base.scm | 20 +++++++++++++-------
gnu/system.scm | 13 +++++++------
2 files changed, 20 insertions(+), 13 deletions(-)
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 819d063673..7c50bc45b1 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -43,6 +43,7 @@ (define-module (gnu services base)
#:autoload (guix diagnostics) (warning formatted-message &fix-hint)
#:autoload (guix i18n) (G_)
#:use-module (guix combinators)
+ #:use-module (guix utils)
#:use-module (gnu services)
#:use-module (gnu services admin)
#:use-module (gnu services shepherd)
@@ -2644,7 +2645,7 @@ (define swap-service-type
(with-imported-modules (source-module-closure '((gnu build file-systems)))
(shepherd-service
(provision (list (swap->shepherd-service-name swap)))
- (requirement `(udev ,@requirements))
+ (requirement `(,@(if (target-hurd?) '() '(udev)) ,@requirements))
(documentation "Enable the given swap space.")
(modules `((gnu build file-systems)
,@%default-modules))
@@ -2652,16 +2653,21 @@ (define swap-service-type
(let ((device #$device-lookup))
(and device
(begin
- (restart-on-EINTR (swapon device
- #$(if (swap-space? swap)
- (swap-space->flags-bit-mask
- swap)
- 0)))
+ #$(if (target-hurd?)
+ #~(system* "swapon" device)
+ #~(restart-on-EINTR
+ (swapon device
+ #$(if (swap-space? swap)
+ (swap-space->flags-bit-mask
+ swap)
+ 0))))
#t)))))
(stop #~(lambda _
(let ((device #$device-lookup))
(when device
- (restart-on-EINTR (swapoff device)))
+ #$(if (target-hurd?)
+ #~(system* "swapoff" device)
+ #~(restart-on-EINTR (swapoff device))))
#f)))
(respawn? #f))))
(description "Turn on the virtual memory swap area.")))
diff --git a/gnu/system.scm b/gnu/system.scm
index 44f93f91d1..187a72cbf5 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -843,11 +843,11 @@ (define (hurd-default-essential-services os)
(let ((host-name (operating-system-host-name os))
(hosts-file (%operating-system-hosts-file os))
(entries (operating-system-directory-base-entries os)))
- (list (service system-service-type entries)
- %boot-service
- %hurd-startup-service
- %activation-service
- (service shepherd-root-service-type)
+ (cons* (service system-service-type entries)
+ %boot-service
+ %hurd-startup-service
+ %activation-service
+ (service shepherd-root-service-type)
(service user-processes-service-type)
(account-service (append (operating-system-accounts os)
@@ -869,7 +869,8 @@ (define (hurd-default-essential-services os)
(service privileged-program-service-type
(append (operating-system-privileged-programs os)
(operating-system-setuid-programs os)))
- (service profile-service-type (operating-system-packages os)))))
+ (service profile-service-type (operating-system-packages os))
+ (swap-services os))))
(define* (operating-system-services os)
"Return all the services of OS, including \"essential\" services."
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 05/16] gnu: hurd: Support second boot.
2024-10-21 8:13 [bug#73927] [PATCH 00/16] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (3 preceding siblings ...)
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 ` Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 06/16] hurd-boot: " Janneke Nieuwenhuizen
` (12 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-21 8:17 UTC (permalink / raw)
To: 73927
This avoids hanging upon second boot and ensures a declarative /hurd and /dev.
* gnu/packages/patches/hurd-startup.patch: New file.
* gnu/local.mk (dist_patch_DATA): Add it.
* gnu/packages/hurd.scm (hurd): Use it.
[arguments]: In stage create-runsystem remove /dev/urandom.
Change-Id: Ifcca5562c297204735c35132820a32ca0f273677
---
gnu/local.mk | 1 +
gnu/packages/hurd.scm | 6 +-
gnu/packages/patches/hurd-startup.patch | 82 +++++++++++++++++++++++++
3 files changed, 88 insertions(+), 1 deletion(-)
create mode 100644 gnu/packages/patches/hurd-startup.patch
diff --git a/gnu/local.mk b/gnu/local.mk
index 5d1b316aa3..6d0c20f5be 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1538,6 +1538,7 @@ dist_patch_DATA = \
%D%/packages/patches/hubbub-sort-entities.patch \
%D%/packages/patches/hueplusplus-mbedtls.patch \
%D%/packages/patches/hurd-rumpdisk-no-hd.patch \
+ %D%/packages/patches/hurd-startup.patch \
%D%/packages/patches/hwloc-1-test-btrfs.patch \
%D%/packages/patches/i7z-gcc-10.patch \
%D%/packages/patches/icecat-makeicecat.patch \
diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm
index e6ea920714..9c1681f236 100644
--- a/gnu/packages/hurd.scm
+++ b/gnu/packages/hurd.scm
@@ -317,7 +317,8 @@ (define-public hurd
(name "hurd")
(source (origin
(inherit (package-source hurd-headers))
- (patches (search-patches "hurd-rumpdisk-no-hd.patch"))))
+ (patches (search-patches "hurd-rumpdisk-no-hd.patch"
+ "hurd-startup.patch"))))
(version (package-version hurd-headers))
(arguments
`(#:tests? #f ;no "check" target
@@ -388,6 +389,9 @@ (define-public hurd
# Note: this /hurd/ gets substituted
settrans --create /servers/socket/1 /hurd/pflocal
+# Upon second boot, (file-exists? /dev/null) in hurd-boot-system hangs unless:
+rm -f /dev/urandom
+
# parse multiboot arguments
for i in \"$@\"; do
case $i in
diff --git a/gnu/packages/patches/hurd-startup.patch b/gnu/packages/patches/hurd-startup.patch
new file mode 100644
index 0000000000..0b0dcc9537
--- /dev/null
+++ b/gnu/packages/patches/hurd-startup.patch
@@ -0,0 +1,82 @@
+This avoids hanging upon second boot and ensures a declarative /dev.
+
+Upstream status: Not presented upstream.
+
+From a15d281ea012ee360c45376e964d35f6292ac549 Mon Sep 17 00:00:00 2001
+From: Janneke Nieuwenhuizen <janneke@gnu.org>
+Date: Sat, 27 May 2023 17:28:22 +0200
+Subject: [PATCH] startup: Remove /hurd, /dev, create /servers.
+
+This avoids hanging upon second boot and ensures a declarative /hurd
+and /dev.
+
+* startup/startup.c (rm_r, create_servers): New functions.
+(main): Use them to remove /dev and create /servers. Remove /hurd
+symlink.
+---
+ startup/startup.c | 42 ++++++++++++++++++++++++++++++++++++++++++
+ 1 file changed, 42 insertions(+)
+
+diff --git a/startup/startup.c b/startup/startup.c
+index feb7d265..5f380194 100644
+--- a/startup/startup.c
++++ b/startup/startup.c
+@@ -732,6 +732,42 @@ parse_opt (int key, char *arg, struct argp_state *state)
+ return 0;
+ }
+
++#include <ftw.h>
++static int
++rm_r (char const *file_name)
++{
++ int callback (char const *file_name, struct stat64 const *stat_buffer,
++ int type_flag, struct FTW *ftw_buffer)
++ {
++ fprintf (stderr, "startup: removing: %s\n", file_name);
++ return remove (file_name);
++ }
++
++ return nftw64 (file_name, callback, 0, FTW_DEPTH | FTW_MOUNT | FTW_PHYS);
++}
++
++void
++create_servers (void)
++{
++ char const *servers[] = {
++ "/servers/startup",
++ "/servers/exec",
++ "/servers/proc",
++ "/servers/password",
++ "/servers/default-pager",
++ "/servers/crash-dump-core",
++ "/servers/kill",
++ "/servers/suspend",
++ 0,
++ };
++ mkdir ("/servers", 0755);
++ for (char const **p = servers; *p; p++)
++ open (*p, O_WRONLY | O_APPEND | O_CREAT, 0444);
++ mkdir ("/servers/socket", 0755);
++ mkdir ("/servers/bus", 0755);
++ mkdir ("/servers/bus/pci", 0755);
++}
++
+ int
+ main (int argc, char **argv, char **envp)
+ {
+@@ -741,6 +777,12 @@ main (int argc, char **argv, char **envp)
+ mach_port_t consdev;
+ struct argp argp = { options, parse_opt, 0, doc };
+
++ /* GNU Guix creates fresh ones in boot-hurd-system. */
++ unlink ("/hurd");
++ rm_r ("/dev");
++ mkdir ("/dev", 0755);
++ create_servers ();
++
+ /* Parse the arguments. We don't want the vector reordered, we
+ should pass on to our child the exact arguments we got and just
+ ignore any arguments that aren't flags for us. ARGP_NO_ERRS
+--
+2.40.1
+
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 06/16] hurd-boot: Support second boot.
2024-10-21 8:13 [bug#73927] [PATCH 00/16] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (4 preceding siblings ...)
2024-10-21 8:17 ` [bug#73927] [PATCH 05/16] gnu: hurd: Support second boot Janneke Nieuwenhuizen
@ 2024-10-21 8:17 ` Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 07/16] maint: Add installer dependencies to the manifest Janneke Nieuwenhuizen
` (11 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-21 8:17 UTC (permalink / raw)
To: 73927
* gnu/build/hurd-boot.scm (boot-hurd-system): Check for stale shepherd socket
and remove it. Be chattier about /hurd symlink replacement.
Change-Id: I5e528c131ebeadb7ebc9727336a0f9301af3e68e
---
gnu/build/hurd-boot.scm | 21 ++++++++++++++++-----
1 file changed, 16 insertions(+), 5 deletions(-)
diff --git a/gnu/build/hurd-boot.scm b/gnu/build/hurd-boot.scm
index daf4fb41ab..23ace25d4f 100644
--- a/gnu/build/hurd-boot.scm
+++ b/gnu/build/hurd-boot.scm
@@ -322,18 +322,29 @@ (define* (boot-hurd-system #:key (on-error 'debug))
(let* ((args (command-line))
(system (find-long-option "gnu.system" args))
- (to-load (find-long-option "gnu.load" args)))
+ (to-load (find-long-option "gnu.load" args))
+ (profile (string-append system "/profile"))
+ (bin (string-append profile "/bin"))
+ (sbin (string-append profile "/bin")))
- (false-if-exception (delete-file "/hurd"))
- (let ((hurd/hurd (readlink* (string-append system "/profile/hurd"))))
- (symlink hurd/hurd "/hurd"))
+ (setenv "PATH" (string-append bin ":" sbin))
+
+ (when (file-exists? "/var/run/shepherd/socket")
+ (format #t "Removing stale shepherd socket...\n")
+ (delete-file "/var/run/shepherd/socket"))
(unless (file-exists? "/servers/startup")
(format #t "Creating essential device nodes...\n")
(make-hurd-device-nodes))
+ (let ((profile/hurd (readlink* (string-append profile "/hurd"))))
+ (when (file-exists? "/hurd")
+ (format #t "Removing stale /hurd link\n")
+ (delete-file "/hurd"))
+ (format #t "Linking /hurd from ~a...\n" profile/hurd)
+ (symlink profile/hurd "/hurd"))
+
(format #t "Setting-up essential translators...\n")
- (setenv "PATH" (string-append system "/profile/bin"))
(set-hurd-device-translators)
(format #t "Starting pager...\n")
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 07/16] maint: Add installer dependencies to the manifest.
2024-10-21 8:13 [bug#73927] [PATCH 00/16] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (5 preceding siblings ...)
2024-10-21 8:17 ` [bug#73927] [PATCH 06/16] hurd-boot: " Janneke Nieuwenhuizen
@ 2024-10-21 8:17 ` Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 08/16] installer: Remove unused (newt) imports Janneke Nieuwenhuizen
` (10 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-21 8:17 UTC (permalink / raw)
To: 73927
* manifest.scm: Add guile-newt, guile-parted, guile-webutils.
Change-Id: Idcf46320d29c15f36da05f66e81b7779e37c1bf6
---
manifest.scm | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
diff --git a/manifest.scm b/manifest.scm
index 27e1d62566..ccd6268461 100644
--- a/manifest.scm
+++ b/manifest.scm
@@ -51,4 +51,9 @@
"mumi"
"nss-certs"
"openssl" ;required if using 'smtpEncryption = tls'
- "patman"))))
+ "patman"))
+ ;; For installer
+ (specifications->manifest
+ (list "guile-newt"
+ "guile-parted"
+ "guile-webutils"))))
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 08/16] installer: Remove unused (newt) imports.
2024-10-21 8:13 [bug#73927] [PATCH 00/16] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (6 preceding siblings ...)
2024-10-21 8:17 ` [bug#73927] [PATCH 07/16] maint: Add installer dependencies to the manifest Janneke Nieuwenhuizen
@ 2024-10-21 8:17 ` Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 09/16] installer: Align comments Janneke Nieuwenhuizen
` (9 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-21 8:17 UTC (permalink / raw)
To: 73927; +Cc: Josselin Poiret, Ludovic Courtès, Mathieu Othacehe
* gnu/installer/newt/ethernet.scm,
gnu/installer/newt/keymap.scm,
gnu/installer/newt/locale.scm,
gnu/installer/newt/parameters.scm,
gnu/installer/newt/services.scm: Remove (newt).
Change-Id: Ia6624aaf73491024da54b8ffee7358941b187fdf
---
gnu/installer/newt/ethernet.scm | 1 -
gnu/installer/newt/keymap.scm | 1 -
gnu/installer/newt/locale.scm | 1 -
gnu/installer/newt/parameters.scm | 1 -
gnu/installer/newt/services.scm | 1 -
5 files changed, 5 deletions(-)
diff --git a/gnu/installer/newt/ethernet.scm b/gnu/installer/newt/ethernet.scm
index d75a640519..53e440fd60 100644
--- a/gnu/installer/newt/ethernet.scm
+++ b/gnu/installer/newt/ethernet.scm
@@ -27,7 +27,6 @@ (define-module (gnu installer newt ethernet)
#:use-module (ice-9 match)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
- #:use-module (newt)
#:export (run-ethernet-page))
(define (ethernet-services)
diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm
index c5d4be6792..109ec55e0a 100644
--- a/gnu/installer/newt/keymap.scm
+++ b/gnu/installer/newt/keymap.scm
@@ -24,7 +24,6 @@ (define-module (gnu installer newt keymap)
#:use-module (gnu installer newt page)
#:use-module (guix i18n)
#:use-module (guix records)
- #:use-module (newt)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm
index 01171e253f..a226b39ba6 100644
--- a/gnu/installer/newt/locale.scm
+++ b/gnu/installer/newt/locale.scm
@@ -22,7 +22,6 @@ (define-module (gnu installer newt locale)
#:use-module (gnu installer steps)
#:use-module (gnu installer newt page)
#:use-module (guix i18n)
- #:use-module (newt)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
diff --git a/gnu/installer/newt/parameters.scm b/gnu/installer/newt/parameters.scm
index 8fb1aa3abb..7c61266e4d 100644
--- a/gnu/installer/newt/parameters.scm
+++ b/gnu/installer/newt/parameters.scm
@@ -23,7 +23,6 @@ (define-module (gnu installer newt parameters)
#:use-module (guix build syscalls)
#:use-module (guix i18n)
#:use-module (ice-9 match)
- #:use-module (newt)
#:export (run-parameters-page))
(define (run-proxy-page)
diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm
index b22024602c..d1035b6524 100644
--- a/gnu/installer/newt/services.scm
+++ b/gnu/installer/newt/services.scm
@@ -28,7 +28,6 @@ (define-module (gnu installer newt services)
#:use-module (guix i18n)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
- #:use-module (newt)
#:export (run-services-page))
(define (run-desktop-environments-cbt-page)
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 09/16] installer: Align comments.
2024-10-21 8:13 [bug#73927] [PATCH 00/16] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (7 preceding siblings ...)
2024-10-21 8:17 ` [bug#73927] [PATCH 08/16] installer: Remove unused (newt) imports Janneke Nieuwenhuizen
@ 2024-10-21 8:17 ` Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 10/16] installer: Use "partitioning-page" consistently Janneke Nieuwenhuizen
` (8 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-21 8:17 UTC (permalink / raw)
To: 73927; +Cc: Josselin Poiret, Ludovic Courtès, Mathieu Othacehe
* gnu/installer.scm (installer-program): Align comments.
Change-Id: I50c173c46ea9bfdb3da0562146bc969d46f0edd9
---
gnu/installer.scm | 24 ++++++++++++------------
1 file changed, 12 insertions(+), 12 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 5cd99e4013..3dfcb7581a 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -355,22 +355,22 @@ (define (installer-program)
(define set-installer-path
;; Add the specified binary to PATH for later use by the installer.
#~(let* ((inputs
- '#$(list bash ;start subshells
- connman ;call connmanctl
+ '#$(list bash ;start subshells
+ connman ;call connmanctl
cryptsetup
- dosfstools ;mkfs.fat
- e2fsprogs ;mkfs.ext4
- lvm2-static ;dmsetup
+ dosfstools ;mkfs.fat
+ e2fsprogs ;mkfs.ext4
+ lvm2-static ;dmsetup
btrfs-progs
- jfsutils ;jfs_mkfs
- ntfs-3g ;mkfs.ntfs
- xfsprogs ;mkfs.xfs
- kbd ;chvt
- util-linux ;mkwap
+ jfsutils ;jfs_mkfs
+ ntfs-3g ;mkfs.ntfs
+ xfsprogs ;mkfs.xfs
+ kbd ;chvt
+ util-linux ;mkwap
nano
shadow
- tar ;dump
- gzip ;dump
+ tar ;dump
+ gzip ;dump
coreutils)))
(with-output-to-port (%make-void-port "w")
(lambda ()
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 10/16] installer: Use "partitioning-page" consistently.
2024-10-21 8:13 [bug#73927] [PATCH 00/16] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (8 preceding siblings ...)
2024-10-21 8:17 ` [bug#73927] [PATCH 09/16] installer: Align comments Janneke Nieuwenhuizen
@ 2024-10-21 8:17 ` Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 11/16] installer: Fix file-name typos Janneke Nieuwenhuizen
` (7 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-21 8:17 UTC (permalink / raw)
To: 73927; +Cc: Josselin Poiret, Ludovic Courtès, Mathieu Othacehe
Having `partition-page' function call `RUN-partititionING-page' where all
other proxy functions call `RUN-<name>' hurts my brain while refactoring.
* gnu/installer/record.scm (<installer>)[partition-page]: Rename to...
[partitioning-page]: ...this.
* gnu/installer/newt.scm (partitioning-page, newt-installer): Update
accordingly.
* gnu/installer.scm (installer-steps): Update accordingly.
Change-Id: I6b2f3459a3d0a7a89260224b7d8438676e3411ba
---
gnu/installer.scm | 3 ++-
gnu/installer/newt.scm | 5 +++--
gnu/installer/record.scm | 5 +++--
3 files changed, 8 insertions(+), 5 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 3dfcb7581a..3a05843cab 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -312,7 +313,7 @@ (define (installer-steps)
(id 'partition)
(description (G_ "Partitioning"))
(compute (lambda _
- ((installer-partition-page current-installer))))
+ ((installer-partitioning-page current-installer))))
(configuration-formatter user-partitions->configuration))
(installer-step
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index e1c4453168..6d8ea35fff 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -193,7 +194,7 @@ (define (hostname-page)
(define (user-page)
(run-user-page))
-(define (partition-page)
+(define (partitioning-page)
(run-partitioning-page))
(define (services-page)
@@ -220,7 +221,7 @@ (define newt-installer
(timezone-page timezone-page)
(hostname-page hostname-page)
(user-page user-page)
- (partition-page partition-page)
+ (partitioning-page partitioning-page)
(services-page services-page)
(welcome-page welcome-page)
(parameters-menu parameters-menu)
diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm
index 5e0264682f..334af44a0c 100644
--- a/gnu/installer/record.scm
+++ b/gnu/installer/record.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -37,7 +38,7 @@ (define-module (gnu installer record)
installer-timezone-page
installer-hostname-page
installer-user-page
- installer-partition-page
+ installer-partitioning-page
installer-services-page
installer-welcome-page
installer-parameters-menu
@@ -86,7 +87,7 @@ (define-record-type* <installer>
;; procedure void -> void
(user-page installer-user-page)
;; procedure void -> void
- (partition-page installer-partition-page)
+ (partitioning-page installer-partitioning-page)
;; procedure void -> void
(services-page installer-services-page)
;; procedure (logo #:pci-database) -> void
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 11/16] installer: Fix file-name typos.
2024-10-21 8:13 [bug#73927] [PATCH 00/16] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (9 preceding siblings ...)
2024-10-21 8:17 ` [bug#73927] [PATCH 10/16] installer: Use "partitioning-page" consistently Janneke Nieuwenhuizen
@ 2024-10-21 8:17 ` Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 12/16] installer: Use `%' for parameter %run-command-in-installer Janneke Nieuwenhuizen
` (6 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-21 8:17 UTC (permalink / raw)
To: 73927; +Cc: Josselin Poiret, Ludovic Courtès, Mathieu Othacehe
* gnu/installer/newt/page.scm (run-dump-page): Typo file-name.
* gnu/installer/utils.scm (open-new-log-port): Likewise.
Change-Id: I837991a0ee5054b3afa8328205e23ac6f9fbae8d
---
gnu/installer/newt/page.scm | 7 ++++---
gnu/installer/utils.scm | 7 ++++---
2 files changed, 8 insertions(+), 6 deletions(-)
diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
index e1623a51fd..64a2916826 100644
--- a/gnu/installer/newt/page.scm
+++ b/gnu/installer/newt/page.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -950,10 +951,10 @@ (define* (run-dump-page base-dir file-choices)
('exit-component
(let ((result
(map (match-lambda
- ((edit checkbox filename)
+ ((edit checkbox file-name)
(if (components=? edit argument)
- (abort-to-prompt prompt-tag filename)
- (cons filename (eq? #\x
+ (abort-to-prompt prompt-tag file-name)
+ (cons file-name (eq? #\x
(checkbox-value checkbox))))))
components)))
(destroy-form-and-pop form)
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index 6838410166..c722e9af8f 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.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.
;;;
@@ -283,11 +284,11 @@ (define-syntax syslog
(define (open-new-log-port)
(define now (localtime (time-second (current-time))))
- (define filename
+ (define file-name
(format #f "/tmp/installer.~a.log"
(strftime "%F.%T" now)))
- (open filename (logior O_RDWR
- O_CREAT)))
+ (open file-name (logior O_RDWR
+ O_CREAT)))
(define installer-log-port
(let ((port #f))
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 12/16] installer: Use `%' for parameter %run-command-in-installer.
2024-10-21 8:13 [bug#73927] [PATCH 00/16] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (10 preceding siblings ...)
2024-10-21 8:17 ` [bug#73927] [PATCH 11/16] installer: Fix file-name typos Janneke Nieuwenhuizen
@ 2024-10-21 8:17 ` Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 13/16] installer: Add dry-run? Janneke Nieuwenhuizen
` (5 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-21 8:17 UTC (permalink / raw)
To: 73927; +Cc: Josselin Poiret, Ludovic Courtès, Mathieu Othacehe
* gnu/installer/utils.scm (run-command-in-installer): Rename to...
(%run-command-in-installer): ...this.
* gnu/installer.scm (installer-program): Update accordingly.
* gnu/installer/parted.scm (remove-logical-devices, create-btrfs-file-system,
create-ext4-file-system, create-fat16-file-system, create-fat32-file-system,
create-jfs-file-system, create-ntfs-file-system, create-xfs-file-system,
create-swap-partition, luks-format-and-open, luks-ensure-open, luks-close):
Update accordingly.
Change-Id: I96ebc59ebc85fd8ebccb0cc57130b4e7532d287f
---
gnu/installer.scm | 2 +-
gnu/installer/parted.scm | 27 ++++++++++++++-------------
gnu/installer/utils.scm | 6 +++---
3 files changed, 18 insertions(+), 17 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 3a05843cab..21809e4259 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -465,7 +465,7 @@ (define (installer-program)
(installer-init current-installer)
(lambda ()
(parameterize
- ((run-command-in-installer
+ ((%run-command-in-installer
(installer-run-command current-installer)))
(catch #t
(lambda ()
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index dbdec1bba8..e59df3d8e6 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2019-2020, 2022, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -363,7 +364,7 @@ (define* (force-device-sync device)
(define (remove-logical-devices)
"Remove all active logical devices."
- ((run-command-in-installer) "dmsetup" "remove_all"))
+ ((%run-command-in-installer) "dmsetup" "remove_all"))
(define (installer-root-partition-path)
"Return the root partition path, or #f if it could not be detected."
@@ -1183,7 +1184,7 @@ (define (set-user-partitions-file-name user-partitions)
(define (create-btrfs-file-system partition)
"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-ext4-file-system partition)
"Create an ext4 file-system for PARTITION file-name."
@@ -1192,32 +1193,32 @@ (define (create-ext4-file-system partition)
;; up and adding new files would fail with ENOSPC despite there being plenty
;; of free space and inodes:
;; <https://blog.merovius.de/posts/2013-10-20-ext4-mysterious-no-space-left-on/>.
- ((run-command-in-installer) "mkfs.ext4" "-F" partition
+ ((%run-command-in-installer) "mkfs.ext4" "-F" partition
"-O" "large_dir"))
(define (create-fat16-file-system partition)
"Create a fat16 file-system for PARTITION file-name."
- ((run-command-in-installer) "mkfs.fat" "-F16" partition))
+ ((%run-command-in-installer) "mkfs.fat" "-F16" partition))
(define (create-fat32-file-system partition)
"Create a fat32 file-system for PARTITION file-name."
- ((run-command-in-installer) "mkfs.fat" "-F32" partition))
+ ((%run-command-in-installer) "mkfs.fat" "-F32" partition))
(define (create-jfs-file-system partition)
"Create a JFS file-system for PARTITION file-name."
- ((run-command-in-installer) "jfs_mkfs" "-f" partition))
+ ((%run-command-in-installer) "jfs_mkfs" "-f" partition))
(define (create-ntfs-file-system partition)
"Create a JFS file-system for PARTITION file-name."
- ((run-command-in-installer) "mkfs.ntfs" "-F" "-f" partition))
+ ((%run-command-in-installer) "mkfs.ntfs" "-F" "-f" partition))
(define (create-xfs-file-system partition)
"Create an XFS file-system for PARTITION file-name."
- ((run-command-in-installer) "mkfs.xfs" "-f" partition))
+ ((%run-command-in-installer) "mkfs.xfs" "-f" partition))
(define (create-swap-partition partition)
"Set up swap area on PARTITION file-name."
- ((run-command-in-installer) "mkswap" "-f" partition))
+ ((%run-command-in-installer) "mkswap" "-f" partition))
(define (call-with-luks-key-file password proc)
"Write PASSWORD in a temporary file and pass it to PROC as argument."
@@ -1246,9 +1247,9 @@ (define (luks-format-and-open user-partition)
(lambda (key-file)
(installer-log-line "formatting and opening LUKS entry ~s at ~s"
label file-name)
- ((run-command-in-installer) "cryptsetup" "-q" "luksFormat"
+ ((%run-command-in-installer) "cryptsetup" "-q" "luksFormat"
file-name key-file)
- ((run-command-in-installer) "cryptsetup" "open" "--type" "luks"
+ ((%run-command-in-installer) "cryptsetup" "open" "--type" "luks"
"--key-file" key-file file-name label)))))
(define (luks-ensure-open user-partition)
@@ -1262,14 +1263,14 @@ (define (luks-ensure-open user-partition)
(lambda (key-file)
(installer-log-line "opening LUKS entry ~s at ~s"
label file-name)
- ((run-command-in-installer) "cryptsetup" "open" "--type" "luks"
+ ((%run-command-in-installer) "cryptsetup" "open" "--type" "luks"
"--key-file" key-file file-name label))))))
(define (luks-close user-partition)
"Close the encrypted partition pointed by USER-PARTITION."
(let ((label (user-partition-crypt-label user-partition)))
(installer-log-line "closing LUKS entry ~s" label)
- ((run-command-in-installer) "cryptsetup" "close" label)))
+ ((%run-command-in-installer) "cryptsetup" "close" label)))
(define (format-user-partitions user-partitions)
"Format the <user-partition> records in USER-PARTITIONS list with
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index c722e9af8f..170f036537 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -50,7 +50,7 @@ (define-module (gnu installer utils)
run-external-command-with-handler/tty
run-external-command-with-line-hooks
run-command
- run-command-in-installer
+ %run-command-in-installer
syslog-port
%syslog-line-hook
@@ -222,13 +222,13 @@ (define* (run-command command #:key (tty? #f))
(pause)
succeeded?)
-(define run-command-in-installer
+(define %run-command-in-installer
(make-parameter
(lambda (. args)
(raise
(condition
(&serious)
- (&message (message "run-command-in-installer not set")))))))
+ (&message (message "%run-command-in-installer not set")))))))
\f
;;;
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 13/16] installer: Add dry-run?
2024-10-21 8:13 [bug#73927] [PATCH 00/16] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (11 preceding siblings ...)
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 ` Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 14/16] installer: Add "Kernel" page to select the Hurd Janneke Nieuwenhuizen
` (4 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-21 8:17 UTC (permalink / raw)
To: 73927; +Cc: Josselin Poiret, Ludovic Courtès, Mathieu Othacehe
This allows running the installer without root privileges. Do something like
./pre-inst-env guix repl
,use (guix)
,use (gnu installer)
(installer-program #:dry-run? #t)
,build $1
=>
"/gnu/store/...-installer-program"
and run
/gnu/store/...-installer-program
* gnu/installer/newt.scm (locale-page): Add #:dry-run? parameter.
(keymap-page): Likewise.
* gnu/installer/newt/keymap.scm (run-keymap-page): Likewise.
* gnu/installer/steps.scm (run-installer-steps): Likewise. Use it to skip
writing to socket.
* gnu/installer/newt/final.scm (run-final-page): Rename to...
(run-final-page-install): ...this.
(dry-run-final-page, run-final-page): New procedures.
* gnu/installer/parted.scm (bootloader-configuration): Cater for empty user
partitions.
* gnu/installer/utils.scm (dry-run-command): New procedure.
* gnu/installer.scm (compute-locale-step): Add #:dry-run? parameter. Use it
to avoid actually applying locale.
(compute-keymap-step): Add dry-run? parameter. Pass it to
keymap-page.
(installer-program): Add #:dry-run? parameter. If #:true
avoid writing to /proc, use dry-run-command, skip sync and reboot, and pass
dry-run? to...
(installer-steps): ...here. Add #:dry-run? parameter. Use it to disable
skip network, substitutes, partitioning pages, and pass it to...
compute-locale-step, compute-keymap-step, and final-page.
Change-Id: I0ff4c3b0a0c69539af617c27ba37654beed44619
---
gnu/installer.scm | 81 ++++++++++++++++++++------------
gnu/installer/newt.scm | 14 +++---
gnu/installer/newt/final.scm | 20 +++++++-
gnu/installer/newt/keymap.scm | 5 +-
gnu/installer/newt/locale.scm | 6 ++-
gnu/installer/newt/partition.scm | 1 +
gnu/installer/parted.scm | 29 +++++++-----
gnu/installer/steps.scm | 16 +++++--
gnu/installer/utils.scm | 4 ++
9 files changed, 116 insertions(+), 60 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 21809e4259..39a83c4455 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -134,7 +134,8 @@ (define apply-locale
(define* (compute-locale-step #:key
locales-name
iso639-languages-name
- iso3166-territories-name)
+ iso3166-territories-name
+ dry-run?)
"Return a gexp that run the locale-page of INSTALLER, and install the
selected locale. The list of locales, languages and territories passed to
locale-page are computed in derivations named respectively LOCALES-NAME,
@@ -177,8 +178,11 @@ (define* (compute-locale-step #:key
((installer-locale-page current-installer)
#:supported-locales #$locales-loader
#:iso639-languages #$iso639-loader
- #:iso3166-territories #$iso3166-loader)))
- (#$apply-locale result)
+ #:iso3166-territories #$iso3166-loader
+ #:dry-run? #$dry-run?)))
+ (if #$dry-run?
+ '()
+ (#$apply-locale result))
result))))
(define apply-keymap
@@ -188,7 +192,7 @@ (define apply-keymap
(kmscon-update-keymap (default-keyboard-model)
layout variant options))))
-(define* (compute-keymap-step context)
+(define (compute-keymap-step context dry-run?)
"Return a gexp that runs the keymap-page of INSTALLER and install the
selected keymap."
#~(lambda (current-installer)
@@ -200,15 +204,16 @@ (define* (compute-keymap-step context)
"/share/X11/xkb/rules/base.xml")))
(lambda (models layouts)
((installer-keymap-page current-installer)
- layouts '#$context)))))
+ layouts '#$context #$dry-run?)))))
(and result (#$apply-keymap result))
result)))
-(define (installer-steps)
+(define* (installer-steps #:key dry-run?)
(let ((locale-step (compute-locale-step
#:locales-name "locales"
#:iso639-languages-name "iso639-languages"
- #:iso3166-territories-name "iso3166-territories"))
+ #:iso3166-territories-name "iso3166-territories"
+ #:dry-run? dry-run?))
(timezone-data #~(string-append #$tzdata
"/share/zoneinfo/zone.tab")))
#~(lambda (current-installer)
@@ -216,7 +221,7 @@ (define (installer-steps)
(lambda ()
((installer-parameters-page current-installer)
(lambda _
- (#$(compute-keymap-step 'param)
+ (#$(compute-keymap-step 'param dry-run?)
current-installer)))))
(list
;; Ask the user to choose a locale among those supported by
@@ -262,8 +267,10 @@ (define (installer-steps)
(id 'keymap)
(description (G_ "Keyboard mapping selection"))
(compute (lambda _
- (#$(compute-keymap-step 'default)
- current-installer)))
+ (if #$dry-run?
+ '("en" "US" #f)
+ (#$(compute-keymap-step 'default dry-run?)
+ current-installer))))
(configuration-formatter keyboard-layout->configuration))
;; Ask the user to input a hostname for the system.
@@ -280,14 +287,18 @@ (define (installer-steps)
(id 'network)
(description (G_ "Network selection"))
(compute (lambda _
- ((installer-network-page current-installer)))))
+ (if #$dry-run?
+ '()
+ ((installer-network-page current-installer))))))
;; Ask whether to enable substitute server discovery.
(installer-step
(id 'substitutes)
(description (G_ "Substitute server discovery"))
(compute (lambda _
- ((installer-substitutes-page current-installer)))))
+ (if #$dry-run?
+ '()
+ ((installer-substitutes-page current-installer))))))
;; Prompt for users (name, group and home directory).
(installer-step
@@ -313,7 +324,9 @@ (define (installer-steps)
(id 'partition)
(description (G_ "Partitioning"))
(compute (lambda _
- ((installer-partitioning-page current-installer))))
+ (if #$dry-run?
+ '()
+ ((installer-partitioning-page current-installer)))))
(configuration-formatter user-partitions->configuration))
(installer-step
@@ -322,7 +335,7 @@ (define (installer-steps)
(compute
(lambda (result prev-steps)
((installer-final-page current-installer)
- result prev-steps))))))))
+ result prev-steps #$dry-run?))))))))
(define (provenance-sexp)
"Return an sexp representing the currently-used channels, for logging
@@ -343,7 +356,7 @@ (define (provenance-sexp)
`(channel ,(channel-name channel) ,url ,(channel-commit channel))))
channels))))
-(define (installer-program)
+(define* (installer-program #:key dry-run?)
"Return a file-like object that runs the given INSTALLER."
(define init-gettext
;; Initialize gettext support, so that installer messages can be
@@ -377,7 +390,7 @@ (define (installer-program)
(lambda ()
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)))))
- (define steps (installer-steps))
+ (define steps (installer-steps #:dry-run? dry-run?))
(define modules
(scheme-modules*
(string-append (current-source-directory) "/..")
@@ -425,9 +438,10 @@ (define (installer-program)
;; Enable core dump generation.
(setrlimit 'core #f #f)
- (call-with-output-file "/proc/sys/kernel/core_pattern"
- (lambda (port)
- (format port %core-dump)))
+ (unless #$dry-run?
+ (call-with-output-file "/proc/sys/kernel/core_pattern"
+ (lambda (port)
+ (format port %core-dump))))
;; Initialize gettext support so that installers can use
;; (guix i18n) module.
@@ -466,24 +480,29 @@ (define (installer-program)
(lambda ()
(parameterize
((%run-command-in-installer
- (installer-run-command current-installer)))
+ (if #$dry-run?
+ dry-run-command
+ (installer-run-command current-installer))))
(catch #t
(lambda ()
(define results
(run-installer-steps
#:rewind-strategy 'menu
#:menu-proc (installer-menu-page current-installer)
- #:steps steps))
-
- (match (result-step results 'final)
- ('success
- ;; We did it! Let's reboot!
- (sync)
- (stop-service 'root))
- (_
- ;; The installation failed, exit so that it is
- ;; restarted by login.
- #f)))
+ #:steps steps
+ #:dry-run? #$dry-run?))
+
+ (let ((result (result-step results 'final)))
+ (unless #$dry-run?
+ (match (result-step results 'final)
+ ('success
+ ;; We did it! Let's reboot!
+ (sync)
+ (stop-service 'root))
+ (_
+ ;; The installation failed, exit so that it is
+ ;; restarted by login.
+ #f)))))
(const #f)
(lambda (key . args)
(installer-log-line "crashing due to uncaught exception: ~s ~s"
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index 6d8ea35fff..d53bc058b3 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -158,17 +158,19 @@ (define (newt-run-command . args)
(term-signal term-sig)
(stop-signal stop-sig)))))))))))
-(define (final-page result prev-steps)
- (run-final-page result prev-steps))
+(define (final-page result prev-steps dry-run?)
+ (run-final-page result prev-steps dry-run?))
(define* (locale-page #:key
supported-locales
iso639-languages
- iso3166-territories)
+ iso3166-territories
+ dry-run?)
(run-locale-page
#:supported-locales supported-locales
#:iso639-languages iso639-languages
- #:iso3166-territories iso3166-territories))
+ #:iso3166-territories iso3166-territories
+ #:dry-run? dry-run?))
(define (timezone-page zonetab)
(run-timezone-page zonetab))
@@ -179,8 +181,8 @@ (define* (welcome-page logo #:key pci-database)
(define (menu-page steps)
(run-menu-page steps))
-(define* (keymap-page layouts context)
- (run-keymap-page layouts #:context context))
+(define (keymap-page layouts context dry-run?)
+ (run-keymap-page layouts #:context context #:dry-run? dry-run?))
(define (network-page)
(run-network-page))
diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
index 9f950a0551..c4e53f6d79 100644
--- a/gnu/installer/newt/final.scm
+++ b/gnu/installer/newt/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 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -106,7 +107,7 @@ (define* (run-install-shell locale
(newt-resume)
install-ok?))
-(define (run-final-page result prev-steps)
+(define (run-final-page-install result prev-steps)
(define (wait-for-clients)
(unless (null? (current-clients))
(installer-log-line "waiting with clients before starting final step")
@@ -133,3 +134,20 @@ (define (run-final-page result prev-steps)
(if install-ok?
(run-install-success-page)
(run-install-failed-page))))
+
+(define (dry-run-final-page result prev-steps)
+ (installer-log-line "proceeding with final step -- dry-run")
+ (let* ((configuration (format-configuration prev-steps result))
+ (user-partitions (result-step result 'partition))
+ (locale (result-step result 'locale))
+ (users (result-step result 'user))
+ (file (configuration->file configuration))
+ (install-ok? (run-config-display-page #:locale locale)))
+ (if install-ok?
+ (run-install-success-page)
+ (run-install-failed-page))))
+
+(define (run-final-page result prev-steps dry-run?)
+ (if dry-run?
+ (dry-run-final-page result prev-steps)
+ (run-final-page-install result prev-steps)))
diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm
index 109ec55e0a..57f6d6530c 100644
--- a/gnu/installer/newt/keymap.scm
+++ b/gnu/installer/newt/keymap.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -153,7 +154,7 @@ (define (toggleable-latin-layout layout variant)
"grp:alt_shift_toggle"))
(list layout variant #f)))
-(define* (run-keymap-page layouts #:key (context #f))
+(define* (run-keymap-page layouts #:key context dry-run?)
"Run a page asking the user to select a keyboard layout and variant. LAYOUTS
is a list of supported X11-KEYMAP-LAYOUT. For non-Latin keyboard layouts, a
second layout and toggle options will be added automatically. Return a list
@@ -201,7 +202,7 @@ (define* (run-keymap-page layouts #:key (context #f))
"xkeyboard-config")))))
(toggleable-latin-layout layout variant)))
- (let* ((result (run-installer-steps #:steps keymap-steps))
+ (let* ((result (run-installer-steps #:steps keymap-steps #:dry-run? dry-run?))
(layout (result-step result 'layout))
(variant (result-step result 'variant)))
(and layout
diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm
index a226b39ba6..0be9db449e 100644
--- a/gnu/installer/newt/locale.scm
+++ b/gnu/installer/newt/locale.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -92,7 +93,8 @@ (define (run-modifier-page modifiers modifier->text)
(define* (run-locale-page #:key
supported-locales
iso639-languages
- iso3166-territories)
+ iso3166-territories
+ dry-run?)
"Run a page asking the user to select a locale language and possibly
territory, codeset and modifier. Use SUPPORTED-LOCALES as the list of glibc
available locales. ISO639-LANGUAGES is an association list associating a
@@ -212,4 +214,4 @@ (define* (run-locale-page #:key
;; step, turn the result into a glibc locale string and return it.
(result->locale-string
supported-locales
- (run-installer-steps #:steps locale-steps)))
+ (run-installer-steps #:steps locale-steps #:dry-run? dry-run?)))
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index 37656696c1..48dd306080 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2018, 2019, 2022 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index e59df3d8e6..b36b238d8b 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -1461,19 +1461,22 @@ (define (root-user-partition? partition)
(define (bootloader-configuration user-partitions)
"Return the bootloader configuration field for USER-PARTITIONS."
- (let* ((root-partition (find root-user-partition?
- user-partitions))
- (root-partition-disk (user-partition-disk-file-name root-partition)))
- `((bootloader-configuration
- ,@(if (efi-installation?)
- `((bootloader grub-efi-bootloader)
- (targets (list ,(default-esp-mount-point))))
- `((bootloader grub-bootloader)
- (targets (list ,root-partition-disk))))
-
- ;; XXX: Assume we defined the 'keyboard-layout' field of
- ;; <operating-system> right above.
- (keyboard-layout keyboard-layout)))))
+ (let ((root-partition (find root-user-partition? user-partitions)))
+ (match user-partitions
+ (() '())
+ (_
+ (let ((root-partition-disk (user-partition-disk-file-name
+ root-partition)))
+ `((bootloader-configuration
+ ,@(if (efi-installation?)
+ `((bootloader grub-efi-bootloader)
+ (targets (list ,(default-esp-mount-point))))
+ `((bootloader grub-bootloader)
+ (targets (list ,root-partition-disk))))
+
+ ;; XXX: Assume we defined the 'keyboard-layout' field of
+ ;; <operating-system> right above.
+ (keyboard-layout keyboard-layout))))))))
(define (user-partition-missing-modules user-partitions)
"Return the list of kernel modules missing from the default set of kernel
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
index 0c505e40e4..de0a852f02 100644
--- a/gnu/installer/steps.scm
+++ b/gnu/installer/steps.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -84,7 +85,8 @@ (define-record-type* <installer-step>
(define* (run-installer-steps #:key
steps
(rewind-strategy 'previous)
- (menu-proc (const #f)))
+ (menu-proc (const #f))
+ dry-run?)
"Run the COMPUTE procedure of all <installer-step> records in STEPS
sequentially, inside a the 'installer-step prompt. When aborted to with a
parameter of 'abort, fallback to a previous install-step, accordingly to the
@@ -191,10 +193,14 @@ (define* (run-installer-steps #:key
;; prematurely.
(sigaction SIGPIPE SIG_IGN)
- (with-server-socket
- (run '()
- #:todo-steps steps
- #:done-steps '())))
+ (if dry-run?
+ (run '()
+ #:todo-steps steps
+ #:done-steps '())
+ (with-server-socket
+ (run '()
+ #:todo-steps steps
+ #:done-steps '()))))
(define (find-step-by-id steps id)
"Find and return the step in STEPS whose id is equal to ID."
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index 170f036537..a8eb6cee83 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -49,6 +49,7 @@ (define-module (gnu installer utils)
run-external-command-with-handler
run-external-command-with-handler/tty
run-external-command-with-line-hooks
+ dry-run-command
run-command
%run-command-in-installer
@@ -222,6 +223,9 @@ (define* (run-command command #:key (tty? #f))
(pause)
succeeded?)
+(define (dry-run-command . args)
+ (format #t "dry-run-command: skipping: ~a\n" args))
+
(define %run-command-in-installer
(make-parameter
(lambda (. args)
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 14/16] installer: Add "Kernel" page to select the Hurd.
2024-10-21 8:13 [bug#73927] [PATCH 00/16] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (12 preceding siblings ...)
2024-10-21 8:17 ` [bug#73927] [PATCH 13/16] installer: Add dry-run? Janneke Nieuwenhuizen
@ 2024-10-21 8:17 ` Janneke Nieuwenhuizen
2024-10-21 18:14 ` Mathieu Othacehe
2024-10-21 8:17 ` [bug#73927] [PATCH 15/16] installer: Add static-networking template Janneke Nieuwenhuizen
` (3 subsequent siblings)
17 siblings, 1 reply; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-21 8:17 UTC (permalink / raw)
To: 73927; +Cc: Josselin Poiret, Ludovic Courtès, Mathieu Othacehe
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
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 15/16] installer: Add static-networking template.
2024-10-21 8:13 [bug#73927] [PATCH 00/16] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (13 preceding siblings ...)
2024-10-21 8:17 ` [bug#73927] [PATCH 14/16] installer: Add "Kernel" page to select the Hurd Janneke Nieuwenhuizen
@ 2024-10-21 8:17 ` Janneke Nieuwenhuizen
2024-10-21 8:17 ` [bug#73927] [PATCH 16/16] DRAFT installer: Support dry-run from Guile via store Janneke Nieuwenhuizen
` (2 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-21 8:17 UTC (permalink / raw)
To: 73927; +Cc: Josselin Poiret, Ludovic Courtès, Mathieu Othacehe
* gnu/installer/services.scm (%system-services): Add
static-networking-service-type.
Change-Id: Iec6336f8d1f49e8b801e978d5c9eeb4f83a6e748
---
gnu/installer/services.scm | 22 ++++++++++++++++++++++
1 file changed, 22 insertions(+)
diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm
index d5a382606c..8b117d9a20 100644
--- a/gnu/installer/services.scm
+++ b/gnu/installer/services.scm
@@ -149,6 +149,28 @@ (define (%system-services)
(name (G_ "DHCP client (dynamic IP address assignment)"))
(type 'network-management)
(snippet '((service dhcp-client-service-type))))
+ (system-service
+ (name (G_ "Static networking service."))
+ (type 'network-management)
+ (snippet `((service
+ static-networking-service-type
+ (list %loopback-static-networking
+ (static-networking
+ (addresses
+ (list
+ (network-address
+ (device "eth0")
+ ,(comment (G_ ";; Fill-in your IP.\n"))
+ (value "192.168.178.10/24"))))
+ (routes
+ (list (network-route
+ (destination "default")
+ ,(comment (G_ ";; Fill-in your gateway IP.\n"))
+ (gateway "192.168.178.1"))))
+ (requirement '())
+ (provision '(networking))
+ ,(comment (G_ ";; Fill-in your nameservers.\n"))
+ (name-servers '("192.168.178.1"))))))))
;; Dealing with documents.
(system-service
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 16/16] DRAFT installer: Support dry-run from Guile via store.
2024-10-21 8:13 [bug#73927] [PATCH 00/16] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (14 preceding siblings ...)
2024-10-21 8:17 ` [bug#73927] [PATCH 15/16] installer: Add static-networking template Janneke Nieuwenhuizen
@ 2024-10-21 8:17 ` Janneke Nieuwenhuizen
2024-10-21 18:18 ` Mathieu Othacehe
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
17 siblings, 1 reply; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-21 8:17 UTC (permalink / raw)
To: 73927; +Cc: Josselin Poiret, Ludovic Courtès, Mathieu Othacehe
This supports running the installer quasi-directly from Guile by only building
a Guile installer-script in the store. Do something like:
./pre-inst-env guile -c '((@ (gnu installer) run-installer) #:dry-run? #t)'
sudo -E ./pre-inst-env guile -c '((@ (gnu installer) run-installer))'
* gnu/installer.scm (installer-script, run-installer): New procedures.
Change-Id: I8cc1746845ec99f738e35fa91bb2342a674cfa88
---
gnu/installer.scm | 84 +++++++++++++++++++++++++++++++++++++++++++++--
1 file changed, 82 insertions(+), 2 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 64f6273c55..617578665e 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -21,10 +21,14 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu installer)
+ #:use-module (guix build utils)
+ #:use-module (guix derivations)
#:use-module (guix discovery)
- #:use-module (guix packages)
#:use-module (guix gexp)
#:use-module (guix modules)
+ #:use-module (guix monads)
+ #:use-module (guix packages)
+ #:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix ui)
#:use-module ((guix self) #:select (make-config.scm))
@@ -56,7 +60,9 @@ (define-module (gnu installer)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (web uri)
- #:export (installer-program))
+ #:export (installer-program
+ installer-steps
+ run-installer))
(define module-to-import?
;; Return true for modules that should be imported. For (gnu system …) and
@@ -562,3 +568,77 @@ (define* (installer-program #:key dry-run?)
(execl #$(program-file "installer-real" installer-builder
#:guile guile-3.0-latest)
"installer-real"))))
+
+(define* (installer-script #:key dry-run?
+ (steps (installer-steps #:dry-run? dry-run?)))
+ (program-file
+ "installer-script"
+ #~(begin
+ (use-modules (gnu installer)
+ (gnu installer record)
+ (gnu installer keymap)
+ (gnu installer steps)
+ (gnu installer dump)
+ (gnu installer final)
+ (gnu installer hostname)
+ (gnu installer kernel)
+ (gnu installer locale)
+ (gnu installer parted)
+ (gnu installer services)
+ (gnu installer timezone)
+ (gnu installer user)
+ (gnu installer utils)
+ (gnu installer newt)
+ ((gnu installer newt keymap)
+ #:select (keyboard-layout->configuration))
+ (gnu services herd)
+ (guix i18n)
+ (guix build utils)
+ (guix utils)
+ ((system repl debug)
+ #:select (terminal-width))
+ (ice-9 match)
+ (ice-9 textual-ports))
+ (terminal-width 200)
+ (let* ((current-installer newt-installer)
+ (steps (#$steps current-installer)))
+ (catch #t
+ (lambda _
+ ((installer-init current-installer))
+ (parameterize ((%run-command-in-installer
+ (if #$dry-run?
+ dry-run-command
+ (installer-run-command current-installer)))
+ (%installer-configuration-file
+ (if #$dry-run?
+ "config.scm"
+ (%installer-configuration-file))))
+ (let ((results (run-installer-steps
+ #:rewind-strategy 'menu
+ #:menu-proc
+ (installer-menu-page current-installer)
+ #:steps steps
+ #:dry-run? #$dry-run?)))
+ (result-step results 'final))))
+ (const #f)
+ (lambda (key . args)
+ (sleep 10)
+ ((installer-exit current-installer))
+ (display-backtrace (make-stack #t) (current-error-port))
+ (apply throw key args)))))))
+
+(define* (run-installer #:key dry-run?)
+ "To run the installer from Guile without building it:
+ ./pre-inst-env guile -c '((@ (gnu installer) run-installer) #:dry-run? #t)'
+when using #:dry-run? #t, no root access is required and the LOCALE, KEYMAP,
+and PARTITION pages are skipped."
+ (let* ((script (installer-script #:dry-run? dry-run?))
+ (store (open-connection))
+ (drv (run-with-store store
+ (lower-object script)))
+ (program (match (derivation->output-paths drv)
+ ((("out" . program)) program)))
+ (outputs (build-derivations store (list drv))))
+ (close-connection store)
+ (format #t "running installer: ~a\n" program)
+ (invoke "./pre-inst-env" "guile" program)))
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 14/16] installer: Add "Kernel" page to select the Hurd.
2024-10-21 8:17 ` [bug#73927] [PATCH 14/16] installer: Add "Kernel" page to select the Hurd Janneke Nieuwenhuizen
@ 2024-10-21 18:14 ` Mathieu Othacehe
2024-10-22 8:53 ` janneke
0 siblings, 1 reply; 61+ messages in thread
From: Mathieu Othacehe @ 2024-10-21 18:14 UTC (permalink / raw)
To: Janneke Nieuwenhuizen; +Cc: 73927, Josselin Poiret, Ludovic Courtès
Hello Janneke,
Really great to see that extension to the installer :)
The installer patches look OK to me, I will try to test them
on real hardware soon.
> Change-Id: I15d535a7a8a917e5f3492f8c01d922d652c32ee5
>
> geert none
>
> Change-Id: Ib6c5665638018f59a2690f603fad0702e042fb8b
>
> Change-Id: I01b854390240be60ce9fef8c9510a90bc6843ef3
>
> geert
>
> Change-Id: Ibb7205443969fc92d4fe62d4dfb4f956d03229b9
^
Maybe something to cleanup?
> + ;; 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?))))
> +
If I remember correctly, new installer steps require some adaptations in
the (gnu installer tests) module.
Is make check-system TESTS="gui-installed-os" working correctly?
Thanks,
Mathieu
^ permalink raw reply [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 16/16] DRAFT installer: Support dry-run from Guile via store.
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
0 siblings, 1 reply; 61+ messages in thread
From: Mathieu Othacehe @ 2024-10-21 18:18 UTC (permalink / raw)
To: Janneke Nieuwenhuizen; +Cc: 73927, Josselin Poiret, Ludovic Courtès
Hello,
> This supports running the installer quasi-directly from Guile by only building
> a Guile installer-script in the store. Do something like:
>
> ./pre-inst-env guile -c '((@ (gnu installer) run-installer) #:dry-run? #t)'
>
> sudo -E ./pre-inst-env guile -c '((@ (gnu installer) run-installer))'
I remember resorting to a similar hack, back in 2018 when writing the
installer. Maybe we should go the extra mile and integrate that one to a
proper guix command, such as `guix system installer` that would call
`run-installer` with dry-run set to #t. WDYT?
Thanks,
Mathieu
^ permalink raw reply [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 16/16] DRAFT installer: Support dry-run from Guile via store.
2024-10-21 18:18 ` Mathieu Othacehe
@ 2024-10-22 8:21 ` janneke
0 siblings, 0 replies; 61+ messages in thread
From: janneke @ 2024-10-22 8:21 UTC (permalink / raw)
To: Mathieu Othacehe; +Cc: 73927, Josselin Poiret, Ludovic Courtès
Mathieu Othacehe writes:
Hello Mathieu,
>> This supports running the installer quasi-directly from Guile by only building
>> a Guile installer-script in the store. Do something like:
>>
>> ./pre-inst-env guile -c '((@ (gnu installer) run-installer) #:dry-run? #t)'
>>
>> sudo -E ./pre-inst-env guile -c '((@ (gnu installer) run-installer))'
>
> I remember resorting to a similar hack, back in 2018 when writing the
> installer. Maybe we should go the extra mile and integrate that one to a
> proper guix command, such as `guix system installer` that would call
> `run-installer` with dry-run set to #t. WDYT?
Sure, sounds nice, and being able to run it with dry-run? #f is also
nice but I guess that would be doable :)
So you also don't see a way to move the installer-steps list out of the
gexp without adding the extra dependencies?
Greetings,
Janneke
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 14/16] installer: Add "Kernel" page to select the Hurd.
2024-10-21 18:14 ` Mathieu Othacehe
@ 2024-10-22 8:53 ` janneke
2024-10-22 14:34 ` janneke
0 siblings, 1 reply; 61+ messages in thread
From: janneke @ 2024-10-22 8:53 UTC (permalink / raw)
To: Mathieu Othacehe; +Cc: 73927, Josselin Poiret, Ludovic Courtès
Mathieu Othacehe writes:
Hello Mathieu,
> Really great to see that extension to the installer :)
Thanks!
> The installer patches look OK to me, I will try to test them
> on real hardware soon.
>> Change-Id: I15d535a7a8a917e5f3492f8c01d922d652c32ee5
>>
>> geert none
>>
>> Change-Id: Ib6c5665638018f59a2690f603fad0702e042fb8b
>>
>> Change-Id: I01b854390240be60ce9fef8c9510a90bc6843ef3
>>
>> geert
>>
>> Change-Id: Ibb7205443969fc92d4fe62d4dfb4f956d03229b9
>
> ^
> Maybe something to cleanup?
Oops, sorry :) Cleaned it up locally.
>> + ;; 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?))))
>> +
>
> If I remember correctly, new installer steps require some adaptations in
> the (gnu installer tests) module.
>
> Is make check-system TESTS="gui-installed-os" working correctly?
Ah, right; that fails. I'll look into it, thanks for the pointer.
Where are the .ppm files saved/how do I get at them?
Greetings,
Janneke
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 14/16] installer: Add "Kernel" page to select the Hurd.
2024-10-22 8:53 ` janneke
@ 2024-10-22 14:34 ` janneke
2024-10-22 18:06 ` Mathieu Othacehe
0 siblings, 1 reply; 61+ messages in thread
From: janneke @ 2024-10-22 14:34 UTC (permalink / raw)
To: Mathieu Othacehe; +Cc: 73927, Josselin Poiret, Ludovic Courtès
[-- Attachment #1: Type: text/plain, Size: 1043 bytes --]
Hi,
>> The installer patches look OK to me, I will try to test them
>> on real hardware soon.
Just a heads-up: While I'm pretty sure that the the config.scm is OK (if
you don't select any options, use static networking and fill in your IP
and gateway), I haven't had any luck yet installing it.
The guile-fibers for the hurd does currently (?) not cross-build from
32 bit, i.e.
guix build guile-fibers --target=i586-pc-gnu --system=i686-linux
fails, and I had no luck with a 64bit machine, getting i/o errors while
running guix init. No idea which device fails on me there.
> Ah, right; that fails. I'll look into it, thanks for the pointer.
> Where are the .ppm files saved/how do I get at them?
Hmm, I could use some help here. I tried the almost trivial patch
attached, but that fails and it's not clear to my why. Possibly I don't
understand the code because it seems to me that the screenshot names
go out of sync after the locale page. Also, the roundtrip time to test
something out is pretty bad...
Greetings,
Janneke
[-- Attachment #2: 0001-squash-installer-Add-Kernel-page-to-select-the-Hurd.patch --]
[-- Type: text/x-patch, Size: 3076 bytes --]
From 22d12407d3b291318b76ac167d22104cc2852a85 Mon Sep 17 00:00:00 2001
Message-ID: <22d12407d3b291318b76ac167d22104cc2852a85.1729607385.git.janneke@gnu.org>
From: Janneke Nieuwenhuizen <janneke@gnu.org>
Date: Tue, 22 Oct 2024 11:00:59 +0200
Subject: [PATCH] squash! installer: Add "Kernel" page to select the Hurd.
* gnu/installer/tests.scm (choose-kernel): New procedure.
* gnu/tests/install.scm (gui-test-program): Use it.
---
gnu/installer/tests.scm | 11 +++++++++++
gnu/tests/install.scm | 5 ++++-
2 files changed, 15 insertions(+), 1 deletion(-)
diff --git a/gnu/installer/tests.scm b/gnu/installer/tests.scm
index 8785cd9a9f..a9a5d5d988 100644
--- a/gnu/installer/tests.scm
+++ b/gnu/installer/tests.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -35,6 +36,7 @@ (define-module (gnu installer tests)
choose-locale+keyboard
enter-host-name+passwords
+ choose-kernel
choose-services
choose-partitioning
start-installation
@@ -211,6 +213,15 @@ (define* (enter-host-name+passwords port
(password ,password)))
names passwords))))))
+(define* (choose-kernel port #:key (kernel "Linux Libre"))
+ "Converse over PORT with the guided installer to choose the specified
+KERNEL."
+ (converse port
+ ((list-selection (title "Kernel")
+ (multiple-choices? #f)
+ (items _))
+ kernel)))
+
(define* (choose-services port
#:key
(choose-desktop-environment? (const #f))
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 36dbd9111f..6be582373d 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -3,7 +3,7 @@
;;; Copyright © 2017, 2019, 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
-;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -1869,6 +1869,9 @@ (define* (gui-test-program marionette
#$marionette)
(screenshot "installer-services.ppm")
+ (marionette-eval* '(choose-kernel installer-socket) #$marionette)
+ (screenshot "installer-kernel.ppm")
+
(marionette-eval* '(choose-services installer-socket
#:choose-desktop-environment?
(const #$desktop?)
base-commit: 80f8ef0a01f2cf39deebfecc344e5f04d87d4bd4
--
2.46.0
[-- Attachment #3: fail-with-kernel-page-fix.log --]
[-- Type: application/octet-stream, Size: 3521 bytes --]
Oct 22 11:20:19 localhost installer[194]: running step 'welcome'
Oct 22 11:20:19 localhost installer[194]: running form #<newt-form 1d23c4c0> ("GNU Guix install") with 1 clients
Oct 22 11:20:19 localhost installer[194]: form #<newt-form 1d23c4c0> ("GNU Guix install"): client 20 replied "Graphical install using a terminal based interface"
Oct 22 11:20:20 localhost installer[194]: running step 'timezone'
conversation expecting pattern ((quote list-selection) ((quote title) "Timezone") ((quote multiple-choices?) #f) ((quote items) _))Oct 22 11:20:20 localhost installer[194]: running form #<newt-form 1d23ab50> ("Timezone") with 1 clients
Oct 22 11:20:20 localhost installer[194]: form #<newt-form 1d23ab50> ("Timezone"): client 20 replied "Europe"
Oct 22 11:20:20 localhost installer[194]: running form #<newt-form 1d2332f0> ("Timezone") with 1 clients
conversation expecting patternOct 22 11:20:20 localhost installer[194]: form #<newt-form 1d2332f0> ("Timezone"): client 20 replied "Zagreb"
Oct 22 11:20:20 localhost installer[194]: running step 'keymap'
((quote list-selection) ((quote title) "Layout") ((quote multiple-choices?) #f) ((quote items) _))
Oct 22 11:20:21 localhost installer[194]: running step 'layout'
Oct 22 11:20:21 localhost installer[194]: running form #<newt-form 1d2329f0> ("Layout") with 1 clients
conversation expecting pattern ((quote list-selection) ((quote title) "Variant") ((quote multiple-choices?) #f) ((quote items) _))Oct 22 11:20:21 localhost installer[194]: form #<newt-form 1d2329f0> ("Layout"): client 20 replied "English (US)"
Oct 22 11:20:21 localhost installer[194]: running step 'variant'
Oct 22 11:20:21 localhost installer[194]: running form #<newt-form 1d232890> ("Variant") with 1 clients
Oct 22 11:20:21 localhost installer[194]: form #<newt-form 1d232890> ("Variant"): client 20 replied "English (intl., with AltGr dead keys)"
conversation expecting pattern ((quote input) ((quote title) "Hostname") ((quote text) _) ((quote default) _))
conversation expecting patteOct 22 11:20:21 localhost installer[194]: running step 'hostname'
Oct 22 11:20:21 localhost installer[194]: running form #<newt-form 1d234f60> ("Hostname") with 1 clients
rn ((quote input) ((quote title) "System administrator password") ((quote text) _) ((quote default) _))Oct 22 11:20:21 localhost installer[194]: form #<newt-form 1d234f60> ("Hostname"): client 20 replied "liberigilo"
Oct 22 11:20:21 localhost installer[194]: running step 'kernel'
Oct 22 11:20:21 localhost installer[194]: running form #<newt-form 1d23a8f0> ("Kernel") with 1 clients
shepherd: Service user-homes has been started.
shepherd: Starting service term-tty1...
shepherd: Service term-tty1 started.
shepherd: Service term-tty1 running with value 177.
ice-9/eval.scm:159:9: ERROR:
1. &pattern-not-matched:
pattern: ((quote input) ((quote title) "System administrator password") ((quote text) _) ((quote default) _))
sexp: (list-selection (title "Kernel") (multiple-choices? #f) (items ("Hurd" "Linux Libre")))
Backtrace:
2 (primitive-load "/gnu/store/9ga3v94czyndh67qfxx9r0zcywg?")
In ice-9/eval.scm:
191:35 1 (_ #f)
619:8 0 (_ #(#<directory (guile-user) 7ffff7850c80> #<variabl?>))
ice-9/eval.scm:619:8: Throw to key `marionette-eval-failure' with args `((quote (enter-host-name+passwords installer-socket #:host-name "liberigilo" #:root-password "foo" #:users (quote (("alice" "pass1") ("bob" "pass2"))))))'.
[-- Attachment #4: Type: text/plain, Size: 164 bytes --]
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH 14/16] installer: Add "Kernel" page to select the Hurd.
2024-10-22 14:34 ` janneke
@ 2024-10-22 18:06 ` Mathieu Othacehe
2024-10-22 19:18 ` [bug#73927] [PATCH v2 " janneke
0 siblings, 1 reply; 61+ messages in thread
From: Mathieu Othacehe @ 2024-10-22 18:06 UTC (permalink / raw)
To: janneke; +Cc: 73927, Josselin Poiret, Ludovic Courtès
Hey,
> Hmm, I could use some help here. I tried the almost trivial patch
> attached, but that fails and it's not clear to my why. Possibly I don't
> understand the code because it seems to me that the screenshot names
> go out of sync after the locale page. Also, the roundtrip time to test
> something out is pretty bad...
The ppm stuff is just about keeping screenshots around to debug any test
failures. According to the log that you sent, I would say that the issue
is a mismatch between the installation step that is expected by the
marionette and the actual installation step:
--8<---------------cut here---------------start------------->8---
pattern: ((quote input) ((quote title) "System administrator password") ((quote text) _) ((quote default) _)).
sexp: (list-selection (title "Kernel") (multiple-choices? #f) (items ("Hurd" "Linux Libre"))).
--8<---------------cut here---------------end--------------->8---
The system administrator password page is expected but the kernel
selection page is sent.
It seems that you have chosen to display the Kernel selection page
between the host-name page and the network selection page. I guess that
by moving the Kernel step here:
--8<---------------cut here---------------start------------->8---
;; Prompt for users (name, group and home directory).
(installer-step
(id 'user)
(description (G_ "User creation"))
(compute (lambda _
((installer-user-page current-installer))))
(configuration-formatter users->configuration))
-> Kernel step
;; Ask the user to choose one or many desktop environment(s).
(installer-step
(id 'services)
(description (G_ "Services"))
(compute (lambda _
((installer-services-page current-installer))))
(configuration-formatter system-services->configuration))
--8<---------------cut here---------------end--------------->8---
the test would match with the actual installation step.
Hope that will help,
Thanks,
Mathieu
^ permalink raw reply [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v2 14/16] installer: Add "Kernel" page to select the Hurd.
2024-10-22 18:06 ` Mathieu Othacehe
@ 2024-10-22 19:18 ` janneke
0 siblings, 0 replies; 61+ messages in thread
From: janneke @ 2024-10-22 19:18 UTC (permalink / raw)
To: Mathieu Othacehe; +Cc: 73927, Josselin Poiret, Ludovic Courtès
[-- Attachment #1: Type: text/plain, Size: 2157 bytes --]
Mathieu Othacehe writes:
Hi,
> The ppm stuff is just about keeping screenshots around to debug any test
> failures.
Ok. In any case we can see about that later.
> According to the log that you sent, I would say that the issue
> is a mismatch between the installation step that is expected by the
> marionette and the actual installation step:
>
> pattern: ((quote input) ((quote title) "System administrator password") ((quote text) _) ((quote default) _)).
> sexp: (list-selection (title "Kernel") (multiple-choices? #f) (items ("Hurd" "Linux Libre"))).
>
>
> The system administrator password page is expected but the kernel
> selection page is sent.
Ah, the test combines host-name and users together, makes sense. Kind
of obvious when you see it :)
> It seems that you have chosen to display the Kernel selection page
> between the host-name page and the network selection page. I guess that
> by moving the Kernel step here:
>
> ;; Prompt for users (name, group and home directory).
> (installer-step
> (id 'user)
> (description (G_ "User creation"))
> (compute (lambda _
> ((installer-user-page current-installer))))
> (configuration-formatter users->configuration))
>
> -> Kernel step
>
> ;; Ask the user to choose one or many desktop environment(s).
> (installer-step
> (id 'services)
> (description (G_ "Services"))
> (compute (lambda _
> ((installer-services-page current-installer))))
> (configuration-formatter system-services->configuration))
>
> the test would match with the actual installation step.
Good call.
> Hope that will help,
It does thanks; test passed!
--8<---------------cut here---------------start------------->8---
make check-system TESTS="gui-installed-os"
...
successfully built /gnu/store/68yvz94hgnicavcps2i96wpddsygq9fz-gui-installed-os.drv
/gnu/store/84n7zjm5l41m279i72cfp7z0cxa9h20p-gui-installed-os
--8<---------------cut here---------------end--------------->8---
Find v2 attached; as only this patch has changed.
Greetings,
Janneke
[-- Attachment #2: v2-0014-installer-Add-Kernel-page-to-select-the-Hurd.patch --]
[-- Type: text/x-patch, Size: 37450 bytes --]
From e6bd56aa544deb45764baf3138668849aab2b86b Mon Sep 17 00:00:00 2001
Message-ID: <e6bd56aa544deb45764baf3138668849aab2b86b.1729624171.git.janneke@gnu.org>
In-Reply-To: <1fbb300ade6667d5390dbe1a2e8e82ff4af7d1a0.1729624171.git.janneke@gnu.org>
References: <1fbb300ade6667d5390dbe1a2e8e82ff4af7d1a0.1729624171.git.janneke@gnu.org>
From: Janneke Nieuwenhuizen <janneke@gnu.org>
Date: Sun, 20 Oct 2024 15:13:16 +0200
Subject: [PATCH v2 14/16] installer: Add "Kernel" page to select the Hurd.
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.
* gnu/installer/tests.scm (choose-kernel): New procedure.
* gnu/tests/install.scm (gui-test-program): Use it.
Change-Id: Ifafb27b8a2f933944c77223a27ec151757237e36
---
gnu/installer.scm | 14 ++++++++
gnu/installer/final.scm | 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/installer/tests.scm | 11 ++++++
gnu/local.mk | 2 ++
gnu/system/hurd.scm | 3 ++
gnu/tests/install.scm | 5 ++-
15 files changed, 246 insertions(+), 48 deletions(-)
create mode 100644 gnu/installer/kernel.scm
create mode 100644 gnu/installer/newt/kernel.scm
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 39a83c4455..31c0ff7ff4 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -308,6 +308,18 @@ (define* (installer-steps #:key dry-run?)
((installer-user-page current-installer))))
(configuration-formatter users->configuration))
+ ;; Ask the user to select the kernel for the system,
+ ;; for x86 systems only.
+ (installer-step
+ (id 'kernel)
+ (description (G_ "Kernel"))
+ (compute (lambda _
+ (if (target-x86?)
+ ((installer-kernel-page current-installer))
+ '())))
+ (configuration-formatter (lambda (result)
+ (kernel->configuration result #$dry-run?))))
+
;; Ask the user to choose one or many desktop environment(s).
(installer-step
(id 'services)
@@ -419,6 +431,7 @@ (define* (installer-program #:key dry-run?)
(gnu installer dump)
(gnu installer final)
(gnu installer hostname)
+ (gnu installer kernel)
(gnu installer locale)
(gnu installer parted)
(gnu installer services)
@@ -431,6 +444,7 @@ (define* (installer-program #:key dry-run?)
(gnu services herd)
(guix i18n)
(guix build utils)
+ (guix utils)
((system repl debug)
#:select (terminal-width))
(ice-9 match)
diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm
index 069426a3b8..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/installer/tests.scm b/gnu/installer/tests.scm
index 8785cd9a9f..a9a5d5d988 100644
--- a/gnu/installer/tests.scm
+++ b/gnu/installer/tests.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -35,6 +36,7 @@ (define-module (gnu installer tests)
choose-locale+keyboard
enter-host-name+passwords
+ choose-kernel
choose-services
choose-partitioning
start-installation
@@ -211,6 +213,15 @@ (define* (enter-host-name+passwords port
(password ,password)))
names passwords))))))
+(define* (choose-kernel port #:key (kernel "Linux Libre"))
+ "Converse over PORT with the guided installer to choose the specified
+KERNEL."
+ (converse port
+ ((list-selection (title "Kernel")
+ (multiple-choices? #f)
+ (items _))
+ kernel)))
+
(define* (choose-services port
#:key
(choose-desktop-environment? (const #f))
diff --git a/gnu/local.mk b/gnu/local.mk
index 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
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 36dbd9111f..6be582373d 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -3,7 +3,7 @@
;;; Copyright © 2017, 2019, 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
-;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -1869,6 +1869,9 @@ (define* (gui-test-program marionette
#$marionette)
(screenshot "installer-services.ppm")
+ (marionette-eval* '(choose-kernel installer-socket) #$marionette)
+ (screenshot "installer-kernel.ppm")
+
(marionette-eval* '(choose-services installer-socket
#:choose-desktop-environment?
(const #$desktop?)
--
2.46.0
[-- Attachment #3: Type: text/plain, Size: 164 bytes --]
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd.
2024-10-21 8:13 [bug#73927] [PATCH 00/16] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (15 preceding siblings ...)
2024-10-21 8:17 ` [bug#73927] [PATCH 16/16] DRAFT installer: Support dry-run from Guile via store Janneke Nieuwenhuizen
@ 2024-10-25 9:39 ` Janneke Nieuwenhuizen
2024-10-25 9:39 ` [bug#73927] [PATCH v3 01/17] gnu: guile-fibers: Fix cross-build for " Janneke Nieuwenhuizen
` (16 more replies)
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
17 siblings, 17 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-25 9:39 UTC (permalink / raw)
To: 73927
New in this series:
* guix install now creates essential devices for the Hurd
* by default, no EFI partition is created
* the grub configuration for the HURD now caters for non-HURD-VM (chilhurds)
* make check-system TESTS="gui-installed-os now also works for non-x86
which makes that besides creating a sensible config.scm, the installed Hurd
now has a good chance to actually boot :)
Also updated hurd-team.
Greetings,
Janneke
Janneke Nieuwenhuizen (17):
gnu: guile-fibers: Fix cross-build for the Hurd.
guix system: When installing the Hurd, create essential devices.
bootloader: grub: Remove hardcoded partition number for the Hurd.
system: hurd: Remove qemu networking from %base-services/hurd.
system: hurd: Add swap-services to hurd-default-essential-services.
gnu: hurd: Support second boot.
hurd-boot: Support second boot.
maint: Add installer dependencies to the manifest.
installer: Remove unused (newt) imports.
installer: Align comments.
installer: Use "partitioning-page" consistently.
installer: Fix file-name typos.
installer: Use `%' for parameter %run-command-in-installer.
installer: Add dry-run?
installer: Add "Kernel" page to select the Hurd.
installer: Add static-networking template.
installer: Support dry-run from Guile via store.
gnu/bootloader/grub.scm | 42 ++++-
gnu/build/hurd-boot.scm | 21 ++-
gnu/installer.scm | 206 ++++++++++++++++++------
gnu/installer/final.scm | 10 +-
gnu/installer/kernel.scm | 41 +++++
gnu/installer/newt.scm | 24 ++-
gnu/installer/newt/ethernet.scm | 1 -
gnu/installer/newt/final.scm | 20 ++-
gnu/installer/newt/kernel.scm | 45 ++++++
gnu/installer/newt/keymap.scm | 6 +-
gnu/installer/newt/locale.scm | 7 +-
gnu/installer/newt/page.scm | 7 +-
gnu/installer/newt/parameters.scm | 1 -
gnu/installer/newt/partition.scm | 10 +-
gnu/installer/newt/services.scm | 32 ++--
gnu/installer/parted.scm | 117 +++++++++-----
gnu/installer/record.scm | 8 +-
gnu/installer/services.scm | 68 ++++++--
gnu/installer/steps.scm | 30 ++--
gnu/installer/tests.scm | 11 ++
gnu/installer/utils.scm | 17 +-
gnu/local.mk | 3 +
gnu/packages/guile-xyz.scm | 11 +-
gnu/packages/hurd.scm | 6 +-
gnu/packages/patches/hurd-startup.patch | 82 ++++++++++
gnu/services/base.scm | 20 ++-
gnu/services/virtualization.scm | 4 +-
gnu/system.scm | 13 +-
gnu/system/examples/bare-hurd.tmpl | 10 +-
gnu/system/hurd.scm | 26 +--
gnu/system/images/hurd.scm | 2 +-
gnu/tests/install.scm | 6 +-
guix/scripts/system.scm | 6 +-
manifest.scm | 7 +-
34 files changed, 724 insertions(+), 196 deletions(-)
create mode 100644 gnu/installer/kernel.scm
create mode 100644 gnu/installer/newt/kernel.scm
create mode 100644 gnu/packages/patches/hurd-startup.patch
base-commit: 2394a7f5fbf60dd6adc0a870366adb57166b6d8b
--
2.46.0
^ permalink raw reply [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v3 01/17] gnu: guile-fibers: Fix cross-build for the Hurd.
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
@ 2024-10-25 9:39 ` Janneke Nieuwenhuizen
2024-10-25 9:39 ` [bug#73927] [PATCH v3 02/17] guix system: When installing the Hurd, create essential devices Janneke Nieuwenhuizen
` (15 subsequent siblings)
16 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-25 9:39 UTC (permalink / raw)
To: 73927
* gnu/packages/guile-xyz.scm (guile-fibers): When cross-building for the Hurd,
add "fix-env" phase.
Change-Id: Iebe12941bbfb2f5a6208f9364115e95f10e82ed6
---
gnu/packages/guile-xyz.scm | 11 +++++++++--
1 file changed, 9 insertions(+), 2 deletions(-)
diff --git a/gnu/packages/guile-xyz.scm b/gnu/packages/guile-xyz.scm
index 5f34ea98a6..06d3b59dc3 100644
--- a/gnu/packages/guile-xyz.scm
+++ b/gnu/packages/guile-xyz.scm
@@ -9,7 +9,7 @@
;;; Copyright © 2016, 2017, 2021 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016, 2017 Adonay "adfeno" Felipe Nogueira <https://libreplanet.org/wiki/User:Adfeno> <adfeno@openmailbox.org>
;;; Copyright © 2016, 2021 Amirouche <amirouche@hypermove.net>
-;;; Copyright © 2016, 2019, 2021, 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016, 2019, 2021, 2023, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2017 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2017 David Thompson <davet@gnu.org>
;;; Copyright © 2017, 2018, 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -875,7 +875,14 @@ (define-public guile-fibers
(substitute* "tests/basic.scm"
((".*spawn-fiber-chain 5000000.*") ""))
(substitute* "tests/channels.scm"
- ((".*assert-run-fibers-terminates .*pingpong.*") "")))))))))
+ ((".*assert-run-fibers-terminates .*pingpong.*") "")))))
+ #$@(if (and (target-hurd?) (%current-target-system))
+ #~((add-before 'build 'fixup-env
+ (lambda _
+ (substitute* "env"
+ ((".*override.*" all)
+ (string-append "true #" all))))))
+ '())))))
(native-inputs
(list texinfo pkg-config autoconf-2.71 automake libtool
guile-3.0 ;for 'guild compile
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v3 02/17] guix system: When installing the Hurd, create essential devices.
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
2024-10-25 9:39 ` [bug#73927] [PATCH v3 01/17] gnu: guile-fibers: Fix cross-build for " Janneke Nieuwenhuizen
@ 2024-10-25 9:39 ` Janneke Nieuwenhuizen
2024-10-25 9:39 ` [bug#73927] [PATCH v3 03/17] bootloader: grub: Remove hardcoded partition number for the Hurd Janneke Nieuwenhuizen
` (14 subsequent siblings)
16 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-25 9:39 UTC (permalink / raw)
To: 73927
* guix/scripts/system.scm (install): When installing the Hurd, invoke
`make-hurd-device-nodes'.
Change-Id: If84d5fe0b5bf4a93452f0b5241650f325d583543
---
guix/scripts/system.scm | 6 +++++-
1 file changed, 5 insertions(+), 1 deletion(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 99c58f3812..7989b183ad 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -5,7 +5,7 @@
;;; Copyright © 2017, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
-;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
@@ -63,6 +63,7 @@ (define-module (guix scripts system)
#:autoload (guix progress) (progress-reporter/bar
call-with-progress-reporter)
#:use-module ((guix docker) #:select (%docker-image-max-layers))
+ #:use-module (gnu build hurd-boot)
#:use-module (gnu build image)
#:use-module (gnu build install)
#:autoload (gnu build file-systems)
@@ -243,6 +244,9 @@ (define (maybe-copy to-copy)
(delete-file-recursively state)))
(chmod target #o755)
+ ;; For the Hurd to boot, it needs some essential device nodes.
+ (when (target-hurd?)
+ (make-hurd-device-nodes target))
(let ((os-dir (derivation->output-path os-drv))
(format (lift format %store-monad))
(populate (lift2 populate-root-file-system %store-monad)))
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v3 03/17] bootloader: grub: Remove hardcoded partition number for the Hurd.
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
2024-10-25 9:39 ` [bug#73927] [PATCH v3 01/17] gnu: guile-fibers: Fix cross-build for " Janneke Nieuwenhuizen
2024-10-25 9:39 ` [bug#73927] [PATCH v3 02/17] guix system: When installing the Hurd, create essential devices Janneke Nieuwenhuizen
@ 2024-10-25 9:39 ` Janneke Nieuwenhuizen
2024-10-25 9:39 ` [bug#73927] [PATCH v3 04/17] system: hurd: Remove qemu networking from %base-services/hurd Janneke Nieuwenhuizen
` (13 subsequent siblings)
16 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-25 9:39 UTC (permalink / raw)
To: 73927
This supports using another than the default DISK0 PART1 and using LABEL or
UUID as root file-system specifier. It still defaults to DISK0 PART1 if
the file-system cannot be found, i.e., lives only at the build side: A
virtual machine/childhurd build.
* gnu/bootloader/grub.scm (%device-spec-regexp): New variable.
(string->device-spec, device-spec->hurd-device): Use it in new procedures.
(device->hurd-device): New procedure.
(make-grub-configuration): Use them to remove hardcoded partition
number (root-index 1).
Change-Id: I49fa93dacc09883dfb4d695402c5eac2e0e17286
---
gnu/bootloader/grub.scm | 42 +++++++++++++++++++++++++++++++++++------
1 file changed, 36 insertions(+), 6 deletions(-)
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 2723eda5f4..c929af691b 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -3,7 +3,7 @@
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2019, 2020, 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2019, 2020, 2023, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2020 Stefan <stefan-guix@vodafonemail.de>
@@ -34,6 +34,7 @@ (define-module (gnu bootloader grub)
#:use-module (guix gexp)
#:use-module (gnu artwork)
#:use-module (gnu bootloader)
+ #:use-module (gnu build file-systems)
#:use-module (gnu system uuid)
#:use-module (gnu system file-systems)
#:use-module (gnu system keyboard)
@@ -45,6 +46,7 @@ (define-module (gnu bootloader grub)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
+ #:use-module (srfi srfi-26)
#:export (grub-theme
grub-theme?
grub-theme-image
@@ -355,6 +357,34 @@ (define (grub-root-search device file)
((or #f (? string?))
#~(format #f "search --file --set ~a" #$file)))))
+(define %device-spec-regexp "/dev/[hsvw]d([abcd])([0-9]*)")
+(define (string->device-spec str)
+ "Return device spec STR as /dev/XdYZ, also catering for uuid or label."
+ (cond ((string-match %device-spec-regexp str)
+ str)
+ ((string->uuid str)
+ =>
+ find-partition-by-uuid)
+ (else
+ (find-partition-by-label str))))
+
+(define* (device-spec->hurd-device device-spec #:key (disk "w"))
+ "Return DEVICE-SPEC as a Hurd device spec:
+ part:PART-NUMBER:device:DISKdDISK-INDEX
+Default to part:1:device:DISKd0 if partition cannot be found."
+ (let* ((m (and=> device-spec (cute string-match %device-spec-regexp <>)))
+ (disk-char (and m (and=> (match:substring m 1) (compose car string->list))))
+ (disk-index (or (and disk-char (- (char->integer disk-char) (char->integer #\a)))
+ 0))
+ (partition-number (or (and m (and=> (match:substring m 2) string->number))
+ 1)))
+ (format #f "part:~a:device:~ad~a" partition-number disk disk-index)))
+
+(define* (device->hurd-device device #:key (disk "w"))
+ "Return DEVICE as a Hurd device spec: part:PART-NUMBER:device:DISKdDISK-INDEX."
+ (let ((device-spec (canonicalize-device-spec device)))
+ (device-spec->hurd-device device-spec #:disk disk)))
+
(define* (make-grub-configuration grub config entries
#:key
(locale #f)
@@ -413,16 +443,16 @@ (define (menu-entry->gexp entry)
;; IDE driver ("hdX") and those understood by rumpdisk ("wdX"
;; in the "noide" case).
(disk (if (member "noide" arguments) "w" "h"))
- (modules (menu-entry-multiboot-modules entry))
- (root-index 1)) ; XXX EFI will need root-index 2
+ (device-string (file-system-device->string device))
+ (device-spec (and=> device-string string->device-spec))
+ (modules (menu-entry-multiboot-modules entry)))
#~(format port "
menuentry ~s {
- multiboot ~a root=part:~a:device:~ad0~a~a
+ multiboot ~a root=~a~a~a
}~%"
#$label
#$kernel
- #$root-index
- #$disk
+ #$(device-spec->hurd-device device-spec #:disk disk)
(string-join (list #$@arguments) " " 'prefix)
(string-join (map string-join '#$modules)
"\n module " 'prefix))))
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v3 04/17] system: hurd: Remove qemu networking from %base-services/hurd.
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (2 preceding siblings ...)
2024-10-25 9:39 ` [bug#73927] [PATCH v3 03/17] bootloader: grub: Remove hardcoded partition number for the Hurd Janneke Nieuwenhuizen
@ 2024-10-25 9:39 ` Janneke Nieuwenhuizen
2024-10-25 9:39 ` [bug#73927] [PATCH v3 05/17] system: hurd: Add swap-services to hurd-default-essential-services Janneke Nieuwenhuizen
` (12 subsequent siblings)
16 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-25 9:39 UTC (permalink / raw)
To: 73927
This allows us to use %base-services/hurd for services in a Hurd config for a
real machine without removing static-networking.
* gnu/system/hurd.scm (%base-services/hurd): Factor networking out to...
(%base-services+qemu-networking/hurd): ..this new variable.
* gnu/system/examples/bare-hurd.tmpl (%hurd-os): Use it.
* gnu/services/virtualization.scm (%hurd-vm-operating-system): Use it.
* gnu/system/images/hurd.scm (hurd-barebones-os): Use it. Add comment about
QEMU and networking for a real machine.
Change-Id: I777a63410383b9bf8b5740e4513dbc1e9fb0fd41
---
gnu/services/virtualization.scm | 4 ++--
gnu/system/examples/bare-hurd.tmpl | 10 ++++++++--
gnu/system/hurd.scm | 23 ++++++++++++++---------
gnu/system/images/hurd.scm | 2 +-
4 files changed, 25 insertions(+), 14 deletions(-)
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index d87e494348..d33dfa6ca7 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com>
;;; Copyright © 2018, 2020-2024 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2020, 2021, 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2021, 2023, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Timotej Lazar <timotej.lazar@araneo.si>
;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2022 Leo Nikkilä <hello@lnikki.la>
@@ -1643,7 +1643,7 @@ (define %hurd-vm-operating-system
;; /etc/guix/acl file in the childhurd. Thus, clear
;; 'authorize-key?' so that it's not overridden at activation
;; time.
- (modify-services %base-services/hurd
+ (modify-services %base-services+qemu-networking/hurd
(guix-service-type config =>
(guix-configuration
(inherit config)
diff --git a/gnu/system/examples/bare-hurd.tmpl b/gnu/system/examples/bare-hurd.tmpl
index 463c7ee798..68c6d3c166 100644
--- a/gnu/system/examples/bare-hurd.tmpl
+++ b/gnu/system/examples/bare-hurd.tmpl
@@ -1,7 +1,7 @@
;; -*-scheme-*-
;; This is an operating system configuration template
-;; for a "bare bones" setup, with no X11 display server.
+;; for a "bare bones" QEMU setup, with no X11 display server.
;; To build a disk image for a virtual machine, do
;;
@@ -54,6 +54,12 @@
(permit-root-login #t)
(allow-empty-passwords? #t)
(password-authentication? #t)))
- %base-services/hurd))))
+ ;; For installing on a real (non-QEMU) machine, use:
+ ;; (static-networking-service-type
+ ;; (list %loopback-static-networking
+ ;; (static-networking
+ ;; ...)))
+ ;; %base-services/hurd
+ %base-services+qemu-networking/hurd))))
%hurd-os
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index 6d6a20cf57..283bae6f10 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020-2024 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2020, 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2023, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -47,6 +47,7 @@ (define-module (gnu system hurd)
#:use-module (gnu system vm)
#:export (%base-packages/hurd
%base-services/hurd
+ %base-services+qemu-networking/hurd
%hurd-default-operating-system
%hurd-default-operating-system-kernel
%setuid-programs/hurd))
@@ -79,14 +80,6 @@ (define %base-packages/hurd
(define %base-services/hurd
(append (list (service hurd-console-service-type
(hurd-console-configuration (hurd hurd)))
- (service static-networking-service-type
- (list %loopback-static-networking
-
- ;; QEMU user-mode networking. To get "eth0", you need
- ;; QEMU to emulate a device for which Mach has an
- ;; in-kernel driver, for instance with:
- ;; --device rtl8139,netdev=net0 --netdev user,id=net0
- %qemu-static-networking))
(service guix-service-type
(guix-configuration
(extra-options '("--disable-chroot"
@@ -102,6 +95,18 @@ (define %base-services/hurd
(tty (string-append "tty" (number->string n))))))
(iota 6 1))))
+(define %base-services+qemu-networking/hurd
+ (cons
+ (service static-networking-service-type
+ (list %loopback-static-networking
+
+ ;; QEMU user-mode networking. To get "eth0", you need
+ ;; QEMU to emulate a device for which Mach has an
+ ;; in-kernel driver, for instance with:
+ ;; --device rtl8139,netdev=net0 --netdev user,id=net0
+ %qemu-static-networking))
+ %base-services/hurd))
+
(define %setuid-programs/hurd
;; Default set of setuid-root programs.
(map file-like->setuid-program
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index 9b618f7dc6..01c422a54f 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -60,7 +60,7 @@ (define hurd-barebones-os
(permit-root-login #t)
(allow-empty-passwords? #t)
(password-authentication? #t)))
- %base-services/hurd))))
+ %base-services+qemu-networking/hurd))))
(define hurd-initialize-root-partition
#~(lambda* (#:rest args)
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v3 05/17] system: hurd: Add swap-services to hurd-default-essential-services.
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (3 preceding siblings ...)
2024-10-25 9:39 ` [bug#73927] [PATCH v3 04/17] system: hurd: Remove qemu networking from %base-services/hurd Janneke Nieuwenhuizen
@ 2024-10-25 9:39 ` Janneke Nieuwenhuizen
2024-10-25 9:39 ` [bug#73927] [PATCH v3 06/17] gnu: hurd: Support second boot Janneke Nieuwenhuizen
` (11 subsequent siblings)
16 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-25 9:39 UTC (permalink / raw)
To: 73927
* gnu/services/base.scm (swap-service-type): Do not include 'udev' requirement
for the Hurd. Use system* with "swapon", "swapoff" for the Hurd.
* gnu/system.scm (hurd-default-essential-services): Add swap-services.
* gnu/services/base.scm (swap-service-type):
Change-Id: I1d4d445c614921752dc84aa0dd6ff42cdbf62aa8
---
gnu/services/base.scm | 20 +++++++++++++-------
gnu/system.scm | 13 +++++++------
2 files changed, 20 insertions(+), 13 deletions(-)
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index d0a57a8807..6201dea4b8 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -44,6 +44,7 @@ (define-module (gnu services base)
#:autoload (guix diagnostics) (warning formatted-message &fix-hint)
#:autoload (guix i18n) (G_)
#:use-module (guix combinators)
+ #:use-module (guix utils)
#:use-module (gnu services)
#:use-module (gnu services admin)
#:use-module (gnu services shepherd)
@@ -2647,7 +2648,7 @@ (define device-lookup
(with-imported-modules (source-module-closure '((gnu build file-systems)))
(shepherd-service
(provision (list (swap->shepherd-service-name swap)))
- (requirement `(udev ,@requirements))
+ (requirement `(,@(if (target-hurd?) '() '(udev)) ,@requirements))
(documentation "Enable the given swap space.")
(modules `((gnu build file-systems)
,@%default-modules))
@@ -2655,16 +2656,21 @@ (define device-lookup
(let ((device #$device-lookup))
(and device
(begin
- (restart-on-EINTR (swapon device
- #$(if (swap-space? swap)
- (swap-space->flags-bit-mask
- swap)
- 0)))
+ #$(if (target-hurd?)
+ #~(system* "swapon" device)
+ #~(restart-on-EINTR
+ (swapon device
+ #$(if (swap-space? swap)
+ (swap-space->flags-bit-mask
+ swap)
+ 0))))
#t)))))
(stop #~(lambda _
(let ((device #$device-lookup))
(when device
- (restart-on-EINTR (swapoff device)))
+ #$(if (target-hurd?)
+ #~(system* "swapoff" device)
+ #~(restart-on-EINTR (swapoff device))))
#f)))
(respawn? #f))))
(description "Turn on the virtual memory swap area.")))
diff --git a/gnu/system.scm b/gnu/system.scm
index c19730b331..533a4154d6 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -845,11 +845,11 @@ (define (hurd-default-essential-services os)
(let ((host-name (operating-system-host-name os))
(hosts-file (%operating-system-hosts-file os))
(entries (operating-system-directory-base-entries os)))
- (list (service system-service-type entries)
- %boot-service
- %hurd-startup-service
- %activation-service
- (service shepherd-root-service-type)
+ (cons* (service system-service-type entries)
+ %boot-service
+ %hurd-startup-service
+ %activation-service
+ (service shepherd-root-service-type)
(service user-processes-service-type)
;; Make sure that privileged-programs activation script
@@ -873,7 +873,8 @@ (define (hurd-default-essential-services os)
(list `("hosts" ,hosts-file)))
(service hosts-service-type
(local-host-entries host-name)))
- (service profile-service-type (operating-system-packages os)))))
+ (service profile-service-type (operating-system-packages os))
+ (swap-services os))))
(define* (operating-system-services os)
"Return all the services of OS, including \"essential\" services."
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v3 06/17] gnu: hurd: Support second boot.
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (4 preceding siblings ...)
2024-10-25 9:39 ` [bug#73927] [PATCH v3 05/17] system: hurd: Add swap-services to hurd-default-essential-services Janneke Nieuwenhuizen
@ 2024-10-25 9:39 ` Janneke Nieuwenhuizen
2024-10-25 9:39 ` [bug#73927] [PATCH v3 07/17] hurd-boot: " Janneke Nieuwenhuizen
` (10 subsequent siblings)
16 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-25 9:39 UTC (permalink / raw)
To: 73927
This avoids hanging upon second boot and ensures a declarative /hurd and /dev.
* gnu/packages/patches/hurd-startup.patch: New file.
* gnu/local.mk (dist_patch_DATA): Add it.
* gnu/packages/hurd.scm (hurd): Use it.
[arguments]: In stage create-runsystem remove /dev/urandom.
Change-Id: Ifcca5562c297204735c35132820a32ca0f273677
---
gnu/local.mk | 1 +
gnu/packages/hurd.scm | 6 +-
gnu/packages/patches/hurd-startup.patch | 82 +++++++++++++++++++++++++
3 files changed, 88 insertions(+), 1 deletion(-)
create mode 100644 gnu/packages/patches/hurd-startup.patch
diff --git a/gnu/local.mk b/gnu/local.mk
index 911af88627..0a1357f114 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1540,6 +1540,7 @@ dist_patch_DATA = \
%D%/packages/patches/hubbub-sort-entities.patch \
%D%/packages/patches/hueplusplus-mbedtls.patch \
%D%/packages/patches/hurd-rumpdisk-no-hd.patch \
+ %D%/packages/patches/hurd-startup.patch \
%D%/packages/patches/hwloc-1-test-btrfs.patch \
%D%/packages/patches/i7z-gcc-10.patch \
%D%/packages/patches/icecat-makeicecat.patch \
diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm
index e6ea920714..9c1681f236 100644
--- a/gnu/packages/hurd.scm
+++ b/gnu/packages/hurd.scm
@@ -317,7 +317,8 @@ (define-public hurd
(name "hurd")
(source (origin
(inherit (package-source hurd-headers))
- (patches (search-patches "hurd-rumpdisk-no-hd.patch"))))
+ (patches (search-patches "hurd-rumpdisk-no-hd.patch"
+ "hurd-startup.patch"))))
(version (package-version hurd-headers))
(arguments
`(#:tests? #f ;no "check" target
@@ -388,6 +389,9 @@ (define-public hurd
# Note: this /hurd/ gets substituted
settrans --create /servers/socket/1 /hurd/pflocal
+# Upon second boot, (file-exists? /dev/null) in hurd-boot-system hangs unless:
+rm -f /dev/urandom
+
# parse multiboot arguments
for i in \"$@\"; do
case $i in
diff --git a/gnu/packages/patches/hurd-startup.patch b/gnu/packages/patches/hurd-startup.patch
new file mode 100644
index 0000000000..0b0dcc9537
--- /dev/null
+++ b/gnu/packages/patches/hurd-startup.patch
@@ -0,0 +1,82 @@
+This avoids hanging upon second boot and ensures a declarative /dev.
+
+Upstream status: Not presented upstream.
+
+From a15d281ea012ee360c45376e964d35f6292ac549 Mon Sep 17 00:00:00 2001
+From: Janneke Nieuwenhuizen <janneke@gnu.org>
+Date: Sat, 27 May 2023 17:28:22 +0200
+Subject: [PATCH] startup: Remove /hurd, /dev, create /servers.
+
+This avoids hanging upon second boot and ensures a declarative /hurd
+and /dev.
+
+* startup/startup.c (rm_r, create_servers): New functions.
+(main): Use them to remove /dev and create /servers. Remove /hurd
+symlink.
+---
+ startup/startup.c | 42 ++++++++++++++++++++++++++++++++++++++++++
+ 1 file changed, 42 insertions(+)
+
+diff --git a/startup/startup.c b/startup/startup.c
+index feb7d265..5f380194 100644
+--- a/startup/startup.c
++++ b/startup/startup.c
+@@ -732,6 +732,42 @@ parse_opt (int key, char *arg, struct argp_state *state)
+ return 0;
+ }
+
++#include <ftw.h>
++static int
++rm_r (char const *file_name)
++{
++ int callback (char const *file_name, struct stat64 const *stat_buffer,
++ int type_flag, struct FTW *ftw_buffer)
++ {
++ fprintf (stderr, "startup: removing: %s\n", file_name);
++ return remove (file_name);
++ }
++
++ return nftw64 (file_name, callback, 0, FTW_DEPTH | FTW_MOUNT | FTW_PHYS);
++}
++
++void
++create_servers (void)
++{
++ char const *servers[] = {
++ "/servers/startup",
++ "/servers/exec",
++ "/servers/proc",
++ "/servers/password",
++ "/servers/default-pager",
++ "/servers/crash-dump-core",
++ "/servers/kill",
++ "/servers/suspend",
++ 0,
++ };
++ mkdir ("/servers", 0755);
++ for (char const **p = servers; *p; p++)
++ open (*p, O_WRONLY | O_APPEND | O_CREAT, 0444);
++ mkdir ("/servers/socket", 0755);
++ mkdir ("/servers/bus", 0755);
++ mkdir ("/servers/bus/pci", 0755);
++}
++
+ int
+ main (int argc, char **argv, char **envp)
+ {
+@@ -741,6 +777,12 @@ main (int argc, char **argv, char **envp)
+ mach_port_t consdev;
+ struct argp argp = { options, parse_opt, 0, doc };
+
++ /* GNU Guix creates fresh ones in boot-hurd-system. */
++ unlink ("/hurd");
++ rm_r ("/dev");
++ mkdir ("/dev", 0755);
++ create_servers ();
++
+ /* Parse the arguments. We don't want the vector reordered, we
+ should pass on to our child the exact arguments we got and just
+ ignore any arguments that aren't flags for us. ARGP_NO_ERRS
+--
+2.40.1
+
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v3 07/17] hurd-boot: Support second boot.
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (5 preceding siblings ...)
2024-10-25 9:39 ` [bug#73927] [PATCH v3 06/17] gnu: hurd: Support second boot Janneke Nieuwenhuizen
@ 2024-10-25 9:39 ` Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 08/17] maint: Add installer dependencies to the manifest Janneke Nieuwenhuizen
` (9 subsequent siblings)
16 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-25 9:39 UTC (permalink / raw)
To: 73927
* gnu/build/hurd-boot.scm (boot-hurd-system): Check for stale shepherd socket
and remove it. Be chattier about /hurd symlink replacement.
Change-Id: I5e528c131ebeadb7ebc9727336a0f9301af3e68e
---
gnu/build/hurd-boot.scm | 21 ++++++++++++++++-----
1 file changed, 16 insertions(+), 5 deletions(-)
diff --git a/gnu/build/hurd-boot.scm b/gnu/build/hurd-boot.scm
index daf4fb41ab..23ace25d4f 100644
--- a/gnu/build/hurd-boot.scm
+++ b/gnu/build/hurd-boot.scm
@@ -322,18 +322,29 @@ (define* (boot-hurd-system #:key (on-error 'debug))
(let* ((args (command-line))
(system (find-long-option "gnu.system" args))
- (to-load (find-long-option "gnu.load" args)))
+ (to-load (find-long-option "gnu.load" args))
+ (profile (string-append system "/profile"))
+ (bin (string-append profile "/bin"))
+ (sbin (string-append profile "/bin")))
- (false-if-exception (delete-file "/hurd"))
- (let ((hurd/hurd (readlink* (string-append system "/profile/hurd"))))
- (symlink hurd/hurd "/hurd"))
+ (setenv "PATH" (string-append bin ":" sbin))
+
+ (when (file-exists? "/var/run/shepherd/socket")
+ (format #t "Removing stale shepherd socket...\n")
+ (delete-file "/var/run/shepherd/socket"))
(unless (file-exists? "/servers/startup")
(format #t "Creating essential device nodes...\n")
(make-hurd-device-nodes))
+ (let ((profile/hurd (readlink* (string-append profile "/hurd"))))
+ (when (file-exists? "/hurd")
+ (format #t "Removing stale /hurd link\n")
+ (delete-file "/hurd"))
+ (format #t "Linking /hurd from ~a...\n" profile/hurd)
+ (symlink profile/hurd "/hurd"))
+
(format #t "Setting-up essential translators...\n")
- (setenv "PATH" (string-append system "/profile/bin"))
(set-hurd-device-translators)
(format #t "Starting pager...\n")
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v3 08/17] maint: Add installer dependencies to the manifest.
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (6 preceding siblings ...)
2024-10-25 9:39 ` [bug#73927] [PATCH v3 07/17] hurd-boot: " Janneke Nieuwenhuizen
@ 2024-10-25 9:40 ` Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 09/17] installer: Remove unused (newt) imports Janneke Nieuwenhuizen
` (8 subsequent siblings)
16 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-25 9:40 UTC (permalink / raw)
To: 73927
* manifest.scm: Add guile-newt, guile-parted, guile-webutils.
Change-Id: Idcf46320d29c15f36da05f66e81b7779e37c1bf6
---
manifest.scm | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
diff --git a/manifest.scm b/manifest.scm
index 27e1d62566..ccd6268461 100644
--- a/manifest.scm
+++ b/manifest.scm
@@ -51,4 +51,9 @@
"mumi"
"nss-certs"
"openssl" ;required if using 'smtpEncryption = tls'
- "patman"))))
+ "patman"))
+ ;; For installer
+ (specifications->manifest
+ (list "guile-newt"
+ "guile-parted"
+ "guile-webutils"))))
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v3 09/17] installer: Remove unused (newt) imports.
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (7 preceding siblings ...)
2024-10-25 9:40 ` [bug#73927] [PATCH v3 08/17] maint: Add installer dependencies to the manifest Janneke Nieuwenhuizen
@ 2024-10-25 9:40 ` Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 10/17] installer: Align comments Janneke Nieuwenhuizen
` (7 subsequent siblings)
16 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-25 9:40 UTC (permalink / raw)
To: 73927
* gnu/installer/newt/ethernet.scm,
gnu/installer/newt/keymap.scm,
gnu/installer/newt/locale.scm,
gnu/installer/newt/parameters.scm,
gnu/installer/newt/services.scm: Remove (newt).
Change-Id: Ia6624aaf73491024da54b8ffee7358941b187fdf
---
gnu/installer/newt/ethernet.scm | 1 -
gnu/installer/newt/keymap.scm | 1 -
gnu/installer/newt/locale.scm | 1 -
gnu/installer/newt/parameters.scm | 1 -
gnu/installer/newt/services.scm | 1 -
5 files changed, 5 deletions(-)
diff --git a/gnu/installer/newt/ethernet.scm b/gnu/installer/newt/ethernet.scm
index d75a640519..53e440fd60 100644
--- a/gnu/installer/newt/ethernet.scm
+++ b/gnu/installer/newt/ethernet.scm
@@ -27,7 +27,6 @@ (define-module (gnu installer newt ethernet)
#:use-module (ice-9 match)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
- #:use-module (newt)
#:export (run-ethernet-page))
(define (ethernet-services)
diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm
index c5d4be6792..109ec55e0a 100644
--- a/gnu/installer/newt/keymap.scm
+++ b/gnu/installer/newt/keymap.scm
@@ -24,7 +24,6 @@ (define-module (gnu installer newt keymap)
#:use-module (gnu installer newt page)
#:use-module (guix i18n)
#:use-module (guix records)
- #:use-module (newt)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm
index 01171e253f..a226b39ba6 100644
--- a/gnu/installer/newt/locale.scm
+++ b/gnu/installer/newt/locale.scm
@@ -22,7 +22,6 @@ (define-module (gnu installer newt locale)
#:use-module (gnu installer steps)
#:use-module (gnu installer newt page)
#:use-module (guix i18n)
- #:use-module (newt)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
diff --git a/gnu/installer/newt/parameters.scm b/gnu/installer/newt/parameters.scm
index 8fb1aa3abb..7c61266e4d 100644
--- a/gnu/installer/newt/parameters.scm
+++ b/gnu/installer/newt/parameters.scm
@@ -23,7 +23,6 @@ (define-module (gnu installer newt parameters)
#:use-module (guix build syscalls)
#:use-module (guix i18n)
#:use-module (ice-9 match)
- #:use-module (newt)
#:export (run-parameters-page))
(define (run-proxy-page)
diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm
index b22024602c..d1035b6524 100644
--- a/gnu/installer/newt/services.scm
+++ b/gnu/installer/newt/services.scm
@@ -28,7 +28,6 @@ (define-module (gnu installer newt services)
#:use-module (guix i18n)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
- #:use-module (newt)
#:export (run-services-page))
(define (run-desktop-environments-cbt-page)
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v3 10/17] installer: Align comments.
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (8 preceding siblings ...)
2024-10-25 9:40 ` [bug#73927] [PATCH v3 09/17] installer: Remove unused (newt) imports Janneke Nieuwenhuizen
@ 2024-10-25 9:40 ` Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 11/17] installer: Use "partitioning-page" consistently Janneke Nieuwenhuizen
` (6 subsequent siblings)
16 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-25 9:40 UTC (permalink / raw)
To: 73927
* gnu/installer.scm (installer-program): Align comments.
Change-Id: I50c173c46ea9bfdb3da0562146bc969d46f0edd9
---
gnu/installer.scm | 24 ++++++++++++------------
1 file changed, 12 insertions(+), 12 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 5cd99e4013..3dfcb7581a 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -355,22 +355,22 @@ (define init-gettext
(define set-installer-path
;; Add the specified binary to PATH for later use by the installer.
#~(let* ((inputs
- '#$(list bash ;start subshells
- connman ;call connmanctl
+ '#$(list bash ;start subshells
+ connman ;call connmanctl
cryptsetup
- dosfstools ;mkfs.fat
- e2fsprogs ;mkfs.ext4
- lvm2-static ;dmsetup
+ dosfstools ;mkfs.fat
+ e2fsprogs ;mkfs.ext4
+ lvm2-static ;dmsetup
btrfs-progs
- jfsutils ;jfs_mkfs
- ntfs-3g ;mkfs.ntfs
- xfsprogs ;mkfs.xfs
- kbd ;chvt
- util-linux ;mkwap
+ jfsutils ;jfs_mkfs
+ ntfs-3g ;mkfs.ntfs
+ xfsprogs ;mkfs.xfs
+ kbd ;chvt
+ util-linux ;mkwap
nano
shadow
- tar ;dump
- gzip ;dump
+ tar ;dump
+ gzip ;dump
coreutils)))
(with-output-to-port (%make-void-port "w")
(lambda ()
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v3 11/17] installer: Use "partitioning-page" consistently.
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (9 preceding siblings ...)
2024-10-25 9:40 ` [bug#73927] [PATCH v3 10/17] installer: Align comments Janneke Nieuwenhuizen
@ 2024-10-25 9:40 ` Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 12/17] installer: Fix file-name typos Janneke Nieuwenhuizen
` (5 subsequent siblings)
16 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-25 9:40 UTC (permalink / raw)
To: 73927
Having `partition-page' function call `RUN-partititionING-page' where all
other proxy functions call `RUN-<name>' hurts my brain while refactoring.
* gnu/installer/record.scm (<installer>)[partition-page]: Rename to...
[partitioning-page]: ...this.
* gnu/installer/newt.scm (partitioning-page, newt-installer): Update
accordingly.
* gnu/installer.scm (installer-steps): Update accordingly.
Change-Id: I6b2f3459a3d0a7a89260224b7d8438676e3411ba
---
gnu/installer.scm | 3 ++-
gnu/installer/newt.scm | 5 +++--
gnu/installer/record.scm | 5 +++--
3 files changed, 8 insertions(+), 5 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 3dfcb7581a..3a05843cab 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -312,7 +313,7 @@ (define (installer-steps)
(id 'partition)
(description (G_ "Partitioning"))
(compute (lambda _
- ((installer-partition-page current-installer))))
+ ((installer-partitioning-page current-installer))))
(configuration-formatter user-partitions->configuration))
(installer-step
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index e1c4453168..6d8ea35fff 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -193,7 +194,7 @@ (define (hostname-page)
(define (user-page)
(run-user-page))
-(define (partition-page)
+(define (partitioning-page)
(run-partitioning-page))
(define (services-page)
@@ -220,7 +221,7 @@ (define newt-installer
(timezone-page timezone-page)
(hostname-page hostname-page)
(user-page user-page)
- (partition-page partition-page)
+ (partitioning-page partitioning-page)
(services-page services-page)
(welcome-page welcome-page)
(parameters-menu parameters-menu)
diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm
index 5e0264682f..334af44a0c 100644
--- a/gnu/installer/record.scm
+++ b/gnu/installer/record.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -37,7 +38,7 @@ (define-module (gnu installer record)
installer-timezone-page
installer-hostname-page
installer-user-page
- installer-partition-page
+ installer-partitioning-page
installer-services-page
installer-welcome-page
installer-parameters-menu
@@ -86,7 +87,7 @@ (define-record-type* <installer>
;; procedure void -> void
(user-page installer-user-page)
;; procedure void -> void
- (partition-page installer-partition-page)
+ (partitioning-page installer-partitioning-page)
;; procedure void -> void
(services-page installer-services-page)
;; procedure (logo #:pci-database) -> void
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v3 12/17] installer: Fix file-name typos.
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (10 preceding siblings ...)
2024-10-25 9:40 ` [bug#73927] [PATCH v3 11/17] installer: Use "partitioning-page" consistently Janneke Nieuwenhuizen
@ 2024-10-25 9:40 ` Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 13/17] installer: Use `%' for parameter %run-command-in-installer Janneke Nieuwenhuizen
` (4 subsequent siblings)
16 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-25 9:40 UTC (permalink / raw)
To: 73927
* gnu/installer/newt/page.scm (run-dump-page): Typo file-name.
* gnu/installer/utils.scm (open-new-log-port): Likewise.
Change-Id: I837991a0ee5054b3afa8328205e23ac6f9fbae8d
---
gnu/installer/newt/page.scm | 7 ++++---
gnu/installer/utils.scm | 7 ++++---
2 files changed, 8 insertions(+), 6 deletions(-)
diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
index e1623a51fd..64a2916826 100644
--- a/gnu/installer/newt/page.scm
+++ b/gnu/installer/newt/page.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -950,10 +951,10 @@ (define prompt-tag (make-prompt-tag))
('exit-component
(let ((result
(map (match-lambda
- ((edit checkbox filename)
+ ((edit checkbox file-name)
(if (components=? edit argument)
- (abort-to-prompt prompt-tag filename)
- (cons filename (eq? #\x
+ (abort-to-prompt prompt-tag file-name)
+ (cons file-name (eq? #\x
(checkbox-value checkbox))))))
components)))
(destroy-form-and-pop form)
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index 6838410166..c722e9af8f 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.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.
;;;
@@ -283,11 +284,11 @@ (define-syntax syslog
(define (open-new-log-port)
(define now (localtime (time-second (current-time))))
- (define filename
+ (define file-name
(format #f "/tmp/installer.~a.log"
(strftime "%F.%T" now)))
- (open filename (logior O_RDWR
- O_CREAT)))
+ (open file-name (logior O_RDWR
+ O_CREAT)))
(define installer-log-port
(let ((port #f))
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v3 13/17] installer: Use `%' for parameter %run-command-in-installer.
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (11 preceding siblings ...)
2024-10-25 9:40 ` [bug#73927] [PATCH v3 12/17] installer: Fix file-name typos Janneke Nieuwenhuizen
@ 2024-10-25 9:40 ` Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 14/17] installer: Add dry-run? Janneke Nieuwenhuizen
` (3 subsequent siblings)
16 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-25 9:40 UTC (permalink / raw)
To: 73927
* gnu/installer/utils.scm (run-command-in-installer): Rename to...
(%run-command-in-installer): ...this.
* gnu/installer.scm (installer-program): Update accordingly.
* gnu/installer/parted.scm (remove-logical-devices, create-btrfs-file-system,
create-ext4-file-system, create-fat16-file-system, create-fat32-file-system,
create-jfs-file-system, create-ntfs-file-system, create-xfs-file-system,
create-swap-partition, luks-format-and-open, luks-ensure-open, luks-close):
Update accordingly.
Change-Id: I96ebc59ebc85fd8ebccb0cc57130b4e7532d287f
---
gnu/installer.scm | 2 +-
gnu/installer/parted.scm | 27 ++++++++++++++-------------
gnu/installer/utils.scm | 6 +++---
3 files changed, 18 insertions(+), 17 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 3a05843cab..21809e4259 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -465,7 +465,7 @@ (define steps (#$steps current-installer))
(installer-init current-installer)
(lambda ()
(parameterize
- ((run-command-in-installer
+ ((%run-command-in-installer
(installer-run-command current-installer)))
(catch #t
(lambda ()
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index dbdec1bba8..e59df3d8e6 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2019-2020, 2022, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -363,7 +364,7 @@ (define* (force-device-sync device)
(define (remove-logical-devices)
"Remove all active logical devices."
- ((run-command-in-installer) "dmsetup" "remove_all"))
+ ((%run-command-in-installer) "dmsetup" "remove_all"))
(define (installer-root-partition-path)
"Return the root partition path, or #f if it could not be detected."
@@ -1183,7 +1184,7 @@ (define (set-user-partitions-file-name user-partitions)
(define (create-btrfs-file-system partition)
"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-ext4-file-system partition)
"Create an ext4 file-system for PARTITION file-name."
@@ -1192,32 +1193,32 @@ (define (create-ext4-file-system partition)
;; up and adding new files would fail with ENOSPC despite there being plenty
;; of free space and inodes:
;; <https://blog.merovius.de/posts/2013-10-20-ext4-mysterious-no-space-left-on/>.
- ((run-command-in-installer) "mkfs.ext4" "-F" partition
+ ((%run-command-in-installer) "mkfs.ext4" "-F" partition
"-O" "large_dir"))
(define (create-fat16-file-system partition)
"Create a fat16 file-system for PARTITION file-name."
- ((run-command-in-installer) "mkfs.fat" "-F16" partition))
+ ((%run-command-in-installer) "mkfs.fat" "-F16" partition))
(define (create-fat32-file-system partition)
"Create a fat32 file-system for PARTITION file-name."
- ((run-command-in-installer) "mkfs.fat" "-F32" partition))
+ ((%run-command-in-installer) "mkfs.fat" "-F32" partition))
(define (create-jfs-file-system partition)
"Create a JFS file-system for PARTITION file-name."
- ((run-command-in-installer) "jfs_mkfs" "-f" partition))
+ ((%run-command-in-installer) "jfs_mkfs" "-f" partition))
(define (create-ntfs-file-system partition)
"Create a JFS file-system for PARTITION file-name."
- ((run-command-in-installer) "mkfs.ntfs" "-F" "-f" partition))
+ ((%run-command-in-installer) "mkfs.ntfs" "-F" "-f" partition))
(define (create-xfs-file-system partition)
"Create an XFS file-system for PARTITION file-name."
- ((run-command-in-installer) "mkfs.xfs" "-f" partition))
+ ((%run-command-in-installer) "mkfs.xfs" "-f" partition))
(define (create-swap-partition partition)
"Set up swap area on PARTITION file-name."
- ((run-command-in-installer) "mkswap" "-f" partition))
+ ((%run-command-in-installer) "mkswap" "-f" partition))
(define (call-with-luks-key-file password proc)
"Write PASSWORD in a temporary file and pass it to PROC as argument."
@@ -1246,9 +1247,9 @@ (define (luks-format-and-open user-partition)
(lambda (key-file)
(installer-log-line "formatting and opening LUKS entry ~s at ~s"
label file-name)
- ((run-command-in-installer) "cryptsetup" "-q" "luksFormat"
+ ((%run-command-in-installer) "cryptsetup" "-q" "luksFormat"
file-name key-file)
- ((run-command-in-installer) "cryptsetup" "open" "--type" "luks"
+ ((%run-command-in-installer) "cryptsetup" "open" "--type" "luks"
"--key-file" key-file file-name label)))))
(define (luks-ensure-open user-partition)
@@ -1262,14 +1263,14 @@ (define (luks-ensure-open user-partition)
(lambda (key-file)
(installer-log-line "opening LUKS entry ~s at ~s"
label file-name)
- ((run-command-in-installer) "cryptsetup" "open" "--type" "luks"
+ ((%run-command-in-installer) "cryptsetup" "open" "--type" "luks"
"--key-file" key-file file-name label))))))
(define (luks-close user-partition)
"Close the encrypted partition pointed by USER-PARTITION."
(let ((label (user-partition-crypt-label user-partition)))
(installer-log-line "closing LUKS entry ~s" label)
- ((run-command-in-installer) "cryptsetup" "close" label)))
+ ((%run-command-in-installer) "cryptsetup" "close" label)))
(define (format-user-partitions user-partitions)
"Format the <user-partition> records in USER-PARTITIONS list with
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index c722e9af8f..170f036537 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -50,7 +50,7 @@ (define-module (gnu installer utils)
run-external-command-with-handler/tty
run-external-command-with-line-hooks
run-command
- run-command-in-installer
+ %run-command-in-installer
syslog-port
%syslog-line-hook
@@ -222,13 +222,13 @@ (define succeeded?
(pause)
succeeded?)
-(define run-command-in-installer
+(define %run-command-in-installer
(make-parameter
(lambda (. args)
(raise
(condition
(&serious)
- (&message (message "run-command-in-installer not set")))))))
+ (&message (message "%run-command-in-installer not set")))))))
\f
;;;
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v3 14/17] installer: Add dry-run?
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (12 preceding siblings ...)
2024-10-25 9:40 ` [bug#73927] [PATCH v3 13/17] installer: Use `%' for parameter %run-command-in-installer Janneke Nieuwenhuizen
@ 2024-10-25 9:40 ` Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 15/17] installer: Add "Kernel" page to select the Hurd Janneke Nieuwenhuizen
` (2 subsequent siblings)
16 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-25 9:40 UTC (permalink / raw)
To: 73927
This allows running the installer without root privileges. Do something like
./pre-inst-env guix repl
,use (guix)
,use (gnu installer)
(installer-program #:dry-run? #t)
,build $1
=>
"/gnu/store/...-installer-program"
and run
/gnu/store/...-installer-program
* gnu/installer/newt.scm (locale-page): Add #:dry-run? parameter.
(keymap-page): Likewise.
* gnu/installer/newt/keymap.scm (run-keymap-page): Likewise.
* gnu/installer/steps.scm (run-installer-steps): Likewise. Use it to skip
writing to socket.
* gnu/installer/newt/final.scm (run-final-page): Rename to...
(run-final-page-install): ...this.
(dry-run-final-page, run-final-page): New procedures.
* gnu/installer/parted.scm (bootloader-configuration): Cater for empty user
partitions.
* gnu/installer/utils.scm (dry-run-command): New procedure.
* gnu/installer.scm (compute-locale-step): Add #:dry-run? parameter. Use it
to avoid actually applying locale.
(compute-keymap-step): Add dry-run? parameter. Pass it to
keymap-page.
(installer-program): Add #:dry-run? parameter. If #:true
avoid writing to /proc, use dry-run-command, skip sync and reboot, and pass
dry-run? to...
(installer-steps): ...here. Add #:dry-run? parameter. Use it to disable
skip network, substitutes, partitioning pages, and pass it to...
compute-locale-step, compute-keymap-step, and final-page.
Change-Id: I0ff4c3b0a0c69539af617c27ba37654beed44619
---
gnu/installer.scm | 81 ++++++++++++++++++++------------
gnu/installer/newt.scm | 14 +++---
gnu/installer/newt/final.scm | 20 +++++++-
gnu/installer/newt/keymap.scm | 5 +-
gnu/installer/newt/locale.scm | 6 ++-
gnu/installer/newt/partition.scm | 1 +
gnu/installer/parted.scm | 29 +++++++-----
gnu/installer/steps.scm | 16 +++++--
gnu/installer/utils.scm | 4 ++
9 files changed, 116 insertions(+), 60 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 21809e4259..39a83c4455 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -134,7 +134,8 @@ (define apply-locale
(define* (compute-locale-step #:key
locales-name
iso639-languages-name
- iso3166-territories-name)
+ iso3166-territories-name
+ dry-run?)
"Return a gexp that run the locale-page of INSTALLER, and install the
selected locale. The list of locales, languages and territories passed to
locale-page are computed in derivations named respectively LOCALES-NAME,
@@ -177,8 +178,11 @@ (define (compiled-file-loader file name)
((installer-locale-page current-installer)
#:supported-locales #$locales-loader
#:iso639-languages #$iso639-loader
- #:iso3166-territories #$iso3166-loader)))
- (#$apply-locale result)
+ #:iso3166-territories #$iso3166-loader
+ #:dry-run? #$dry-run?)))
+ (if #$dry-run?
+ '()
+ (#$apply-locale result))
result))))
(define apply-keymap
@@ -188,7 +192,7 @@ (define apply-keymap
(kmscon-update-keymap (default-keyboard-model)
layout variant options))))
-(define* (compute-keymap-step context)
+(define (compute-keymap-step context dry-run?)
"Return a gexp that runs the keymap-page of INSTALLER and install the
selected keymap."
#~(lambda (current-installer)
@@ -200,15 +204,16 @@ (define* (compute-keymap-step context)
"/share/X11/xkb/rules/base.xml")))
(lambda (models layouts)
((installer-keymap-page current-installer)
- layouts '#$context)))))
+ layouts '#$context #$dry-run?)))))
(and result (#$apply-keymap result))
result)))
-(define (installer-steps)
+(define* (installer-steps #:key dry-run?)
(let ((locale-step (compute-locale-step
#:locales-name "locales"
#:iso639-languages-name "iso639-languages"
- #:iso3166-territories-name "iso3166-territories"))
+ #:iso3166-territories-name "iso3166-territories"
+ #:dry-run? dry-run?))
(timezone-data #~(string-append #$tzdata
"/share/zoneinfo/zone.tab")))
#~(lambda (current-installer)
@@ -216,7 +221,7 @@ (define (installer-steps)
(lambda ()
((installer-parameters-page current-installer)
(lambda _
- (#$(compute-keymap-step 'param)
+ (#$(compute-keymap-step 'param dry-run?)
current-installer)))))
(list
;; Ask the user to choose a locale among those supported by
@@ -262,8 +267,10 @@ (define (installer-steps)
(id 'keymap)
(description (G_ "Keyboard mapping selection"))
(compute (lambda _
- (#$(compute-keymap-step 'default)
- current-installer)))
+ (if #$dry-run?
+ '("en" "US" #f)
+ (#$(compute-keymap-step 'default dry-run?)
+ current-installer))))
(configuration-formatter keyboard-layout->configuration))
;; Ask the user to input a hostname for the system.
@@ -280,14 +287,18 @@ (define (installer-steps)
(id 'network)
(description (G_ "Network selection"))
(compute (lambda _
- ((installer-network-page current-installer)))))
+ (if #$dry-run?
+ '()
+ ((installer-network-page current-installer))))))
;; Ask whether to enable substitute server discovery.
(installer-step
(id 'substitutes)
(description (G_ "Substitute server discovery"))
(compute (lambda _
- ((installer-substitutes-page current-installer)))))
+ (if #$dry-run?
+ '()
+ ((installer-substitutes-page current-installer))))))
;; Prompt for users (name, group and home directory).
(installer-step
@@ -313,7 +324,9 @@ (define (installer-steps)
(id 'partition)
(description (G_ "Partitioning"))
(compute (lambda _
- ((installer-partitioning-page current-installer))))
+ (if #$dry-run?
+ '()
+ ((installer-partitioning-page current-installer)))))
(configuration-formatter user-partitions->configuration))
(installer-step
@@ -322,7 +335,7 @@ (define (installer-steps)
(compute
(lambda (result prev-steps)
((installer-final-page current-installer)
- result prev-steps))))))))
+ result prev-steps #$dry-run?))))))))
(define (provenance-sexp)
"Return an sexp representing the currently-used channels, for logging
@@ -343,7 +356,7 @@ (define (provenance-sexp)
`(channel ,(channel-name channel) ,url ,(channel-commit channel))))
channels))))
-(define (installer-program)
+(define* (installer-program #:key dry-run?)
"Return a file-like object that runs the given INSTALLER."
(define init-gettext
;; Initialize gettext support, so that installer messages can be
@@ -377,7 +390,7 @@ (define set-installer-path
(lambda ()
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)))))
- (define steps (installer-steps))
+ (define steps (installer-steps #:dry-run? dry-run?))
(define modules
(scheme-modules*
(string-append (current-source-directory) "/..")
@@ -425,9 +438,10 @@ (define installer-builder
;; Enable core dump generation.
(setrlimit 'core #f #f)
- (call-with-output-file "/proc/sys/kernel/core_pattern"
- (lambda (port)
- (format port %core-dump)))
+ (unless #$dry-run?
+ (call-with-output-file "/proc/sys/kernel/core_pattern"
+ (lambda (port)
+ (format port %core-dump))))
;; Initialize gettext support so that installers can use
;; (guix i18n) module.
@@ -466,24 +480,29 @@ (define steps (#$steps current-installer))
(lambda ()
(parameterize
((%run-command-in-installer
- (installer-run-command current-installer)))
+ (if #$dry-run?
+ dry-run-command
+ (installer-run-command current-installer))))
(catch #t
(lambda ()
(define results
(run-installer-steps
#:rewind-strategy 'menu
#:menu-proc (installer-menu-page current-installer)
- #:steps steps))
-
- (match (result-step results 'final)
- ('success
- ;; We did it! Let's reboot!
- (sync)
- (stop-service 'root))
- (_
- ;; The installation failed, exit so that it is
- ;; restarted by login.
- #f)))
+ #:steps steps
+ #:dry-run? #$dry-run?))
+
+ (let ((result (result-step results 'final)))
+ (unless #$dry-run?
+ (match (result-step results 'final)
+ ('success
+ ;; We did it! Let's reboot!
+ (sync)
+ (stop-service 'root))
+ (_
+ ;; The installation failed, exit so that it is
+ ;; restarted by login.
+ #f)))))
(const #f)
(lambda (key . args)
(installer-log-line "crashing due to uncaught exception: ~s ~s"
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index 6d8ea35fff..d53bc058b3 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -158,17 +158,19 @@ (define stop-sig (status:stop-sig result))
(term-signal term-sig)
(stop-signal stop-sig)))))))))))
-(define (final-page result prev-steps)
- (run-final-page result prev-steps))
+(define (final-page result prev-steps dry-run?)
+ (run-final-page result prev-steps dry-run?))
(define* (locale-page #:key
supported-locales
iso639-languages
- iso3166-territories)
+ iso3166-territories
+ dry-run?)
(run-locale-page
#:supported-locales supported-locales
#:iso639-languages iso639-languages
- #:iso3166-territories iso3166-territories))
+ #:iso3166-territories iso3166-territories
+ #:dry-run? dry-run?))
(define (timezone-page zonetab)
(run-timezone-page zonetab))
@@ -179,8 +181,8 @@ (define* (welcome-page logo #:key pci-database)
(define (menu-page steps)
(run-menu-page steps))
-(define* (keymap-page layouts context)
- (run-keymap-page layouts #:context context))
+(define (keymap-page layouts context dry-run?)
+ (run-keymap-page layouts #:context context #:dry-run? dry-run?))
(define (network-page)
(run-network-page))
diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
index 9f950a0551..c4e53f6d79 100644
--- a/gnu/installer/newt/final.scm
+++ b/gnu/installer/newt/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 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -106,7 +107,7 @@ (define* (run-install-shell locale
(newt-resume)
install-ok?))
-(define (run-final-page result prev-steps)
+(define (run-final-page-install result prev-steps)
(define (wait-for-clients)
(unless (null? (current-clients))
(installer-log-line "waiting with clients before starting final step")
@@ -133,3 +134,20 @@ (define (wait-for-clients)
(if install-ok?
(run-install-success-page)
(run-install-failed-page))))
+
+(define (dry-run-final-page result prev-steps)
+ (installer-log-line "proceeding with final step -- dry-run")
+ (let* ((configuration (format-configuration prev-steps result))
+ (user-partitions (result-step result 'partition))
+ (locale (result-step result 'locale))
+ (users (result-step result 'user))
+ (file (configuration->file configuration))
+ (install-ok? (run-config-display-page #:locale locale)))
+ (if install-ok?
+ (run-install-success-page)
+ (run-install-failed-page))))
+
+(define (run-final-page result prev-steps dry-run?)
+ (if dry-run?
+ (dry-run-final-page result prev-steps)
+ (run-final-page-install result prev-steps)))
diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm
index 109ec55e0a..57f6d6530c 100644
--- a/gnu/installer/newt/keymap.scm
+++ b/gnu/installer/newt/keymap.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -153,7 +154,7 @@ (define (toggleable-latin-layout layout variant)
"grp:alt_shift_toggle"))
(list layout variant #f)))
-(define* (run-keymap-page layouts #:key (context #f))
+(define* (run-keymap-page layouts #:key context dry-run?)
"Run a page asking the user to select a keyboard layout and variant. LAYOUTS
is a list of supported X11-KEYMAP-LAYOUT. For non-Latin keyboard layouts, a
second layout and toggle options will be added automatically. Return a list
@@ -201,7 +202,7 @@ (define (format-result layout variant)
"xkeyboard-config")))))
(toggleable-latin-layout layout variant)))
- (let* ((result (run-installer-steps #:steps keymap-steps))
+ (let* ((result (run-installer-steps #:steps keymap-steps #:dry-run? dry-run?))
(layout (result-step result 'layout))
(variant (result-step result 'variant)))
(and layout
diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm
index a226b39ba6..0be9db449e 100644
--- a/gnu/installer/newt/locale.scm
+++ b/gnu/installer/newt/locale.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -92,7 +93,8 @@ (define (run-modifier-page modifiers modifier->text)
(define* (run-locale-page #:key
supported-locales
iso639-languages
- iso3166-territories)
+ iso3166-territories
+ dry-run?)
"Run a page asking the user to select a locale language and possibly
territory, codeset and modifier. Use SUPPORTED-LOCALES as the list of glibc
available locales. ISO639-LANGUAGES is an association list associating a
@@ -212,4 +214,4 @@ (define locale-steps
;; step, turn the result into a glibc locale string and return it.
(result->locale-string
supported-locales
- (run-installer-steps #:steps locale-steps)))
+ (run-installer-steps #:steps locale-steps #:dry-run? dry-run?)))
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index 37656696c1..48dd306080 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2018, 2019, 2022 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index e59df3d8e6..b36b238d8b 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -1461,19 +1461,22 @@ (define (root-user-partition? partition)
(define (bootloader-configuration user-partitions)
"Return the bootloader configuration field for USER-PARTITIONS."
- (let* ((root-partition (find root-user-partition?
- user-partitions))
- (root-partition-disk (user-partition-disk-file-name root-partition)))
- `((bootloader-configuration
- ,@(if (efi-installation?)
- `((bootloader grub-efi-bootloader)
- (targets (list ,(default-esp-mount-point))))
- `((bootloader grub-bootloader)
- (targets (list ,root-partition-disk))))
-
- ;; XXX: Assume we defined the 'keyboard-layout' field of
- ;; <operating-system> right above.
- (keyboard-layout keyboard-layout)))))
+ (let ((root-partition (find root-user-partition? user-partitions)))
+ (match user-partitions
+ (() '())
+ (_
+ (let ((root-partition-disk (user-partition-disk-file-name
+ root-partition)))
+ `((bootloader-configuration
+ ,@(if (efi-installation?)
+ `((bootloader grub-efi-bootloader)
+ (targets (list ,(default-esp-mount-point))))
+ `((bootloader grub-bootloader)
+ (targets (list ,root-partition-disk))))
+
+ ;; XXX: Assume we defined the 'keyboard-layout' field of
+ ;; <operating-system> right above.
+ (keyboard-layout keyboard-layout))))))))
(define (user-partition-missing-modules user-partitions)
"Return the list of kernel modules missing from the default set of kernel
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
index 0c505e40e4..de0a852f02 100644
--- a/gnu/installer/steps.scm
+++ b/gnu/installer/steps.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -84,7 +85,8 @@ (define-record-type* <installer-step>
(define* (run-installer-steps #:key
steps
(rewind-strategy 'previous)
- (menu-proc (const #f)))
+ (menu-proc (const #f))
+ dry-run?)
"Run the COMPUTE procedure of all <installer-step> records in STEPS
sequentially, inside a the 'installer-step prompt. When aborted to with a
parameter of 'abort, fallback to a previous install-step, accordingly to the
@@ -191,10 +193,14 @@ (define* (run result #:key todo-steps done-steps)
;; prematurely.
(sigaction SIGPIPE SIG_IGN)
- (with-server-socket
- (run '()
- #:todo-steps steps
- #:done-steps '())))
+ (if dry-run?
+ (run '()
+ #:todo-steps steps
+ #:done-steps '())
+ (with-server-socket
+ (run '()
+ #:todo-steps steps
+ #:done-steps '()))))
(define (find-step-by-id steps id)
"Find and return the step in STEPS whose id is equal to ID."
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index 170f036537..a8eb6cee83 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -49,6 +49,7 @@ (define-module (gnu installer utils)
run-external-command-with-handler
run-external-command-with-handler/tty
run-external-command-with-line-hooks
+ dry-run-command
run-command
%run-command-in-installer
@@ -222,6 +223,9 @@ (define succeeded?
(pause)
succeeded?)
+(define (dry-run-command . args)
+ (format #t "dry-run-command: skipping: ~a\n" args))
+
(define %run-command-in-installer
(make-parameter
(lambda (. args)
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v3 15/17] installer: Add "Kernel" page to select the Hurd.
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (13 preceding siblings ...)
2024-10-25 9:40 ` [bug#73927] [PATCH v3 14/17] installer: Add dry-run? Janneke Nieuwenhuizen
@ 2024-10-25 9:40 ` Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 16/17] installer: Add static-networking template Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 17/17] installer: Support dry-run from Guile via store Janneke Nieuwenhuizen
16 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-25 9:40 UTC (permalink / raw)
To: 73927
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 (efi-installation?): Return #f when installing for
the Hurd.
(create-ext2-file-system): New procedure.
(user-fs-type-name, user-fs-type->mount-type, partition-filesystem-user-type,
format-user-partitions): Support `ext2'.
(<user-partition> partition->user-partition): Use `ext2' when installing the
Hurd.
(auto-partition!): Likewise. No swap partition when installing the Hurd.
* gnu/installer/final.scm (install-system): Cater for cross installation of
the Hurd.
(bootloader-configuration): Use `grub-minimal-bootloader' when installing the
Hurd.
(user-partition-missing-modules): Cater for empty user-partitions.
(initrd-configuration, user-partitions->configuration): Cater for the Hurd.
* gnu/installer/steps.scm (format-configuration,
configuration->file): Cater for the Hurd.
* gnu/system/hurd.scm (%desktop-services/hurd): New variable.
* gnu/installer/tests.scm (choose-kernel): New procedure.
* gnu/tests/install.scm (gui-test-program): Use it.
Change-Id: Ifafb27b8a2f933944c77223a27ec151757237e36
---
gnu/installer.scm | 14 +++++++
gnu/installer/final.scm | 10 ++++-
gnu/installer/kernel.scm | 41 ++++++++++++++++++++
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 | 65 +++++++++++++++++++++++---------
gnu/installer/record.scm | 3 ++
gnu/installer/services.scm | 46 +++++++++++++++++-----
gnu/installer/steps.scm | 14 ++++---
gnu/installer/tests.scm | 11 ++++++
gnu/local.mk | 2 +
gnu/system/hurd.scm | 3 ++
gnu/tests/install.scm | 6 ++-
15 files changed, 256 insertions(+), 49 deletions(-)
create mode 100644 gnu/installer/kernel.scm
create mode 100644 gnu/installer/newt/kernel.scm
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 39a83c4455..31c0ff7ff4 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -308,6 +308,18 @@ (define* (installer-steps #:key dry-run?)
((installer-user-page current-installer))))
(configuration-formatter users->configuration))
+ ;; Ask the user to select the kernel for the system,
+ ;; for x86 systems only.
+ (installer-step
+ (id 'kernel)
+ (description (G_ "Kernel"))
+ (compute (lambda _
+ (if (target-x86?)
+ ((installer-kernel-page current-installer))
+ '())))
+ (configuration-formatter (lambda (result)
+ (kernel->configuration result #$dry-run?))))
+
;; Ask the user to choose one or many desktop environment(s).
(installer-step
(id 'services)
@@ -419,6 +431,7 @@ (define installer-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)
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 (assert-exit x)
"/tmp/installer-system-init-options"
read))
(const '())))
- (install-command (append (list "guix" "system" "init"
- "--fallback")
+ (install-command (append `( "guix" "system" "init"
+ "--fallback"
+ ,@(if (target-hurd?)
+ '("--target=i586-pc-gnu"
+ "--skip-checks")
+ '()))
options
(list (%installer-configuration-file)
(%installer-target-dir))))
diff --git a/gnu/installer/kernel.scm b/gnu/installer/kernel.scm
new file mode 100644
index 0000000000..c82b06fb83
--- /dev/null
+++ b/gnu/installer/kernel.scm
@@ -0,0 +1,41 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu installer kernel)
+ #:use-module (gnu system hurd)
+ #:use-module (guix read-print)
+ #:export (kernel->configuration))
+
+(define-syntax-rule (G_ str)
+ ;; In this file, translatable strings are annotated with 'G_' so xgettext
+ ;; catches them, but translation happens later on at run time.
+ str)
+
+(define (kernel->configuration kernel dry-run?)
+ (if (equal? kernel "Hurd")
+ `((kernel %hurd-default-operating-system-kernel)
+ ,(comment (G_ ";; \"noide\" disables the gnumach IDE driver, enabling rumpdisk.\n"))
+ (kernel-arguments '("noide"))
+ (firmware '())
+ (hurd hurd)
+ (locale-libcs (list glibc/hurd))
+ (name-service-switch #f)
+ (essential-services (hurd-default-essential-services this-operating-system))
+ (privileged-programs '())
+ (setuid-programs %setuid-programs/hurd))
+ '()))
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index d53bc058b3..1fe710340f 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -25,6 +25,7 @@ (define-module (gnu installer newt)
#:use-module (gnu installer newt final)
#:use-module (gnu installer newt parameters)
#:use-module (gnu installer newt hostname)
+ #:use-module (gnu installer newt kernel)
#:use-module (gnu installer newt keymap)
#:use-module (gnu installer newt locale)
#:use-module (gnu installer newt menu)
@@ -193,6 +194,9 @@ (define (substitutes-page)
(define (hostname-page)
(run-hostname-page))
+(define (kernel-page)
+ (run-kernel-page))
+
(define (user-page)
(run-user-page))
@@ -216,6 +220,7 @@ (define newt-installer
(exit-error exit-error)
(final-page final-page)
(keymap-page keymap-page)
+ (kernel-page kernel-page)
(locale-page locale-page)
(menu-page menu-page)
(network-page network-page)
diff --git a/gnu/installer/newt/kernel.scm b/gnu/installer/newt/kernel.scm
new file mode 100644
index 0000000000..3117247312
--- /dev/null
+++ b/gnu/installer/newt/kernel.scm
@@ -0,0 +1,45 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu installer newt kernel)
+ #:use-module (gnu installer newt page)
+ #:use-module (guix i18n)
+ #:use-module (guix utils)
+ #:export (run-kernel-page))
+
+(define (run-kernel-page)
+ (let* ((kernels `(,@(if (target-x86?) '("Hurd") '())
+ "Linux Libre"))
+ (result
+ (run-listbox-selection-page
+ #:title (G_ "Kernel")
+ #:info-text
+ (G_ "Please select a kernel. When in doubt, choose \"Linux Libre\".
+The Hurd is offered as a technology preview and development aid; many packages \
+are not yet available in Guix, such as a desktop environment or even a windowing \
+system (X, Wayland).")
+ #:listbox-items kernels
+ #:listbox-item->text identity
+ #:listbox-default-item "Linux Libre"
+ #:button-text (G_ "Back")
+ #:button-callback-procedure
+ (lambda _
+ (abort-to-prompt 'installer-step 'abort)))))
+ (when (equal? result "Hurd")
+ (%current-target-system "i586-pc-gnu"))
+ result))
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index 48dd306080..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..dfdd4ed60f 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -152,7 +152,7 @@ (define-record-type* <user-partition>
(crypt-password user-partition-crypt-password ; <secret>
(default #f))
(fs-type user-partition-fs-type
- (default 'ext4))
+ (default (if (target-hurd?) 'ext2 'ext4)))
(bootable? user-partition-bootable?
(default #f))
(esp? user-partition-esp?
@@ -223,11 +223,13 @@ (define default-esp-mount-point
(define (efi-installation?)
"Return #t if an EFI installation should be performed, #f otherwise."
- (file-exists? "/sys/firmware/efi"))
+ (and (file-exists? "/sys/firmware/efi")
+ (not (target-hurd?))))
(define (user-fs-type-name fs-type)
"Return the name of FS-TYPE as specified by libparted."
(case fs-type
+ ((ext2) "ext2")
((ext4) "ext4")
((btrfs) "btrfs")
((fat16) "fat16")
@@ -240,6 +242,7 @@ (define (user-fs-type-name fs-type)
(define (user-fs-type->mount-type fs-type)
"Return the mount type of FS-TYPE."
(case fs-type
+ ((ext2) "ext2")
((ext4) "ext4")
((btrfs) "btrfs")
((fat16) "vfat")
@@ -255,6 +258,7 @@ (define (partition-filesystem-user-type partition)
(and fs-type
(let ((name (filesystem-type-name fs-type)))
(cond
+ ((string=? name "ext2") 'ext2)
((string=? name "ext4") 'ext4)
((string=? name "btrfs") 'btrfs)
((string=? name "fat16") 'fat16)
@@ -296,7 +300,7 @@ (define (partition->user-partition partition)
(file-name (partition-get-path partition))
(disk-file-name (device-path device))
(fs-type (or (partition-filesystem-user-type partition)
- 'ext4))
+ (if (target-hurd?) 'ext2 'ext4)))
(mount-point (and (esp-partition? partition)
(default-esp-mount-point)))
(bootable? (boot-partition? partition))
@@ -1053,7 +1057,7 @@ (define* (auto-partition! disk
(size new-esp-size)
(mount-point (default-esp-mount-point))))
(user-partition
- (fs-type 'ext4)
+ (fs-type (if (target-hurd?) 'ext2 'ext4))
(bootable? #t)
(bios-grub? #t)
(size bios-grub-size))))
@@ -1065,13 +1069,13 @@ (define* (auto-partition! disk
`(,@(if start-partition
`(,start-partition)
'())
- ,@(if encrypted?
+ ,@(if (or encrypted? (target-hurd?))
'()
`(,(user-partition
(fs-type 'swap)
(size swap-size))))
,(user-partition
- (fs-type 'ext4)
+ (fs-type (if (target-hurd?) 'ext2 'ext4))
(bootable? has-extended?)
(crypt-label (and encrypted? "cryptroot"))
(size "100%")
@@ -1083,7 +1087,7 @@ (define* (auto-partition! disk
`(,start-partition)
'())
,(user-partition
- (fs-type 'ext4)
+ (fs-type (if (target-hurd?) 'ext2 'ext4))
(bootable? has-extended?)
(crypt-label (and encrypted? "cryptroot"))
(size "33%")
@@ -1105,7 +1109,7 @@ (define* (auto-partition! disk
(type (if has-extended?
'logical
'normal))
- (fs-type 'ext4)
+ (fs-type (if (target-hurd?) 'ext2 'ext4))
(crypt-label (and encrypted? "crypthome"))
(size "100%")
(mount-point "/home")))))))
@@ -1186,6 +1190,15 @@ (define (create-btrfs-file-system partition)
"Create a btrfs file-system for PARTITION file-name."
((%run-command-in-installer) "mkfs.btrfs" "-f" partition))
+(define (create-ext2-file-system partition)
+ "Create an ext2 file-system for PARTITION file-name, when TARGET-HURD?,
+for the Hurd."
+ (apply (%run-command-in-installer)
+ `("mkfs.ext2" ,@(if (target-hurd?)
+ '("-o" "hurd")
+ '())
+ "-F" ,partition)))
+
(define (create-ext4-file-system partition)
"Create an ext4 file-system for PARTITION file-name."
;; Enable the 'large_dir' feature so users can have a store of several TiBs.
@@ -1291,6 +1304,10 @@ (define (format-user-partitions user-partitions)
(and need-formatting?
(not (eq? type 'extended))
(create-btrfs-file-system file-name)))
+ ((ext2)
+ (and need-formatting?
+ (not (eq? type 'extended))
+ (create-ext2-file-system file-name)))
((ext4)
(and need-formatting?
(not (eq? type 'extended))
@@ -1463,7 +1480,11 @@ (define (bootloader-configuration user-partitions)
"Return the bootloader configuration field for USER-PARTITIONS."
(let ((root-partition (find root-user-partition? user-partitions)))
(match user-partitions
- (() '())
+ (() (if (target-hurd?)
+ '(bootloader-configuration
+ (bootloader grub-minimal-bootloader)
+ (targets "/dev/sdaX"))
+ '()))
(_
(let ((root-partition-disk (user-partition-disk-file-name
root-partition)))
@@ -1471,7 +1492,9 @@ (define (bootloader-configuration user-partitions)
,@(if (efi-installation?)
`((bootloader grub-efi-bootloader)
(targets (list ,(default-esp-mount-point))))
- `((bootloader grub-bootloader)
+ `((bootloader ,(if (target-hurd?)
+ 'grub-minimal-bootloader
+ 'grub-bootloader))
(targets (list ,root-partition-disk))))
;; XXX: Assume we defined the 'keyboard-layout' field of
@@ -1491,22 +1514,28 @@ (define (user-partition-missing-modules user-partitions)
(const '())))
(delete-duplicates
(map user-partition-file-name
- (cons root devices)))))))
+ (filter identity
+ (cons root devices))))))))
(define (initrd-configuration user-partitions)
"Return an 'initrd-modules' field with everything needed for
USER-PARTITIONS, or return nothing."
- (match (user-partition-missing-modules user-partitions)
- (()
- '())
- ((modules ...)
- `((initrd-modules (append ',modules
- %base-initrd-modules))))))
+ (if (target-hurd?)
+ '((initrd #f)
+ (initrd-modules '()))
+ (match (user-partition-missing-modules user-partitions)
+ (()
+ '())
+ ((modules ...)
+ `((initrd-modules (append ',modules
+ %base-initrd-modules)))))))
(define (user-partitions->configuration user-partitions)
"Return the configuration field for USER-PARTITIONS."
(let* ((swap-user-partitions (find-swap-user-partitions user-partitions))
- (swap-devices (map user-partition-file-name swap-user-partitions))
+ (swap-devices (if (target-hurd?)
+ '()
+ (map user-partition-file-name swap-user-partitions)))
(encrypted-partitions
(filter user-partition-crypt-label user-partitions)))
`((bootloader ,@(bootloader-configuration user-partitions))
diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm
index 334af44a0c..22adad279c 100644
--- a/gnu/installer/record.scm
+++ b/gnu/installer/record.scm
@@ -30,6 +30,7 @@ (define-module (gnu installer record)
installer-exit
installer-exit-error
installer-final-page
+ installer-kernel-page
installer-keymap-page
installer-locale-page
installer-menu-page
@@ -69,6 +70,8 @@ (define-record-type* <installer>
(exit-error installer-exit-error)
;; procedure void -> void
(final-page installer-final-page)
+ ;; procedure void -> void
+ (kernel-page installer-kernel-page)
;; procedure (layouts context) -> (list layout variant options)
(keymap-page installer-keymap-page)
;; procedure: (#:key supported-locales iso639-languages iso3166-territories)
diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm
index 1cb9dc579c..d5a382606c 100644
--- a/gnu/installer/services.scm
+++ b/gnu/installer/services.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2022 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2021 Leo Famulari <leo@famulari.name>
;;; Copyright © 2023 Denys Nykula <vegan@libre.net.ua>
@@ -24,6 +24,7 @@
(define-module (gnu installer services)
#:use-module (guix records)
#:use-module (guix read-print)
+ #:use-module (guix utils)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:export (system-service?
@@ -34,6 +35,7 @@ (define-module (gnu installer services)
system-service-packages
desktop-system-service?
+ system-service-none
%system-services
system-services->configuration))
@@ -55,7 +57,13 @@ (define-record-type* <system-service>
(packages system-service-packages ;list of sexps
(default '())))
-(define %system-services
+(define system-service-none
+ (system-service
+ (name (G_ "None"))
+ (type 'network-management)
+ (snippet '())))
+
+(define (%system-services)
(let-syntax ((desktop-environment (syntax-rules ()
((_ fields ...)
(system-service
@@ -105,7 +113,11 @@ (define %system-services
(G_ "\
;; To configure OpenSSH, pass an 'openssh-configuration'
;; record as a second argument to 'service' below.\n"))
- (service openssh-service-type))))
+ ,(if (target-hurd?)
+ '(service openssh-service-type
+ (openssh-configuration
+ (openssh openssh-sans-x)))
+ '(service openssh-service-type)))))
(system-service
(name (G_ "Tor anonymous network router"))
(type 'networking)
@@ -115,7 +127,7 @@ (define %system-services
(system-service
(name (G_ "Network time service (NTP), to set the clock automatically"))
(type 'administration)
- (recommended? #t)
+ (recommended? (not (target-hurd?)))
(snippet '((service ntp-service-type))))
(system-service
(name (G_ "GPM mouse daemon, to use the mouse on the console"))
@@ -154,8 +166,12 @@ (define (system-services->configuration services)
(packages (append-map system-service-packages services))
(desktop? (find desktop-system-service? services))
(base (if desktop?
- '%desktop-services
- '%base-services))
+ (if (target-hurd?)
+ '%desktop-services/hurd
+ '%desktop-services)
+ (if (target-hurd?)
+ '%base-services/hurd
+ '%base-services)))
(native-console-font (match (getenv "LANGUAGE")
((or "be" "bg" "el" "eo" "kk" "ky"
"mk" "mn" "ru" "sr" "tg" "uk")
@@ -181,18 +197,28 @@ (define (system-services->configuration services)
(if (null? snippets)
`(,@(if (null? packages)
- '()
+ (if (target-hurd?)
+ `(,@package-heading
+ (packages %base-packages/hurd))
+ '())
`(,@package-heading
(packages (append (list ,@packages)
- %base-packages))))
+ ,(if (target-hurd?)
+ '%base-packages/hurd
+ '%base-packages)))))
,@service-heading
(services ,services))
`(,@(if (null? packages)
- '()
+ (if (target-hurd?)
+ `(,@package-heading
+ (packages %base-packages/hurd))
+ '())
`(,@package-heading
(packages (append (list ,@packages)
- %base-packages))))
+ ,(if (target-hurd?)
+ '%base-packages/hurd
+ '%base-packages)))))
,@service-heading
(services (append (list ,@snippets
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
index de0a852f02..34dd14c9d5 100644
--- a/gnu/installer/steps.scm
+++ b/gnu/installer/steps.scm
@@ -23,6 +23,7 @@ (define-module (gnu installer steps)
#:use-module (guix build utils)
#:use-module (guix i18n)
#:use-module (guix read-print)
+ #:use-module (guix utils)
#:use-module (gnu installer utils)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
@@ -240,17 +241,20 @@ (define (format-configuration steps results)
,(comment (G_ "\
;; Indicate which modules to import to access the variables
;; used in this configuration.\n"))
- (use-modules (gnu))
+ ,@(if (target-hurd?)
+ '((use-modules (gnu) (gnu system hurd))
+ (use-package-modules hurd ssh))
+ '((use-modules (gnu))))
(use-service-modules cups desktop networking ssh xorg))))
`(,@modules
,(vertical-space 1)
(operating-system ,@configuration))))
(define* (configuration->file configuration
- #:key (filename (%installer-configuration-file)))
- "Write the given CONFIGURATION to FILENAME."
- (mkdir-p (dirname filename))
- (call-with-output-file filename
+ #:key (file-name (%installer-configuration-file)))
+ "Write the given CONFIGURATION to FILE-NAME."
+ (mkdir-p (dirname file-name))
+ (call-with-output-file file-name
(lambda (port)
;; TRANSLATORS: This is a comment within a Scheme file. Each line must
;; start with ";; " (two semicolons and a space). Please keep line
diff --git a/gnu/installer/tests.scm b/gnu/installer/tests.scm
index 8785cd9a9f..a9a5d5d988 100644
--- a/gnu/installer/tests.scm
+++ b/gnu/installer/tests.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -35,6 +36,7 @@ (define-module (gnu installer tests)
choose-locale+keyboard
enter-host-name+passwords
+ choose-kernel
choose-services
choose-partitioning
start-installation
@@ -211,6 +213,15 @@ (define* (enter-host-name+passwords port
(password ,password)))
names passwords))))))
+(define* (choose-kernel port #:key (kernel "Linux Libre"))
+ "Converse over PORT with the guided installer to choose the specified
+KERNEL."
+ (converse port
+ ((list-selection (title "Kernel")
+ (multiple-choices? #f)
+ (items _))
+ kernel)))
+
(define* (choose-services port
#:key
(choose-desktop-environment? (const #f))
diff --git a/gnu/local.mk b/gnu/local.mk
index 0a1357f114..d0c9ca595e 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -862,6 +862,7 @@ INSTALLER_MODULES = \
%D%/installer/final.scm \
%D%/installer/hardware.scm \
%D%/installer/hostname.scm \
+ %D%/installer/kernel.scm \
%D%/installer/keymap.scm \
%D%/installer/locale.scm \
%D%/installer/newt.scm \
@@ -880,6 +881,7 @@ INSTALLER_MODULES = \
%D%/installer/newt/final.scm \
%D%/installer/newt/parameters.scm \
%D%/installer/newt/hostname.scm \
+ %D%/installer/newt/kernel.scm \
%D%/installer/newt/keymap.scm \
%D%/installer/newt/locale.scm \
%D%/installer/newt/menu.scm \
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index 283bae6f10..9a351529e8 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -48,6 +48,7 @@ (define-module (gnu system hurd)
#:export (%base-packages/hurd
%base-services/hurd
%base-services+qemu-networking/hurd
+ %desktop-services/hurd
%hurd-default-operating-system
%hurd-default-operating-system-kernel
%setuid-programs/hurd))
@@ -107,6 +108,8 @@ (define %base-services+qemu-networking/hurd
%qemu-static-networking))
%base-services/hurd))
+(define %desktop-services/hurd %base-services/hurd)
+
(define %setuid-programs/hurd
;; Default set of setuid-root programs.
(map file-like->setuid-program
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 36dbd9111f..c8dccd38b0 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -3,7 +3,7 @@
;;; Copyright © 2017, 2019, 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
-;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -1869,6 +1869,10 @@ (define-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?)
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v3 16/17] installer: Add static-networking template.
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (14 preceding siblings ...)
2024-10-25 9:40 ` [bug#73927] [PATCH v3 15/17] installer: Add "Kernel" page to select the Hurd Janneke Nieuwenhuizen
@ 2024-10-25 9:40 ` Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 17/17] installer: Support dry-run from Guile via store Janneke Nieuwenhuizen
16 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-25 9:40 UTC (permalink / raw)
To: 73927
* gnu/installer/services.scm (%system-services): Add
static-networking-service-type.
Change-Id: Iec6336f8d1f49e8b801e978d5c9eeb4f83a6e748
---
gnu/installer/services.scm | 22 ++++++++++++++++++++++
1 file changed, 22 insertions(+)
diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm
index d5a382606c..8b117d9a20 100644
--- a/gnu/installer/services.scm
+++ b/gnu/installer/services.scm
@@ -149,6 +149,28 @@ (define (%system-services)
(name (G_ "DHCP client (dynamic IP address assignment)"))
(type 'network-management)
(snippet '((service dhcp-client-service-type))))
+ (system-service
+ (name (G_ "Static networking service."))
+ (type 'network-management)
+ (snippet `((service
+ static-networking-service-type
+ (list %loopback-static-networking
+ (static-networking
+ (addresses
+ (list
+ (network-address
+ (device "eth0")
+ ,(comment (G_ ";; Fill-in your IP.\n"))
+ (value "192.168.178.10/24"))))
+ (routes
+ (list (network-route
+ (destination "default")
+ ,(comment (G_ ";; Fill-in your gateway IP.\n"))
+ (gateway "192.168.178.1"))))
+ (requirement '())
+ (provision '(networking))
+ ,(comment (G_ ";; Fill-in your nameservers.\n"))
+ (name-servers '("192.168.178.1"))))))))
;; Dealing with documents.
(system-service
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v3 17/17] installer: Support dry-run from Guile via store.
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (15 preceding siblings ...)
2024-10-25 9:40 ` [bug#73927] [PATCH v3 16/17] installer: Add static-networking template Janneke Nieuwenhuizen
@ 2024-10-25 9:40 ` Janneke Nieuwenhuizen
16 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-25 9:40 UTC (permalink / raw)
To: 73927
This supports running the installer quasi-directly from Guile by only building
a Guile installer-script in the store. Do something like:
./pre-inst-env guile -c '((@ (gnu installer) run-installer) #:dry-run? #t)'
or and BE VERY CAREFUL WHEN NOT USING #:DRY-RUN #T!
sudo -E ./pre-inst-env guile -c '((@ (gnu installer) run-installer))'
for this to work, you also need connman.
* gnu/installer.scm (installer-script, run-installer): New procedures.
Change-Id: I8cc1746845ec99f738e35fa91bb2342a674cfa88
---
gnu/installer.scm | 84 +++++++++++++++++++++++++++++++++++++++++++++--
1 file changed, 82 insertions(+), 2 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 31c0ff7ff4..981687990a 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -21,10 +21,14 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu installer)
+ #:use-module (guix build utils)
+ #:use-module (guix derivations)
#:use-module (guix discovery)
- #:use-module (guix packages)
#:use-module (guix gexp)
#:use-module (guix modules)
+ #:use-module (guix monads)
+ #:use-module (guix packages)
+ #:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix ui)
#:use-module ((guix self) #:select (make-config.scm))
@@ -56,7 +60,9 @@ (define-module (gnu installer)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (web uri)
- #:export (installer-program))
+ #:export (installer-program
+ installer-steps
+ run-installer))
(define module-to-import?
;; Return true for modules that should be imported. For (gnu system …) and
@@ -562,3 +568,77 @@ (define action
(execl #$(program-file "installer-real" installer-builder
#:guile guile-3.0-latest)
"installer-real"))))
+
+(define* (installer-script #:key dry-run?
+ (steps (installer-steps #:dry-run? dry-run?)))
+ (program-file
+ "installer-script"
+ #~(begin
+ (use-modules (gnu installer)
+ (gnu installer record)
+ (gnu installer keymap)
+ (gnu installer steps)
+ (gnu installer dump)
+ (gnu installer final)
+ (gnu installer hostname)
+ (gnu installer kernel)
+ (gnu installer locale)
+ (gnu installer parted)
+ (gnu installer services)
+ (gnu installer timezone)
+ (gnu installer user)
+ (gnu installer utils)
+ (gnu installer newt)
+ ((gnu installer newt keymap)
+ #:select (keyboard-layout->configuration))
+ (gnu services herd)
+ (guix i18n)
+ (guix build utils)
+ (guix utils)
+ ((system repl debug)
+ #:select (terminal-width))
+ (ice-9 match)
+ (ice-9 textual-ports))
+ (terminal-width 200)
+ (let* ((current-installer newt-installer)
+ (steps (#$steps current-installer)))
+ (catch #t
+ (lambda _
+ ((installer-init current-installer))
+ (parameterize ((%run-command-in-installer
+ (if #$dry-run?
+ dry-run-command
+ (installer-run-command current-installer)))
+ (%installer-configuration-file
+ (if #$dry-run?
+ "config.scm"
+ (%installer-configuration-file))))
+ (let ((results (run-installer-steps
+ #:rewind-strategy 'menu
+ #:menu-proc
+ (installer-menu-page current-installer)
+ #:steps steps
+ #:dry-run? #$dry-run?)))
+ (result-step results 'final))))
+ (const #f)
+ (lambda (key . args)
+ (sleep 10)
+ ((installer-exit current-installer))
+ (display-backtrace (make-stack #t) (current-error-port))
+ (apply throw key args)))))))
+
+(define* (run-installer #:key dry-run?)
+ "To run the installer from Guile without building it:
+ ./pre-inst-env guile -c '((@ (gnu installer) run-installer) #:dry-run? #t)'
+when using #:dry-run? #t, no root access is required and the LOCALE, KEYMAP,
+and PARTITION pages are skipped."
+ (let* ((script (installer-script #:dry-run? dry-run?))
+ (store (open-connection))
+ (drv (run-with-store store
+ (lower-object script)))
+ (program (match (derivation->output-paths drv)
+ ((("out" . program)) program)))
+ (outputs (build-derivations store (list drv))))
+ (close-connection store)
+ (format #t "running installer: ~a\n" program)
+ (invoke "./pre-inst-env" "guile" program)))
--
2.46.0
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd.
2024-10-21 8:13 [bug#73927] [PATCH 00/16] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (16 preceding siblings ...)
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 01/18] gnu: guile-fibers: Fix cross-build for " Janneke Nieuwenhuizen
` (17 more replies)
17 siblings, 18 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927
Cc: Janneke Nieuwenhuizen, Josselin Poiret, Ludovic Courtès,
Mathieu Othacehe
From: "Janneke Nieuwenhuizen" <janneke@gnu.org>
New in this series:
* reconfigure: Use native bootloader package for running the installer,
* default to "msdos" partion table,
* do not suggest/create boot partition,
* remove "--skip-checks" from guix system init call,
* default to part:1:device:wd0 instead of failing when no permission to read
/dev (resurrecting tests/guix-system.sh),
which lead to the first fresh install that actually boots without any extra
tinkering on my x60 using this
--8<---------------cut here---------------start------------->8---
./pre-inst-env guix system image -t iso9660 --system=i686-linux gnu/system/install.scm
--8<---------------cut here---------------end--------------->8---
installer. I've updated the hurd-team branch.
Greetings,
Janneke
Janneke Nieuwenhuizen (18):
gnu: guile-fibers: Fix cross-build for the Hurd.
reconfigure: Use native bootloader package for running the installer.
guix system: When installing the Hurd, create essential devices.
bootloader: grub: Remove hardcoded partition number for the Hurd.
system: hurd: Remove qemu networking from %base-services/hurd.
system: hurd: Add swap-services to hurd-default-essential-services.
gnu: hurd: Support second boot.
hurd-boot: Support second boot.
maint: Add installer dependencies to the manifest.
installer: Remove unused (newt) imports.
installer: Align comments.
installer: Use "partitioning-page" consistently.
installer: Fix file-name typos.
installer: Use `%' for parameter %run-command-in-installer.
installer: Add dry-run?
installer: Add "Kernel" page to select the Hurd.
installer: Add static-networking template.
installer: Support dry-run from Guile via store.
gnu/bootloader/grub.scm | 19 ++-
gnu/build/file-systems.scm | 58 +++++++
gnu/build/hurd-boot.scm | 21 ++-
gnu/installer.scm | 207 ++++++++++++++++++------
gnu/installer/final.scm | 9 +-
gnu/installer/kernel.scm | 41 +++++
gnu/installer/newt.scm | 24 ++-
gnu/installer/newt/ethernet.scm | 1 -
gnu/installer/newt/final.scm | 20 ++-
gnu/installer/newt/kernel.scm | 45 ++++++
gnu/installer/newt/keymap.scm | 6 +-
gnu/installer/newt/locale.scm | 7 +-
gnu/installer/newt/page.scm | 7 +-
gnu/installer/newt/parameters.scm | 1 -
gnu/installer/newt/partition.scm | 11 +-
gnu/installer/newt/services.scm | 32 ++--
gnu/installer/parted.scm | 141 ++++++++++------
gnu/installer/record.scm | 8 +-
gnu/installer/services.scm | 68 ++++++--
gnu/installer/steps.scm | 30 ++--
gnu/installer/tests.scm | 11 ++
gnu/installer/utils.scm | 17 +-
gnu/local.mk | 3 +
gnu/packages/guile-xyz.scm | 11 +-
gnu/packages/hurd.scm | 6 +-
gnu/packages/patches/hurd-startup.patch | 82 ++++++++++
gnu/services/base.scm | 20 ++-
gnu/services/virtualization.scm | 4 +-
gnu/system.scm | 13 +-
gnu/system/examples/bare-hurd.tmpl | 10 +-
gnu/system/hurd.scm | 26 +--
gnu/system/images/hurd.scm | 2 +-
gnu/tests/install.scm | 6 +-
guix/scripts/system.scm | 6 +-
guix/scripts/system/reconfigure.scm | 3 +-
manifest.scm | 7 +-
36 files changed, 775 insertions(+), 208 deletions(-)
create mode 100644 gnu/installer/kernel.scm
create mode 100644 gnu/installer/newt/kernel.scm
create mode 100644 gnu/packages/patches/hurd-startup.patch
base-commit: d6f775c30c6f47e174f6110d1089edc6315600e4
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 01/18] gnu: guile-fibers: Fix cross-build for the Hurd.
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 02/18] reconfigure: Use native bootloader package for running the installer Janneke Nieuwenhuizen
` (16 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927
* gnu/packages/guile-xyz.scm (guile-fibers): When cross-building for the Hurd,
add "fix-env" phase.
Change-Id: Iebe12941bbfb2f5a6208f9364115e95f10e82ed6
---
gnu/packages/guile-xyz.scm | 11 +++++++++--
1 file changed, 9 insertions(+), 2 deletions(-)
diff --git a/gnu/packages/guile-xyz.scm b/gnu/packages/guile-xyz.scm
index 5f34ea98a6..06d3b59dc3 100644
--- a/gnu/packages/guile-xyz.scm
+++ b/gnu/packages/guile-xyz.scm
@@ -9,7 +9,7 @@
;;; Copyright © 2016, 2017, 2021 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016, 2017 Adonay "adfeno" Felipe Nogueira <https://libreplanet.org/wiki/User:Adfeno> <adfeno@openmailbox.org>
;;; Copyright © 2016, 2021 Amirouche <amirouche@hypermove.net>
-;;; Copyright © 2016, 2019, 2021, 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016, 2019, 2021, 2023, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2017 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2017 David Thompson <davet@gnu.org>
;;; Copyright © 2017, 2018, 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -875,7 +875,14 @@ (define-public guile-fibers
(substitute* "tests/basic.scm"
((".*spawn-fiber-chain 5000000.*") ""))
(substitute* "tests/channels.scm"
- ((".*assert-run-fibers-terminates .*pingpong.*") "")))))))))
+ ((".*assert-run-fibers-terminates .*pingpong.*") "")))))
+ #$@(if (and (target-hurd?) (%current-target-system))
+ #~((add-before 'build 'fixup-env
+ (lambda _
+ (substitute* "env"
+ ((".*override.*" all)
+ (string-append "true #" all))))))
+ '())))))
(native-inputs
(list texinfo pkg-config autoconf-2.71 automake libtool
guile-3.0 ;for 'guild compile
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 02/18] reconfigure: Use native bootloader package for running the installer.
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 01/18] gnu: guile-fibers: Fix cross-build for " Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 03/18] guix system: When installing the Hurd, create essential devices Janneke Nieuwenhuizen
` (15 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927
Cc: Christopher Baines, Josselin Poiret, Ludovic Courtès,
Mathieu Othacehe, Simon Tournier, Tobias Geerinckx-Rice
This fixes running grub-install when using guix system init --target.
* guix/scripts/system/reconfigure.scm (install-bootloader): Use native package
when invoking install-bootloader-program.
Change-Id: I48d80a8dff866ada3625d827dd3036fb966eee9a
---
guix/scripts/system/reconfigure.scm | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index 604ba08fee..ddb561d28c 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -7,6 +7,7 @@
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -299,7 +300,7 @@ (define* (install-bootloader eval configuration bootcfg
(eval #~(parameterize ((current-warning-port (%make-void-port "w")))
(primitive-load #$(install-bootloader-program installer
disk-installer
- package
+ #~#+package
bootcfg
bootcfg-file
devices
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 03/18] guix system: When installing the Hurd, create essential devices.
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 01/18] gnu: guile-fibers: Fix cross-build for " Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 02/18] reconfigure: Use native bootloader package for running the installer Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 04/18] bootloader: grub: Remove hardcoded partition number for the Hurd Janneke Nieuwenhuizen
` (14 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927
Cc: Christopher Baines, Josselin Poiret, Ludovic Courtès,
Mathieu Othacehe, Simon Tournier, Tobias Geerinckx-Rice
* guix/scripts/system.scm (install): When installing the Hurd, invoke
`make-hurd-device-nodes'.
Change-Id: If84d5fe0b5bf4a93452f0b5241650f325d583543
---
guix/scripts/system.scm | 6 +++++-
1 file changed, 5 insertions(+), 1 deletion(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 99c58f3812..7989b183ad 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -5,7 +5,7 @@
;;; Copyright © 2017, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
-;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
@@ -63,6 +63,7 @@ (define-module (guix scripts system)
#:autoload (guix progress) (progress-reporter/bar
call-with-progress-reporter)
#:use-module ((guix docker) #:select (%docker-image-max-layers))
+ #:use-module (gnu build hurd-boot)
#:use-module (gnu build image)
#:use-module (gnu build install)
#:autoload (gnu build file-systems)
@@ -243,6 +244,9 @@ (define* (install os-drv target
(delete-file-recursively state)))
(chmod target #o755)
+ ;; For the Hurd to boot, it needs some essential device nodes.
+ (when (target-hurd?)
+ (make-hurd-device-nodes target))
(let ((os-dir (derivation->output-path os-drv))
(format (lift format %store-monad))
(populate (lift2 populate-root-file-system %store-monad)))
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 04/18] bootloader: grub: Remove hardcoded partition number for the Hurd.
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (2 preceding siblings ...)
2024-10-30 14:30 ` [bug#73927] [PATCH v4 03/18] guix system: When installing the Hurd, create essential devices Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 05/18] system: hurd: Remove qemu networking from %base-services/hurd Janneke Nieuwenhuizen
` (13 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927
This supports using another than the default DISK0 PART1 and using LABEL or
UUID as root file-system specifier. It still defaults to DISK0 PART1 if
the file-system cannot be found, i.e., lives only at the build side: A
virtual machine/childhurd build.
* gnu/build/file-systems.scm (%hurd-device-spec-regexp, %device-spec-regexp):
New variables.
(device-name->hurd-device-name, hurd-device-name->device-name,
device-spec->device, device-spec->device-name): Use them in new procedures.
* gnu/bootloader/grub.scm (make-grub-configuration): Use them to remove
hardcoded partition number (root-index 1).
Change-Id: I49fa93dacc09883dfb4d695402c5eac2e0e17286
---
gnu/bootloader/grub.scm | 19 +++++++++----
gnu/build/file-systems.scm | 58 ++++++++++++++++++++++++++++++++++++++
2 files changed, 71 insertions(+), 6 deletions(-)
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 2723eda5f4..ef516b1e13 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -3,7 +3,7 @@
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2019, 2020, 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2019, 2020, 2023, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2020 Stefan <stefan-guix@vodafonemail.de>
@@ -34,6 +34,7 @@ (define-module (gnu bootloader grub)
#:use-module (guix gexp)
#:use-module (gnu artwork)
#:use-module (gnu bootloader)
+ #:use-module (gnu build file-systems)
#:use-module (gnu system uuid)
#:use-module (gnu system file-systems)
#:use-module (gnu system keyboard)
@@ -45,6 +46,7 @@ (define-module (gnu bootloader grub)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
+ #:use-module (srfi srfi-26)
#:export (grub-theme
grub-theme?
grub-theme-image
@@ -355,6 +357,11 @@ (define (grub-root-search device file)
((or #f (? string?))
#~(format #f "search --file --set ~a" #$file)))))
+(define* (device->hurd-device-name device-spec #:key (disk "w"))
+ "Return DEVICE as a Hurd name spec: part:PART-NUMBER:device:DISKdDISK-INDEX."
+ (let ((device-name (canonicalize-device-spec device-spec)))
+ (device-name->hurd-device-name device-name #:disk disk)))
+
(define* (make-grub-configuration grub config entries
#:key
(locale #f)
@@ -413,16 +420,16 @@ (define* (make-grub-configuration grub config entries
;; IDE driver ("hdX") and those understood by rumpdisk ("wdX"
;; in the "noide" case).
(disk (if (member "noide" arguments) "w" "h"))
- (modules (menu-entry-multiboot-modules entry))
- (root-index 1)) ; XXX EFI will need root-index 2
+ (device-spec (and=> device file-system-device->string))
+ (device-name (and=> device-spec device-spec->device-name))
+ (modules (menu-entry-multiboot-modules entry)))
#~(format port "
menuentry ~s {
- multiboot ~a root=part:~a:device:~ad0~a~a
+ multiboot ~a root=~a~a~a
}~%"
#$label
#$kernel
- #$root-index
- #$disk
+ #$(device-name->hurd-device-name device-name #:disk disk)
(string-join (list #$@arguments) " " 'prefix)
(string-join (map string-join '#$modules)
"\n module " 'prefix))))
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 41e1c9e282..6fd9f95093 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -9,6 +9,7 @@
;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
;;; Copyright © 2024 Richard Sent <richard@freakingpenguin.com>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -53,6 +54,11 @@ (define-module (gnu build file-systems)
find-partition-by-luks-uuid
canonicalize-device-spec
+ device-name->hurd-device-name
+ device-spec->device
+ device-spec->device-name
+ hurd-device-name->device-name
+
read-partition-label
read-partition-uuid
read-luks-partition-uuid
@@ -1431,4 +1437,56 @@ (define* (mount-file-system fs #:key (root "/root")
(or (file-system-mount-may-fail? fs)
(apply throw args))))))
+(define %device-name-regexp "/dev/[hsvw]d([abcd])([0-9]*)")
+(define %hurd-device-name-regexp "part:([0-9]*):device:[hw]d([0-9]*)")
+
+(define (device-spec->device-name device-spec)
+ "Return DEVICE-SPEC as a Linux /dev/XdYZ device name, also catering for uuid
+or label."
+ (cond ((string-match %device-name-regexp device-spec)
+ device-spec)
+ ((string-match %hurd-device-name-regexp device-spec)
+ (hurd-device-name->device-name device-spec))
+ ((string->uuid device-spec)
+ =>
+ (lambda (uuid) (false-if-exception (find-partition-by-uuid uuid))))
+ (else
+ (false-if-exception (find-partition-by-label device-spec)))))
+
+(define* (device-name->hurd-device-name device-name #:key (disk "w"))
+ "Return DEVICE-NAME as a Hurd device name:
+ part:PART-NUMBER:device:DISKdDISK-INDEX
+Default to part:1:device:DISKd0 if partition cannot be found."
+ (let* ((m (and=> device-name (cute string-match %device-name-regexp <>)))
+ (disk-char (and m (and=> (match:substring m 1)
+ (compose car string->list))))
+ (disk-index (or (and disk-char
+ (- (char->integer disk-char) (char->integer #\a)))
+ 0))
+ (partition-number (or (and m (and=> (match:substring m 2)
+ string->number))
+ 1)))
+ (format #f "part:~a:device:~ad~a" partition-number disk disk-index)))
+
+(define* (hurd-device-name->device-name device-name #:key (disk "s"))
+ (let* ((m (and=> device-name (cute string-match %hurd-device-name-regexp <>)))
+ (disk-index-string (and=> m (cute match:substring <> 2)))
+ (disk-index (or (and=> disk-index-string string->number)
+ 0))
+ (disk-index-char (integer->char (+ disk-index (char->integer #\a))))
+ (partition-string (and=> m (cute match:substring <> 1)))
+ (partition-number (or (and=> partition-string string->number)
+ 1)))
+ (format #f "/dev/~ad~a~a" disk disk-index-char partition-number)))
+
+(define (device-spec->device device-spec)
+ "Return DEVICE-SPEC as UUID, FILE-SYSTEM-LABEL, or DEVICE-SPEC."
+ (cond ((and=> (string->uuid device-spec)
+ find-partition-by-uuid)
+ (string->uuid device-spec))
+ ((find-partition-by-label device-spec)
+ (file-system-label device-spec))
+ (else
+ device-spec)))
+
;;; file-systems.scm ends here
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 05/18] system: hurd: Remove qemu networking from %base-services/hurd.
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (3 preceding siblings ...)
2024-10-30 14:30 ` [bug#73927] [PATCH v4 04/18] bootloader: grub: Remove hardcoded partition number for the Hurd Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 06/18] system: hurd: Add swap-services to hurd-default-essential-services Janneke Nieuwenhuizen
` (12 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927
This allows us to use %base-services/hurd for services in a Hurd config for a
real machine without removing static-networking.
* gnu/system/hurd.scm (%base-services/hurd): Factor networking out to...
(%base-services+qemu-networking/hurd): ..this new variable.
* gnu/system/examples/bare-hurd.tmpl (%hurd-os): Use it.
* gnu/services/virtualization.scm (%hurd-vm-operating-system): Use it.
* gnu/system/images/hurd.scm (hurd-barebones-os): Use it. Add comment about
QEMU and networking for a real machine.
Change-Id: I777a63410383b9bf8b5740e4513dbc1e9fb0fd41
---
gnu/services/virtualization.scm | 4 ++--
gnu/system/examples/bare-hurd.tmpl | 10 ++++++++--
gnu/system/hurd.scm | 23 ++++++++++++++---------
gnu/system/images/hurd.scm | 2 +-
4 files changed, 25 insertions(+), 14 deletions(-)
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index d87e494348..d33dfa6ca7 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com>
;;; Copyright © 2018, 2020-2024 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2020, 2021, 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2021, 2023, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Timotej Lazar <timotej.lazar@araneo.si>
;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2022 Leo Nikkilä <hello@lnikki.la>
@@ -1643,7 +1643,7 @@ (define %hurd-vm-operating-system
;; /etc/guix/acl file in the childhurd. Thus, clear
;; 'authorize-key?' so that it's not overridden at activation
;; time.
- (modify-services %base-services/hurd
+ (modify-services %base-services+qemu-networking/hurd
(guix-service-type config =>
(guix-configuration
(inherit config)
diff --git a/gnu/system/examples/bare-hurd.tmpl b/gnu/system/examples/bare-hurd.tmpl
index 463c7ee798..68c6d3c166 100644
--- a/gnu/system/examples/bare-hurd.tmpl
+++ b/gnu/system/examples/bare-hurd.tmpl
@@ -1,7 +1,7 @@
;; -*-scheme-*-
;; This is an operating system configuration template
-;; for a "bare bones" setup, with no X11 display server.
+;; for a "bare bones" QEMU setup, with no X11 display server.
;; To build a disk image for a virtual machine, do
;;
@@ -54,6 +54,12 @@
(permit-root-login #t)
(allow-empty-passwords? #t)
(password-authentication? #t)))
- %base-services/hurd))))
+ ;; For installing on a real (non-QEMU) machine, use:
+ ;; (static-networking-service-type
+ ;; (list %loopback-static-networking
+ ;; (static-networking
+ ;; ...)))
+ ;; %base-services/hurd
+ %base-services+qemu-networking/hurd))))
%hurd-os
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index 6d6a20cf57..283bae6f10 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020-2024 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2020, 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2023, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -47,6 +47,7 @@ (define-module (gnu system hurd)
#:use-module (gnu system vm)
#:export (%base-packages/hurd
%base-services/hurd
+ %base-services+qemu-networking/hurd
%hurd-default-operating-system
%hurd-default-operating-system-kernel
%setuid-programs/hurd))
@@ -79,14 +80,6 @@ (define %base-packages/hurd
(define %base-services/hurd
(append (list (service hurd-console-service-type
(hurd-console-configuration (hurd hurd)))
- (service static-networking-service-type
- (list %loopback-static-networking
-
- ;; QEMU user-mode networking. To get "eth0", you need
- ;; QEMU to emulate a device for which Mach has an
- ;; in-kernel driver, for instance with:
- ;; --device rtl8139,netdev=net0 --netdev user,id=net0
- %qemu-static-networking))
(service guix-service-type
(guix-configuration
(extra-options '("--disable-chroot"
@@ -102,6 +95,18 @@ (define %base-services/hurd
(tty (string-append "tty" (number->string n))))))
(iota 6 1))))
+(define %base-services+qemu-networking/hurd
+ (cons
+ (service static-networking-service-type
+ (list %loopback-static-networking
+
+ ;; QEMU user-mode networking. To get "eth0", you need
+ ;; QEMU to emulate a device for which Mach has an
+ ;; in-kernel driver, for instance with:
+ ;; --device rtl8139,netdev=net0 --netdev user,id=net0
+ %qemu-static-networking))
+ %base-services/hurd))
+
(define %setuid-programs/hurd
;; Default set of setuid-root programs.
(map file-like->setuid-program
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index 9b618f7dc6..01c422a54f 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -60,7 +60,7 @@ (define hurd-barebones-os
(permit-root-login #t)
(allow-empty-passwords? #t)
(password-authentication? #t)))
- %base-services/hurd))))
+ %base-services+qemu-networking/hurd))))
(define hurd-initialize-root-partition
#~(lambda* (#:rest args)
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 06/18] system: hurd: Add swap-services to hurd-default-essential-services.
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (4 preceding siblings ...)
2024-10-30 14:30 ` [bug#73927] [PATCH v4 05/18] system: hurd: Remove qemu networking from %base-services/hurd Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 07/18] gnu: hurd: Support second boot Janneke Nieuwenhuizen
` (11 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927
* gnu/services/base.scm (swap-service-type): Do not include 'udev' requirement
for the Hurd. Use system* with "swapon", "swapoff" for the Hurd.
* gnu/system.scm (hurd-default-essential-services): Add swap-services.
* gnu/services/base.scm (swap-service-type):
Change-Id: I1d4d445c614921752dc84aa0dd6ff42cdbf62aa8
---
gnu/services/base.scm | 20 +++++++++++++-------
gnu/system.scm | 13 +++++++------
2 files changed, 20 insertions(+), 13 deletions(-)
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index d0a57a8807..6201dea4b8 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -44,6 +44,7 @@ (define-module (gnu services base)
#:autoload (guix diagnostics) (warning formatted-message &fix-hint)
#:autoload (guix i18n) (G_)
#:use-module (guix combinators)
+ #:use-module (guix utils)
#:use-module (gnu services)
#:use-module (gnu services admin)
#:use-module (gnu services shepherd)
@@ -2647,7 +2648,7 @@ (define swap-service-type
(with-imported-modules (source-module-closure '((gnu build file-systems)))
(shepherd-service
(provision (list (swap->shepherd-service-name swap)))
- (requirement `(udev ,@requirements))
+ (requirement `(,@(if (target-hurd?) '() '(udev)) ,@requirements))
(documentation "Enable the given swap space.")
(modules `((gnu build file-systems)
,@%default-modules))
@@ -2655,16 +2656,21 @@ (define swap-service-type
(let ((device #$device-lookup))
(and device
(begin
- (restart-on-EINTR (swapon device
- #$(if (swap-space? swap)
- (swap-space->flags-bit-mask
- swap)
- 0)))
+ #$(if (target-hurd?)
+ #~(system* "swapon" device)
+ #~(restart-on-EINTR
+ (swapon device
+ #$(if (swap-space? swap)
+ (swap-space->flags-bit-mask
+ swap)
+ 0))))
#t)))))
(stop #~(lambda _
(let ((device #$device-lookup))
(when device
- (restart-on-EINTR (swapoff device)))
+ #$(if (target-hurd?)
+ #~(system* "swapoff" device)
+ #~(restart-on-EINTR (swapoff device))))
#f)))
(respawn? #f))))
(description "Turn on the virtual memory swap area.")))
diff --git a/gnu/system.scm b/gnu/system.scm
index c19730b331..533a4154d6 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -845,11 +845,11 @@ (define (hurd-default-essential-services os)
(let ((host-name (operating-system-host-name os))
(hosts-file (%operating-system-hosts-file os))
(entries (operating-system-directory-base-entries os)))
- (list (service system-service-type entries)
- %boot-service
- %hurd-startup-service
- %activation-service
- (service shepherd-root-service-type)
+ (cons* (service system-service-type entries)
+ %boot-service
+ %hurd-startup-service
+ %activation-service
+ (service shepherd-root-service-type)
(service user-processes-service-type)
;; Make sure that privileged-programs activation script
@@ -873,7 +873,8 @@ (define (hurd-default-essential-services os)
(list `("hosts" ,hosts-file)))
(service hosts-service-type
(local-host-entries host-name)))
- (service profile-service-type (operating-system-packages os)))))
+ (service profile-service-type (operating-system-packages os))
+ (swap-services os))))
(define* (operating-system-services os)
"Return all the services of OS, including \"essential\" services."
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 07/18] gnu: hurd: Support second boot.
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (5 preceding siblings ...)
2024-10-30 14:30 ` [bug#73927] [PATCH v4 06/18] system: hurd: Add swap-services to hurd-default-essential-services Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 08/18] hurd-boot: " Janneke Nieuwenhuizen
` (10 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927
This avoids hanging upon second boot and ensures a declarative /hurd and /dev.
* gnu/packages/patches/hurd-startup.patch: New file.
* gnu/local.mk (dist_patch_DATA): Add it.
* gnu/packages/hurd.scm (hurd): Use it.
[arguments]: In stage create-runsystem remove /dev/urandom.
Change-Id: Ifcca5562c297204735c35132820a32ca0f273677
---
gnu/local.mk | 1 +
gnu/packages/hurd.scm | 6 +-
gnu/packages/patches/hurd-startup.patch | 82 +++++++++++++++++++++++++
3 files changed, 88 insertions(+), 1 deletion(-)
create mode 100644 gnu/packages/patches/hurd-startup.patch
diff --git a/gnu/local.mk b/gnu/local.mk
index 1040b3927b..872e55eb41 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1542,6 +1542,7 @@ dist_patch_DATA = \
%D%/packages/patches/hubbub-sort-entities.patch \
%D%/packages/patches/hueplusplus-mbedtls.patch \
%D%/packages/patches/hurd-rumpdisk-no-hd.patch \
+ %D%/packages/patches/hurd-startup.patch \
%D%/packages/patches/hwloc-1-test-btrfs.patch \
%D%/packages/patches/i7z-gcc-10.patch \
%D%/packages/patches/icecat-makeicecat.patch \
diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm
index e6ea920714..9c1681f236 100644
--- a/gnu/packages/hurd.scm
+++ b/gnu/packages/hurd.scm
@@ -317,7 +317,8 @@ (define-public hurd
(name "hurd")
(source (origin
(inherit (package-source hurd-headers))
- (patches (search-patches "hurd-rumpdisk-no-hd.patch"))))
+ (patches (search-patches "hurd-rumpdisk-no-hd.patch"
+ "hurd-startup.patch"))))
(version (package-version hurd-headers))
(arguments
`(#:tests? #f ;no "check" target
@@ -388,6 +389,9 @@ (define-public hurd
# Note: this /hurd/ gets substituted
settrans --create /servers/socket/1 /hurd/pflocal
+# Upon second boot, (file-exists? /dev/null) in hurd-boot-system hangs unless:
+rm -f /dev/urandom
+
# parse multiboot arguments
for i in \"$@\"; do
case $i in
diff --git a/gnu/packages/patches/hurd-startup.patch b/gnu/packages/patches/hurd-startup.patch
new file mode 100644
index 0000000000..0b0dcc9537
--- /dev/null
+++ b/gnu/packages/patches/hurd-startup.patch
@@ -0,0 +1,82 @@
+This avoids hanging upon second boot and ensures a declarative /dev.
+
+Upstream status: Not presented upstream.
+
+From a15d281ea012ee360c45376e964d35f6292ac549 Mon Sep 17 00:00:00 2001
+From: Janneke Nieuwenhuizen <janneke@gnu.org>
+Date: Sat, 27 May 2023 17:28:22 +0200
+Subject: [PATCH] startup: Remove /hurd, /dev, create /servers.
+
+This avoids hanging upon second boot and ensures a declarative /hurd
+and /dev.
+
+* startup/startup.c (rm_r, create_servers): New functions.
+(main): Use them to remove /dev and create /servers. Remove /hurd
+symlink.
+---
+ startup/startup.c | 42 ++++++++++++++++++++++++++++++++++++++++++
+ 1 file changed, 42 insertions(+)
+
+diff --git a/startup/startup.c b/startup/startup.c
+index feb7d265..5f380194 100644
+--- a/startup/startup.c
++++ b/startup/startup.c
+@@ -732,6 +732,42 @@ parse_opt (int key, char *arg, struct argp_state *state)
+ return 0;
+ }
+
++#include <ftw.h>
++static int
++rm_r (char const *file_name)
++{
++ int callback (char const *file_name, struct stat64 const *stat_buffer,
++ int type_flag, struct FTW *ftw_buffer)
++ {
++ fprintf (stderr, "startup: removing: %s\n", file_name);
++ return remove (file_name);
++ }
++
++ return nftw64 (file_name, callback, 0, FTW_DEPTH | FTW_MOUNT | FTW_PHYS);
++}
++
++void
++create_servers (void)
++{
++ char const *servers[] = {
++ "/servers/startup",
++ "/servers/exec",
++ "/servers/proc",
++ "/servers/password",
++ "/servers/default-pager",
++ "/servers/crash-dump-core",
++ "/servers/kill",
++ "/servers/suspend",
++ 0,
++ };
++ mkdir ("/servers", 0755);
++ for (char const **p = servers; *p; p++)
++ open (*p, O_WRONLY | O_APPEND | O_CREAT, 0444);
++ mkdir ("/servers/socket", 0755);
++ mkdir ("/servers/bus", 0755);
++ mkdir ("/servers/bus/pci", 0755);
++}
++
+ int
+ main (int argc, char **argv, char **envp)
+ {
+@@ -741,6 +777,12 @@ main (int argc, char **argv, char **envp)
+ mach_port_t consdev;
+ struct argp argp = { options, parse_opt, 0, doc };
+
++ /* GNU Guix creates fresh ones in boot-hurd-system. */
++ unlink ("/hurd");
++ rm_r ("/dev");
++ mkdir ("/dev", 0755);
++ create_servers ();
++
+ /* Parse the arguments. We don't want the vector reordered, we
+ should pass on to our child the exact arguments we got and just
+ ignore any arguments that aren't flags for us. ARGP_NO_ERRS
+--
+2.40.1
+
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 08/18] hurd-boot: Support second boot.
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (6 preceding siblings ...)
2024-10-30 14:30 ` [bug#73927] [PATCH v4 07/18] gnu: hurd: Support second boot Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 09/18] maint: Add installer dependencies to the manifest Janneke Nieuwenhuizen
` (9 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927
* gnu/build/hurd-boot.scm (boot-hurd-system): Check for stale shepherd socket
and remove it. Be chattier about /hurd symlink replacement.
Change-Id: I5e528c131ebeadb7ebc9727336a0f9301af3e68e
---
gnu/build/hurd-boot.scm | 21 ++++++++++++++++-----
1 file changed, 16 insertions(+), 5 deletions(-)
diff --git a/gnu/build/hurd-boot.scm b/gnu/build/hurd-boot.scm
index daf4fb41ab..23ace25d4f 100644
--- a/gnu/build/hurd-boot.scm
+++ b/gnu/build/hurd-boot.scm
@@ -322,18 +322,29 @@ (define* (boot-hurd-system #:key (on-error 'debug))
(let* ((args (command-line))
(system (find-long-option "gnu.system" args))
- (to-load (find-long-option "gnu.load" args)))
+ (to-load (find-long-option "gnu.load" args))
+ (profile (string-append system "/profile"))
+ (bin (string-append profile "/bin"))
+ (sbin (string-append profile "/bin")))
- (false-if-exception (delete-file "/hurd"))
- (let ((hurd/hurd (readlink* (string-append system "/profile/hurd"))))
- (symlink hurd/hurd "/hurd"))
+ (setenv "PATH" (string-append bin ":" sbin))
+
+ (when (file-exists? "/var/run/shepherd/socket")
+ (format #t "Removing stale shepherd socket...\n")
+ (delete-file "/var/run/shepherd/socket"))
(unless (file-exists? "/servers/startup")
(format #t "Creating essential device nodes...\n")
(make-hurd-device-nodes))
+ (let ((profile/hurd (readlink* (string-append profile "/hurd"))))
+ (when (file-exists? "/hurd")
+ (format #t "Removing stale /hurd link\n")
+ (delete-file "/hurd"))
+ (format #t "Linking /hurd from ~a...\n" profile/hurd)
+ (symlink profile/hurd "/hurd"))
+
(format #t "Setting-up essential translators...\n")
- (setenv "PATH" (string-append system "/profile/bin"))
(set-hurd-device-translators)
(format #t "Starting pager...\n")
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 09/18] maint: Add installer dependencies to the manifest.
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (7 preceding siblings ...)
2024-10-30 14:30 ` [bug#73927] [PATCH v4 08/18] hurd-boot: " Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 10/18] installer: Remove unused (newt) imports Janneke Nieuwenhuizen
` (8 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927
* manifest.scm: Add guile-newt, guile-parted, guile-webutils.
Change-Id: Idcf46320d29c15f36da05f66e81b7779e37c1bf6
---
manifest.scm | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
diff --git a/manifest.scm b/manifest.scm
index 27e1d62566..ccd6268461 100644
--- a/manifest.scm
+++ b/manifest.scm
@@ -51,4 +51,9 @@
"mumi"
"nss-certs"
"openssl" ;required if using 'smtpEncryption = tls'
- "patman"))))
+ "patman"))
+ ;; For installer
+ (specifications->manifest
+ (list "guile-newt"
+ "guile-parted"
+ "guile-webutils"))))
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 10/18] installer: Remove unused (newt) imports.
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (8 preceding siblings ...)
2024-10-30 14:30 ` [bug#73927] [PATCH v4 09/18] maint: Add installer dependencies to the manifest Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 11/18] installer: Align comments Janneke Nieuwenhuizen
` (7 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927; +Cc: Josselin Poiret, Ludovic Courtès, Mathieu Othacehe
* gnu/installer/newt/ethernet.scm,
gnu/installer/newt/keymap.scm,
gnu/installer/newt/locale.scm,
gnu/installer/newt/parameters.scm,
gnu/installer/newt/services.scm: Remove (newt).
Change-Id: Ia6624aaf73491024da54b8ffee7358941b187fdf
---
gnu/installer/newt/ethernet.scm | 1 -
gnu/installer/newt/keymap.scm | 1 -
gnu/installer/newt/locale.scm | 1 -
gnu/installer/newt/parameters.scm | 1 -
gnu/installer/newt/services.scm | 1 -
5 files changed, 5 deletions(-)
diff --git a/gnu/installer/newt/ethernet.scm b/gnu/installer/newt/ethernet.scm
index d75a640519..53e440fd60 100644
--- a/gnu/installer/newt/ethernet.scm
+++ b/gnu/installer/newt/ethernet.scm
@@ -27,7 +27,6 @@ (define-module (gnu installer newt ethernet)
#:use-module (ice-9 match)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
- #:use-module (newt)
#:export (run-ethernet-page))
(define (ethernet-services)
diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm
index c5d4be6792..109ec55e0a 100644
--- a/gnu/installer/newt/keymap.scm
+++ b/gnu/installer/newt/keymap.scm
@@ -24,7 +24,6 @@ (define-module (gnu installer newt keymap)
#:use-module (gnu installer newt page)
#:use-module (guix i18n)
#:use-module (guix records)
- #:use-module (newt)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm
index 01171e253f..a226b39ba6 100644
--- a/gnu/installer/newt/locale.scm
+++ b/gnu/installer/newt/locale.scm
@@ -22,7 +22,6 @@ (define-module (gnu installer newt locale)
#:use-module (gnu installer steps)
#:use-module (gnu installer newt page)
#:use-module (guix i18n)
- #:use-module (newt)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
diff --git a/gnu/installer/newt/parameters.scm b/gnu/installer/newt/parameters.scm
index 8fb1aa3abb..7c61266e4d 100644
--- a/gnu/installer/newt/parameters.scm
+++ b/gnu/installer/newt/parameters.scm
@@ -23,7 +23,6 @@ (define-module (gnu installer newt parameters)
#:use-module (guix build syscalls)
#:use-module (guix i18n)
#:use-module (ice-9 match)
- #:use-module (newt)
#:export (run-parameters-page))
(define (run-proxy-page)
diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm
index b22024602c..d1035b6524 100644
--- a/gnu/installer/newt/services.scm
+++ b/gnu/installer/newt/services.scm
@@ -28,7 +28,6 @@ (define-module (gnu installer newt services)
#:use-module (guix i18n)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
- #:use-module (newt)
#:export (run-services-page))
(define (run-desktop-environments-cbt-page)
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 11/18] installer: Align comments.
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (9 preceding siblings ...)
2024-10-30 14:30 ` [bug#73927] [PATCH v4 10/18] installer: Remove unused (newt) imports Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 12/18] installer: Use "partitioning-page" consistently Janneke Nieuwenhuizen
` (6 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927; +Cc: Josselin Poiret, Ludovic Courtès, Mathieu Othacehe
* gnu/installer.scm (installer-program): Align comments.
Change-Id: I50c173c46ea9bfdb3da0562146bc969d46f0edd9
---
gnu/installer.scm | 24 ++++++++++++------------
1 file changed, 12 insertions(+), 12 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 5cd99e4013..3dfcb7581a 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -355,22 +355,22 @@ (define (installer-program)
(define set-installer-path
;; Add the specified binary to PATH for later use by the installer.
#~(let* ((inputs
- '#$(list bash ;start subshells
- connman ;call connmanctl
+ '#$(list bash ;start subshells
+ connman ;call connmanctl
cryptsetup
- dosfstools ;mkfs.fat
- e2fsprogs ;mkfs.ext4
- lvm2-static ;dmsetup
+ dosfstools ;mkfs.fat
+ e2fsprogs ;mkfs.ext4
+ lvm2-static ;dmsetup
btrfs-progs
- jfsutils ;jfs_mkfs
- ntfs-3g ;mkfs.ntfs
- xfsprogs ;mkfs.xfs
- kbd ;chvt
- util-linux ;mkwap
+ jfsutils ;jfs_mkfs
+ ntfs-3g ;mkfs.ntfs
+ xfsprogs ;mkfs.xfs
+ kbd ;chvt
+ util-linux ;mkwap
nano
shadow
- tar ;dump
- gzip ;dump
+ tar ;dump
+ gzip ;dump
coreutils)))
(with-output-to-port (%make-void-port "w")
(lambda ()
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 12/18] installer: Use "partitioning-page" consistently.
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (10 preceding siblings ...)
2024-10-30 14:30 ` [bug#73927] [PATCH v4 11/18] installer: Align comments Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 13/18] installer: Fix file-name typos Janneke Nieuwenhuizen
` (5 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927; +Cc: Josselin Poiret, Ludovic Courtès, Mathieu Othacehe
Having `partition-page' function call `RUN-partititionING-page' where all
other proxy functions call `RUN-<name>' hurts my brain while refactoring.
* gnu/installer/record.scm (<installer>)[partition-page]: Rename to...
[partitioning-page]: ...this.
* gnu/installer/newt.scm (partitioning-page, newt-installer): Update
accordingly.
* gnu/installer.scm (installer-steps): Update accordingly.
Change-Id: I6b2f3459a3d0a7a89260224b7d8438676e3411ba
---
gnu/installer.scm | 3 ++-
gnu/installer/newt.scm | 5 +++--
gnu/installer/record.scm | 5 +++--
3 files changed, 8 insertions(+), 5 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 3dfcb7581a..3a05843cab 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -312,7 +313,7 @@ (define (installer-steps)
(id 'partition)
(description (G_ "Partitioning"))
(compute (lambda _
- ((installer-partition-page current-installer))))
+ ((installer-partitioning-page current-installer))))
(configuration-formatter user-partitions->configuration))
(installer-step
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index e1c4453168..6d8ea35fff 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -193,7 +194,7 @@ (define (hostname-page)
(define (user-page)
(run-user-page))
-(define (partition-page)
+(define (partitioning-page)
(run-partitioning-page))
(define (services-page)
@@ -220,7 +221,7 @@ (define newt-installer
(timezone-page timezone-page)
(hostname-page hostname-page)
(user-page user-page)
- (partition-page partition-page)
+ (partitioning-page partitioning-page)
(services-page services-page)
(welcome-page welcome-page)
(parameters-menu parameters-menu)
diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm
index 5e0264682f..334af44a0c 100644
--- a/gnu/installer/record.scm
+++ b/gnu/installer/record.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -37,7 +38,7 @@ (define-module (gnu installer record)
installer-timezone-page
installer-hostname-page
installer-user-page
- installer-partition-page
+ installer-partitioning-page
installer-services-page
installer-welcome-page
installer-parameters-menu
@@ -86,7 +87,7 @@ (define-record-type* <installer>
;; procedure void -> void
(user-page installer-user-page)
;; procedure void -> void
- (partition-page installer-partition-page)
+ (partitioning-page installer-partitioning-page)
;; procedure void -> void
(services-page installer-services-page)
;; procedure (logo #:pci-database) -> void
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 13/18] installer: Fix file-name typos.
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (11 preceding siblings ...)
2024-10-30 14:30 ` [bug#73927] [PATCH v4 12/18] installer: Use "partitioning-page" consistently Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 14/18] installer: Use `%' for parameter %run-command-in-installer Janneke Nieuwenhuizen
` (4 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927; +Cc: Josselin Poiret, Ludovic Courtès, Mathieu Othacehe
* gnu/installer/newt/page.scm (run-dump-page): Typo file-name.
* gnu/installer/utils.scm (open-new-log-port): Likewise.
Change-Id: I837991a0ee5054b3afa8328205e23ac6f9fbae8d
---
gnu/installer/newt/page.scm | 7 ++++---
gnu/installer/utils.scm | 7 ++++---
2 files changed, 8 insertions(+), 6 deletions(-)
diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
index e1623a51fd..64a2916826 100644
--- a/gnu/installer/newt/page.scm
+++ b/gnu/installer/newt/page.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -950,10 +951,10 @@ (define* (run-dump-page base-dir file-choices)
('exit-component
(let ((result
(map (match-lambda
- ((edit checkbox filename)
+ ((edit checkbox file-name)
(if (components=? edit argument)
- (abort-to-prompt prompt-tag filename)
- (cons filename (eq? #\x
+ (abort-to-prompt prompt-tag file-name)
+ (cons file-name (eq? #\x
(checkbox-value checkbox))))))
components)))
(destroy-form-and-pop form)
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index 6838410166..c722e9af8f 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.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.
;;;
@@ -283,11 +284,11 @@ (define-syntax syslog
(define (open-new-log-port)
(define now (localtime (time-second (current-time))))
- (define filename
+ (define file-name
(format #f "/tmp/installer.~a.log"
(strftime "%F.%T" now)))
- (open filename (logior O_RDWR
- O_CREAT)))
+ (open file-name (logior O_RDWR
+ O_CREAT)))
(define installer-log-port
(let ((port #f))
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 14/18] installer: Use `%' for parameter %run-command-in-installer.
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (12 preceding siblings ...)
2024-10-30 14:30 ` [bug#73927] [PATCH v4 13/18] installer: Fix file-name typos Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 15/18] installer: Add dry-run? Janneke Nieuwenhuizen
` (3 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927; +Cc: Josselin Poiret, Ludovic Courtès, Mathieu Othacehe
* gnu/installer/utils.scm (run-command-in-installer): Rename to...
(%run-command-in-installer): ...this.
* gnu/installer.scm (installer-program): Update accordingly.
* gnu/installer/parted.scm (remove-logical-devices, create-btrfs-file-system,
create-ext4-file-system, create-fat16-file-system, create-fat32-file-system,
create-jfs-file-system, create-ntfs-file-system, create-xfs-file-system,
create-swap-partition, luks-format-and-open, luks-ensure-open, luks-close):
Update accordingly.
Change-Id: I96ebc59ebc85fd8ebccb0cc57130b4e7532d287f
---
gnu/installer.scm | 2 +-
gnu/installer/parted.scm | 27 ++++++++++++++-------------
gnu/installer/utils.scm | 6 +++---
3 files changed, 18 insertions(+), 17 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 3a05843cab..21809e4259 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -465,7 +465,7 @@ (define (installer-program)
(installer-init current-installer)
(lambda ()
(parameterize
- ((run-command-in-installer
+ ((%run-command-in-installer
(installer-run-command current-installer)))
(catch #t
(lambda ()
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index dbdec1bba8..e59df3d8e6 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2019-2020, 2022, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -363,7 +364,7 @@ (define* (force-device-sync device)
(define (remove-logical-devices)
"Remove all active logical devices."
- ((run-command-in-installer) "dmsetup" "remove_all"))
+ ((%run-command-in-installer) "dmsetup" "remove_all"))
(define (installer-root-partition-path)
"Return the root partition path, or #f if it could not be detected."
@@ -1183,7 +1184,7 @@ (define (set-user-partitions-file-name user-partitions)
(define (create-btrfs-file-system partition)
"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-ext4-file-system partition)
"Create an ext4 file-system for PARTITION file-name."
@@ -1192,32 +1193,32 @@ (define (create-ext4-file-system partition)
;; up and adding new files would fail with ENOSPC despite there being plenty
;; of free space and inodes:
;; <https://blog.merovius.de/posts/2013-10-20-ext4-mysterious-no-space-left-on/>.
- ((run-command-in-installer) "mkfs.ext4" "-F" partition
+ ((%run-command-in-installer) "mkfs.ext4" "-F" partition
"-O" "large_dir"))
(define (create-fat16-file-system partition)
"Create a fat16 file-system for PARTITION file-name."
- ((run-command-in-installer) "mkfs.fat" "-F16" partition))
+ ((%run-command-in-installer) "mkfs.fat" "-F16" partition))
(define (create-fat32-file-system partition)
"Create a fat32 file-system for PARTITION file-name."
- ((run-command-in-installer) "mkfs.fat" "-F32" partition))
+ ((%run-command-in-installer) "mkfs.fat" "-F32" partition))
(define (create-jfs-file-system partition)
"Create a JFS file-system for PARTITION file-name."
- ((run-command-in-installer) "jfs_mkfs" "-f" partition))
+ ((%run-command-in-installer) "jfs_mkfs" "-f" partition))
(define (create-ntfs-file-system partition)
"Create a JFS file-system for PARTITION file-name."
- ((run-command-in-installer) "mkfs.ntfs" "-F" "-f" partition))
+ ((%run-command-in-installer) "mkfs.ntfs" "-F" "-f" partition))
(define (create-xfs-file-system partition)
"Create an XFS file-system for PARTITION file-name."
- ((run-command-in-installer) "mkfs.xfs" "-f" partition))
+ ((%run-command-in-installer) "mkfs.xfs" "-f" partition))
(define (create-swap-partition partition)
"Set up swap area on PARTITION file-name."
- ((run-command-in-installer) "mkswap" "-f" partition))
+ ((%run-command-in-installer) "mkswap" "-f" partition))
(define (call-with-luks-key-file password proc)
"Write PASSWORD in a temporary file and pass it to PROC as argument."
@@ -1246,9 +1247,9 @@ (define (luks-format-and-open user-partition)
(lambda (key-file)
(installer-log-line "formatting and opening LUKS entry ~s at ~s"
label file-name)
- ((run-command-in-installer) "cryptsetup" "-q" "luksFormat"
+ ((%run-command-in-installer) "cryptsetup" "-q" "luksFormat"
file-name key-file)
- ((run-command-in-installer) "cryptsetup" "open" "--type" "luks"
+ ((%run-command-in-installer) "cryptsetup" "open" "--type" "luks"
"--key-file" key-file file-name label)))))
(define (luks-ensure-open user-partition)
@@ -1262,14 +1263,14 @@ (define (luks-ensure-open user-partition)
(lambda (key-file)
(installer-log-line "opening LUKS entry ~s at ~s"
label file-name)
- ((run-command-in-installer) "cryptsetup" "open" "--type" "luks"
+ ((%run-command-in-installer) "cryptsetup" "open" "--type" "luks"
"--key-file" key-file file-name label))))))
(define (luks-close user-partition)
"Close the encrypted partition pointed by USER-PARTITION."
(let ((label (user-partition-crypt-label user-partition)))
(installer-log-line "closing LUKS entry ~s" label)
- ((run-command-in-installer) "cryptsetup" "close" label)))
+ ((%run-command-in-installer) "cryptsetup" "close" label)))
(define (format-user-partitions user-partitions)
"Format the <user-partition> records in USER-PARTITIONS list with
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index c722e9af8f..170f036537 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -50,7 +50,7 @@ (define-module (gnu installer utils)
run-external-command-with-handler/tty
run-external-command-with-line-hooks
run-command
- run-command-in-installer
+ %run-command-in-installer
syslog-port
%syslog-line-hook
@@ -222,13 +222,13 @@ (define* (run-command command #:key (tty? #f))
(pause)
succeeded?)
-(define run-command-in-installer
+(define %run-command-in-installer
(make-parameter
(lambda (. args)
(raise
(condition
(&serious)
- (&message (message "run-command-in-installer not set")))))))
+ (&message (message "%run-command-in-installer not set")))))))
\f
;;;
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 15/18] installer: Add dry-run?
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (13 preceding siblings ...)
2024-10-30 14:30 ` [bug#73927] [PATCH v4 14/18] installer: Use `%' for parameter %run-command-in-installer Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 16/18] installer: Add "Kernel" page to select the Hurd Janneke Nieuwenhuizen
` (2 subsequent siblings)
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927; +Cc: Josselin Poiret, Ludovic Courtès, Mathieu Othacehe
This allows running the installer without root privileges. Do something like
./pre-inst-env guix repl
,use (guix)
,use (gnu installer)
(installer-program #:dry-run? #t)
,build $1
=>
"/gnu/store/...-installer-program"
and run
/gnu/store/...-installer-program
* gnu/installer/newt.scm (locale-page): Add #:dry-run? parameter.
(keymap-page): Likewise.
* gnu/installer/newt/keymap.scm (run-keymap-page): Likewise.
* gnu/installer/steps.scm (run-installer-steps): Likewise. Use it to skip
writing to socket.
* gnu/installer/newt/final.scm (run-final-page): Rename to...
(run-final-page-install): ...this.
(dry-run-final-page, run-final-page): New procedures.
* gnu/installer/parted.scm (bootloader-configuration): Cater for empty user
partitions.
* gnu/installer/utils.scm (dry-run-command): New procedure.
* gnu/installer.scm (compute-locale-step): Add #:dry-run? parameter. Use it
to avoid actually applying locale.
(compute-keymap-step): Add dry-run? parameter. Pass it to
keymap-page.
(installer-program): Add #:dry-run? parameter. If #:true
avoid writing to /proc, use dry-run-command, skip sync and reboot, and pass
dry-run? to...
(installer-steps): ...here. Add #:dry-run? parameter. Use it to disable
skip network, substitutes, partitioning pages, and pass it to...
compute-locale-step, compute-keymap-step, and final-page.
Change-Id: I0ff4c3b0a0c69539af617c27ba37654beed44619
---
gnu/installer.scm | 81 ++++++++++++++++++++------------
gnu/installer/newt.scm | 14 +++---
gnu/installer/newt/final.scm | 20 +++++++-
gnu/installer/newt/keymap.scm | 5 +-
gnu/installer/newt/locale.scm | 6 ++-
gnu/installer/newt/partition.scm | 1 +
gnu/installer/parted.scm | 29 +++++++-----
gnu/installer/steps.scm | 16 +++++--
gnu/installer/utils.scm | 4 ++
9 files changed, 116 insertions(+), 60 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 21809e4259..39a83c4455 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -134,7 +134,8 @@ (define apply-locale
(define* (compute-locale-step #:key
locales-name
iso639-languages-name
- iso3166-territories-name)
+ iso3166-territories-name
+ dry-run?)
"Return a gexp that run the locale-page of INSTALLER, and install the
selected locale. The list of locales, languages and territories passed to
locale-page are computed in derivations named respectively LOCALES-NAME,
@@ -177,8 +178,11 @@ (define* (compute-locale-step #:key
((installer-locale-page current-installer)
#:supported-locales #$locales-loader
#:iso639-languages #$iso639-loader
- #:iso3166-territories #$iso3166-loader)))
- (#$apply-locale result)
+ #:iso3166-territories #$iso3166-loader
+ #:dry-run? #$dry-run?)))
+ (if #$dry-run?
+ '()
+ (#$apply-locale result))
result))))
(define apply-keymap
@@ -188,7 +192,7 @@ (define apply-keymap
(kmscon-update-keymap (default-keyboard-model)
layout variant options))))
-(define* (compute-keymap-step context)
+(define (compute-keymap-step context dry-run?)
"Return a gexp that runs the keymap-page of INSTALLER and install the
selected keymap."
#~(lambda (current-installer)
@@ -200,15 +204,16 @@ (define* (compute-keymap-step context)
"/share/X11/xkb/rules/base.xml")))
(lambda (models layouts)
((installer-keymap-page current-installer)
- layouts '#$context)))))
+ layouts '#$context #$dry-run?)))))
(and result (#$apply-keymap result))
result)))
-(define (installer-steps)
+(define* (installer-steps #:key dry-run?)
(let ((locale-step (compute-locale-step
#:locales-name "locales"
#:iso639-languages-name "iso639-languages"
- #:iso3166-territories-name "iso3166-territories"))
+ #:iso3166-territories-name "iso3166-territories"
+ #:dry-run? dry-run?))
(timezone-data #~(string-append #$tzdata
"/share/zoneinfo/zone.tab")))
#~(lambda (current-installer)
@@ -216,7 +221,7 @@ (define (installer-steps)
(lambda ()
((installer-parameters-page current-installer)
(lambda _
- (#$(compute-keymap-step 'param)
+ (#$(compute-keymap-step 'param dry-run?)
current-installer)))))
(list
;; Ask the user to choose a locale among those supported by
@@ -262,8 +267,10 @@ (define (installer-steps)
(id 'keymap)
(description (G_ "Keyboard mapping selection"))
(compute (lambda _
- (#$(compute-keymap-step 'default)
- current-installer)))
+ (if #$dry-run?
+ '("en" "US" #f)
+ (#$(compute-keymap-step 'default dry-run?)
+ current-installer))))
(configuration-formatter keyboard-layout->configuration))
;; Ask the user to input a hostname for the system.
@@ -280,14 +287,18 @@ (define (installer-steps)
(id 'network)
(description (G_ "Network selection"))
(compute (lambda _
- ((installer-network-page current-installer)))))
+ (if #$dry-run?
+ '()
+ ((installer-network-page current-installer))))))
;; Ask whether to enable substitute server discovery.
(installer-step
(id 'substitutes)
(description (G_ "Substitute server discovery"))
(compute (lambda _
- ((installer-substitutes-page current-installer)))))
+ (if #$dry-run?
+ '()
+ ((installer-substitutes-page current-installer))))))
;; Prompt for users (name, group and home directory).
(installer-step
@@ -313,7 +324,9 @@ (define (installer-steps)
(id 'partition)
(description (G_ "Partitioning"))
(compute (lambda _
- ((installer-partitioning-page current-installer))))
+ (if #$dry-run?
+ '()
+ ((installer-partitioning-page current-installer)))))
(configuration-formatter user-partitions->configuration))
(installer-step
@@ -322,7 +335,7 @@ (define (installer-steps)
(compute
(lambda (result prev-steps)
((installer-final-page current-installer)
- result prev-steps))))))))
+ result prev-steps #$dry-run?))))))))
(define (provenance-sexp)
"Return an sexp representing the currently-used channels, for logging
@@ -343,7 +356,7 @@ (define (provenance-sexp)
`(channel ,(channel-name channel) ,url ,(channel-commit channel))))
channels))))
-(define (installer-program)
+(define* (installer-program #:key dry-run?)
"Return a file-like object that runs the given INSTALLER."
(define init-gettext
;; Initialize gettext support, so that installer messages can be
@@ -377,7 +390,7 @@ (define (installer-program)
(lambda ()
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)))))
- (define steps (installer-steps))
+ (define steps (installer-steps #:dry-run? dry-run?))
(define modules
(scheme-modules*
(string-append (current-source-directory) "/..")
@@ -425,9 +438,10 @@ (define (installer-program)
;; Enable core dump generation.
(setrlimit 'core #f #f)
- (call-with-output-file "/proc/sys/kernel/core_pattern"
- (lambda (port)
- (format port %core-dump)))
+ (unless #$dry-run?
+ (call-with-output-file "/proc/sys/kernel/core_pattern"
+ (lambda (port)
+ (format port %core-dump))))
;; Initialize gettext support so that installers can use
;; (guix i18n) module.
@@ -466,24 +480,29 @@ (define (installer-program)
(lambda ()
(parameterize
((%run-command-in-installer
- (installer-run-command current-installer)))
+ (if #$dry-run?
+ dry-run-command
+ (installer-run-command current-installer))))
(catch #t
(lambda ()
(define results
(run-installer-steps
#:rewind-strategy 'menu
#:menu-proc (installer-menu-page current-installer)
- #:steps steps))
-
- (match (result-step results 'final)
- ('success
- ;; We did it! Let's reboot!
- (sync)
- (stop-service 'root))
- (_
- ;; The installation failed, exit so that it is
- ;; restarted by login.
- #f)))
+ #:steps steps
+ #:dry-run? #$dry-run?))
+
+ (let ((result (result-step results 'final)))
+ (unless #$dry-run?
+ (match (result-step results 'final)
+ ('success
+ ;; We did it! Let's reboot!
+ (sync)
+ (stop-service 'root))
+ (_
+ ;; The installation failed, exit so that it is
+ ;; restarted by login.
+ #f)))))
(const #f)
(lambda (key . args)
(installer-log-line "crashing due to uncaught exception: ~s ~s"
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index 6d8ea35fff..d53bc058b3 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -158,17 +158,19 @@ (define (newt-run-command . args)
(term-signal term-sig)
(stop-signal stop-sig)))))))))))
-(define (final-page result prev-steps)
- (run-final-page result prev-steps))
+(define (final-page result prev-steps dry-run?)
+ (run-final-page result prev-steps dry-run?))
(define* (locale-page #:key
supported-locales
iso639-languages
- iso3166-territories)
+ iso3166-territories
+ dry-run?)
(run-locale-page
#:supported-locales supported-locales
#:iso639-languages iso639-languages
- #:iso3166-territories iso3166-territories))
+ #:iso3166-territories iso3166-territories
+ #:dry-run? dry-run?))
(define (timezone-page zonetab)
(run-timezone-page zonetab))
@@ -179,8 +181,8 @@ (define* (welcome-page logo #:key pci-database)
(define (menu-page steps)
(run-menu-page steps))
-(define* (keymap-page layouts context)
- (run-keymap-page layouts #:context context))
+(define (keymap-page layouts context dry-run?)
+ (run-keymap-page layouts #:context context #:dry-run? dry-run?))
(define (network-page)
(run-network-page))
diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
index 9f950a0551..c4e53f6d79 100644
--- a/gnu/installer/newt/final.scm
+++ b/gnu/installer/newt/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 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -106,7 +107,7 @@ (define* (run-install-shell locale
(newt-resume)
install-ok?))
-(define (run-final-page result prev-steps)
+(define (run-final-page-install result prev-steps)
(define (wait-for-clients)
(unless (null? (current-clients))
(installer-log-line "waiting with clients before starting final step")
@@ -133,3 +134,20 @@ (define (run-final-page result prev-steps)
(if install-ok?
(run-install-success-page)
(run-install-failed-page))))
+
+(define (dry-run-final-page result prev-steps)
+ (installer-log-line "proceeding with final step -- dry-run")
+ (let* ((configuration (format-configuration prev-steps result))
+ (user-partitions (result-step result 'partition))
+ (locale (result-step result 'locale))
+ (users (result-step result 'user))
+ (file (configuration->file configuration))
+ (install-ok? (run-config-display-page #:locale locale)))
+ (if install-ok?
+ (run-install-success-page)
+ (run-install-failed-page))))
+
+(define (run-final-page result prev-steps dry-run?)
+ (if dry-run?
+ (dry-run-final-page result prev-steps)
+ (run-final-page-install result prev-steps)))
diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm
index 109ec55e0a..57f6d6530c 100644
--- a/gnu/installer/newt/keymap.scm
+++ b/gnu/installer/newt/keymap.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -153,7 +154,7 @@ (define (toggleable-latin-layout layout variant)
"grp:alt_shift_toggle"))
(list layout variant #f)))
-(define* (run-keymap-page layouts #:key (context #f))
+(define* (run-keymap-page layouts #:key context dry-run?)
"Run a page asking the user to select a keyboard layout and variant. LAYOUTS
is a list of supported X11-KEYMAP-LAYOUT. For non-Latin keyboard layouts, a
second layout and toggle options will be added automatically. Return a list
@@ -201,7 +202,7 @@ (define* (run-keymap-page layouts #:key (context #f))
"xkeyboard-config")))))
(toggleable-latin-layout layout variant)))
- (let* ((result (run-installer-steps #:steps keymap-steps))
+ (let* ((result (run-installer-steps #:steps keymap-steps #:dry-run? dry-run?))
(layout (result-step result 'layout))
(variant (result-step result 'variant)))
(and layout
diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm
index a226b39ba6..0be9db449e 100644
--- a/gnu/installer/newt/locale.scm
+++ b/gnu/installer/newt/locale.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -92,7 +93,8 @@ (define (run-modifier-page modifiers modifier->text)
(define* (run-locale-page #:key
supported-locales
iso639-languages
- iso3166-territories)
+ iso3166-territories
+ dry-run?)
"Run a page asking the user to select a locale language and possibly
territory, codeset and modifier. Use SUPPORTED-LOCALES as the list of glibc
available locales. ISO639-LANGUAGES is an association list associating a
@@ -212,4 +214,4 @@ (define* (run-locale-page #:key
;; step, turn the result into a glibc locale string and return it.
(result->locale-string
supported-locales
- (run-installer-steps #:steps locale-steps)))
+ (run-installer-steps #:steps locale-steps #:dry-run? dry-run?)))
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index 37656696c1..48dd306080 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2018, 2019, 2022 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index e59df3d8e6..b36b238d8b 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -1461,19 +1461,22 @@ (define (root-user-partition? partition)
(define (bootloader-configuration user-partitions)
"Return the bootloader configuration field for USER-PARTITIONS."
- (let* ((root-partition (find root-user-partition?
- user-partitions))
- (root-partition-disk (user-partition-disk-file-name root-partition)))
- `((bootloader-configuration
- ,@(if (efi-installation?)
- `((bootloader grub-efi-bootloader)
- (targets (list ,(default-esp-mount-point))))
- `((bootloader grub-bootloader)
- (targets (list ,root-partition-disk))))
-
- ;; XXX: Assume we defined the 'keyboard-layout' field of
- ;; <operating-system> right above.
- (keyboard-layout keyboard-layout)))))
+ (let ((root-partition (find root-user-partition? user-partitions)))
+ (match user-partitions
+ (() '())
+ (_
+ (let ((root-partition-disk (user-partition-disk-file-name
+ root-partition)))
+ `((bootloader-configuration
+ ,@(if (efi-installation?)
+ `((bootloader grub-efi-bootloader)
+ (targets (list ,(default-esp-mount-point))))
+ `((bootloader grub-bootloader)
+ (targets (list ,root-partition-disk))))
+
+ ;; XXX: Assume we defined the 'keyboard-layout' field of
+ ;; <operating-system> right above.
+ (keyboard-layout keyboard-layout))))))))
(define (user-partition-missing-modules user-partitions)
"Return the list of kernel modules missing from the default set of kernel
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
index 0c505e40e4..de0a852f02 100644
--- a/gnu/installer/steps.scm
+++ b/gnu/installer/steps.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -84,7 +85,8 @@ (define-record-type* <installer-step>
(define* (run-installer-steps #:key
steps
(rewind-strategy 'previous)
- (menu-proc (const #f)))
+ (menu-proc (const #f))
+ dry-run?)
"Run the COMPUTE procedure of all <installer-step> records in STEPS
sequentially, inside a the 'installer-step prompt. When aborted to with a
parameter of 'abort, fallback to a previous install-step, accordingly to the
@@ -191,10 +193,14 @@ (define* (run-installer-steps #:key
;; prematurely.
(sigaction SIGPIPE SIG_IGN)
- (with-server-socket
- (run '()
- #:todo-steps steps
- #:done-steps '())))
+ (if dry-run?
+ (run '()
+ #:todo-steps steps
+ #:done-steps '())
+ (with-server-socket
+ (run '()
+ #:todo-steps steps
+ #:done-steps '()))))
(define (find-step-by-id steps id)
"Find and return the step in STEPS whose id is equal to ID."
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index 170f036537..a8eb6cee83 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -49,6 +49,7 @@ (define-module (gnu installer utils)
run-external-command-with-handler
run-external-command-with-handler/tty
run-external-command-with-line-hooks
+ dry-run-command
run-command
%run-command-in-installer
@@ -222,6 +223,9 @@ (define* (run-command command #:key (tty? #f))
(pause)
succeeded?)
+(define (dry-run-command . args)
+ (format #t "dry-run-command: skipping: ~a\n" args))
+
(define %run-command-in-installer
(make-parameter
(lambda (. args)
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 16/18] installer: Add "Kernel" page to select the Hurd.
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (14 preceding siblings ...)
2024-10-30 14:30 ` [bug#73927] [PATCH v4 15/18] installer: Add dry-run? Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 17/18] installer: Add static-networking template Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 18/18] installer: Support dry-run from Guile via store Janneke Nieuwenhuizen
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927; +Cc: Josselin Poiret, Ludovic Courtès, Mathieu Othacehe
This adds a "Kernel" page to the installer with the option to (cross-) install
the Hurd, if applicable (only available on x86 machines for now).
* gnu/installer/newt.scm (kernel-page): New procedure.
(newt-installer)[kernel-page]: New field.
* gnu/installer/kernel.scm,
gnu/installer/newt/kernel.scm: New files.
* gnu/local.mk (INSTALLER_MODULES): Add them.
* gnu/installer.scm (installer-steps): Use them to select kernel if
applicable.
* gnu/installer/newt/partition.scm (run-label-page): Default to "msdos" when
instaling the Hurd.
(run-fs-type-page): Add ext2 for the hurd.
(run-partitioning-page-partition): Remove `entire-encrypted' option when
installing the Hurd.
* gnu/installer/services.scm (system-services->configuration): Cater for the
Hurd with %base-services/hurd, and with %base-packages/hurd that must always
be set.
(%system-services): Change to procedure. When installing the the Hurd, do not
recommend `ntp-service-type' and USE `openssh-sans-x' package for
`openssh-service-type'.
(system-service-none): New variable.
* gnu/installer/newt/services.scm (run-network-management-page): Include it
when installing the Hurd.
(run-desktop-environments-cbt-page): When installing the Hurd, recommend to
not select any desktop enviroment. Update users.
* gnu/installer/parted.scm (efi-installation?): Return #f when installing for
the Hurd.
(create-ext2-file-system): New procedure.
(user-fs-type-name, user-fs-type->mount-type, partition-filesystem-user-type,
format-user-partitions): Support `ext2'.
(<user-partition> partition->user-partition): Use `ext2' when installing the
Hurd.
(auto-partition!): Likewise. No swap partition when installing the Hurd.
* gnu/installer/final.scm (install-system): Cater for cross installation of
the Hurd.
(bootloader-configuration): Use `grub-minimal-bootloader' when installing the
Hurd.
(user-partition-missing-modules): Cater for empty user-partitions.
(initrd-configuration, user-partitions->configuration): Cater for the Hurd.
* gnu/installer/steps.scm (format-configuration,
configuration->file): Cater for the Hurd.
* gnu/system/hurd.scm (%desktop-services/hurd): New variable.
* gnu/installer/tests.scm (choose-kernel): New procedure.
* gnu/tests/install.scm (gui-test-program): Use it.
Change-Id: Ifafb27b8a2f933944c77223a27ec151757237e36
---
gnu/installer.scm | 14 +++++
gnu/installer/final.scm | 9 +++-
gnu/installer/kernel.scm | 41 +++++++++++++++
gnu/installer/newt.scm | 5 ++
gnu/installer/newt/kernel.scm | 45 ++++++++++++++++
gnu/installer/newt/partition.scm | 10 +++-
gnu/installer/newt/services.scm | 31 ++++++-----
gnu/installer/parted.scm | 89 +++++++++++++++++++++-----------
gnu/installer/record.scm | 3 ++
gnu/installer/services.scm | 46 +++++++++++++----
gnu/installer/steps.scm | 14 +++--
gnu/installer/tests.scm | 11 ++++
gnu/local.mk | 2 +
gnu/system/hurd.scm | 3 ++
gnu/tests/install.scm | 6 ++-
15 files changed, 269 insertions(+), 60 deletions(-)
create mode 100644 gnu/installer/kernel.scm
create mode 100644 gnu/installer/newt/kernel.scm
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 39a83c4455..31c0ff7ff4 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -308,6 +308,18 @@ (define* (installer-steps #:key dry-run?)
((installer-user-page current-installer))))
(configuration-formatter users->configuration))
+ ;; Ask the user to select the kernel for the system,
+ ;; for x86 systems only.
+ (installer-step
+ (id 'kernel)
+ (description (G_ "Kernel"))
+ (compute (lambda _
+ (if (target-x86?)
+ ((installer-kernel-page current-installer))
+ '())))
+ (configuration-formatter (lambda (result)
+ (kernel->configuration result #$dry-run?))))
+
;; Ask the user to choose one or many desktop environment(s).
(installer-step
(id 'services)
@@ -419,6 +431,7 @@ (define* (installer-program #:key dry-run?)
(gnu installer dump)
(gnu installer final)
(gnu installer hostname)
+ (gnu installer kernel)
(gnu installer locale)
(gnu installer parted)
(gnu installer services)
@@ -431,6 +444,7 @@ (define* (installer-program #:key dry-run?)
(gnu services herd)
(guix i18n)
(guix build utils)
+ (guix utils)
((system repl debug)
#:select (terminal-width))
(ice-9 match)
diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm
index 069426a3b8..64c054cd86 100644
--- a/gnu/installer/final.scm
+++ b/gnu/installer/final.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -25,6 +26,7 @@ (define-module (gnu installer final)
#:use-module (gnu services herd)
#:use-module (guix build syscalls)
#:use-module (guix build utils)
+ #:use-module (guix utils)
#:use-module (gnu build accounts)
#:use-module (gnu build install)
#:use-module (gnu build linux-container)
@@ -164,8 +166,11 @@ (define* (install-system locale #:key (users '()))
"/tmp/installer-system-init-options"
read))
(const '())))
- (install-command (append (list "guix" "system" "init"
- "--fallback")
+ (install-command (append `( "guix" "system" "init"
+ "--fallback"
+ ,@(if (target-hurd?)
+ '("--target=i586-pc-gnu")
+ '()))
options
(list (%installer-configuration-file)
(%installer-target-dir))))
diff --git a/gnu/installer/kernel.scm b/gnu/installer/kernel.scm
new file mode 100644
index 0000000000..c82b06fb83
--- /dev/null
+++ b/gnu/installer/kernel.scm
@@ -0,0 +1,41 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu installer kernel)
+ #:use-module (gnu system hurd)
+ #:use-module (guix read-print)
+ #:export (kernel->configuration))
+
+(define-syntax-rule (G_ str)
+ ;; In this file, translatable strings are annotated with 'G_' so xgettext
+ ;; catches them, but translation happens later on at run time.
+ str)
+
+(define (kernel->configuration kernel dry-run?)
+ (if (equal? kernel "Hurd")
+ `((kernel %hurd-default-operating-system-kernel)
+ ,(comment (G_ ";; \"noide\" disables the gnumach IDE driver, enabling rumpdisk.\n"))
+ (kernel-arguments '("noide"))
+ (firmware '())
+ (hurd hurd)
+ (locale-libcs (list glibc/hurd))
+ (name-service-switch #f)
+ (essential-services (hurd-default-essential-services this-operating-system))
+ (privileged-programs '())
+ (setuid-programs %setuid-programs/hurd))
+ '()))
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index d53bc058b3..1fe710340f 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -25,6 +25,7 @@ (define-module (gnu installer newt)
#:use-module (gnu installer newt final)
#:use-module (gnu installer newt parameters)
#:use-module (gnu installer newt hostname)
+ #:use-module (gnu installer newt kernel)
#:use-module (gnu installer newt keymap)
#:use-module (gnu installer newt locale)
#:use-module (gnu installer newt menu)
@@ -193,6 +194,9 @@ (define (substitutes-page)
(define (hostname-page)
(run-hostname-page))
+(define (kernel-page)
+ (run-kernel-page))
+
(define (user-page)
(run-user-page))
@@ -216,6 +220,7 @@ (define newt-installer
(exit-error exit-error)
(final-page final-page)
(keymap-page keymap-page)
+ (kernel-page kernel-page)
(locale-page locale-page)
(menu-page menu-page)
(network-page network-page)
diff --git a/gnu/installer/newt/kernel.scm b/gnu/installer/newt/kernel.scm
new file mode 100644
index 0000000000..3117247312
--- /dev/null
+++ b/gnu/installer/newt/kernel.scm
@@ -0,0 +1,45 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu installer newt kernel)
+ #:use-module (gnu installer newt page)
+ #:use-module (guix i18n)
+ #:use-module (guix utils)
+ #:export (run-kernel-page))
+
+(define (run-kernel-page)
+ (let* ((kernels `(,@(if (target-x86?) '("Hurd") '())
+ "Linux Libre"))
+ (result
+ (run-listbox-selection-page
+ #:title (G_ "Kernel")
+ #:info-text
+ (G_ "Please select a kernel. When in doubt, choose \"Linux Libre\".
+The Hurd is offered as a technology preview and development aid; many packages \
+are not yet available in Guix, such as a desktop environment or even a windowing \
+system (X, Wayland).")
+ #:listbox-items kernels
+ #:listbox-item->text identity
+ #:listbox-default-item "Linux Libre"
+ #:button-text (G_ "Back")
+ #:button-callback-procedure
+ (lambda _
+ (abort-to-prompt 'installer-step 'abort)))))
+ (when (equal? result "Hurd")
+ (%current-target-system "i586-pc-gnu"))
+ result))
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index 48dd306080..3a7e679577 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.scm
@@ -26,6 +26,7 @@ (define-module (gnu installer newt partition)
#:use-module (gnu installer newt page)
#:use-module (gnu installer newt utils)
#:use-module (guix i18n)
+ #:use-module (guix utils)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
@@ -115,6 +116,7 @@ (define (run-label-page button-text button-callback)
Be careful, all data on the disk will be lost.")
#:title (G_ "Partition table")
#:listbox-items '("msdos" "gpt")
+ #:listbox-default-item (if (target-hurd?) "msdos" "gpt")
#:listbox-item->text identity
#:listbox-callback-procedure
(run-label-confirmation-page button-callback)
@@ -147,6 +149,8 @@ (define (run-fs-type-page)
#:title (G_ "File-system type")
#:listbox-items '(btrfs ext4 jfs xfs
swap
+ ;; This is for the Hurd
+ ext2
;; These lack basic Unix features. Their only use
;; on GNU is for interoperation, e.g., with UEFI.
fat32 fat16 ntfs)
@@ -767,7 +771,11 @@ (define (run-partitioning-page)
(define (run-page devices)
(let* ((items
`((entire . ,(G_ "Guided - using the entire disk"))
- (entire-encrypted . ,(G_ "Guided - using the entire disk with encryption"))
+ ,@(if (target-hurd?)
+ '()
+ `((entire-encrypted
+ .
+ ,(G_ "Guided - using the entire disk with encryption"))))
(manual . ,(G_ "Manual"))))
(result (run-listbox-selection-page
#:info-text (G_ "Please select a partitioning method.")
diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm
index d1035b6524..848683e8c7 100644
--- a/gnu/installer/newt/services.scm
+++ b/gnu/installer/newt/services.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2021 Leo Famulari <leo@famulari.name>
;;;
@@ -26,6 +26,7 @@ (define-module (gnu installer newt services)
#:use-module (gnu installer newt page)
#:use-module (gnu installer newt utils)
#:use-module (guix i18n)
+ #:use-module (guix utils)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:export (run-services-page))
@@ -33,11 +34,13 @@ (define-module (gnu installer newt services)
(define (run-desktop-environments-cbt-page)
"Run a page allowing the user to choose between various desktop
environments."
- (let ((items (filter desktop-system-service? %system-services)))
+ (let ((items (filter desktop-system-service? (%system-services))))
(run-checkbox-tree-page
- #:info-text (G_ "Please select the desktop environment(s) you wish to \
+ #:info-text (if (target-hurd?)
+ (G_ "Currently, none of these is available for the Hurd.")
+ (G_ "Please select the desktop environment(s) you wish to \
install. If you select multiple desktop environments here, you will be able \
-to choose from them later when you log in.")
+to choose from them later when you log in."))
#:title (G_ "Desktop environment")
#:items items
#:selection (map system-service-recommended? items)
@@ -51,7 +54,7 @@ (define (run-networking-cbt-page)
"Run a page allowing the user to select networking services."
(let ((items (filter (lambda (service)
(eq? 'networking (system-service-type service)))
- %system-services)))
+ (%system-services))))
(run-checkbox-tree-page
#:info-text (G_ "You can now select networking services to run on your \
system.")
@@ -69,7 +72,7 @@ (define (run-printing-services-cbt-page)
(let ((items (filter (lambda (service)
(eq? 'document
(system-service-type service)))
- %system-services)))
+ (%system-services))))
(run-checkbox-tree-page
#:info-text (G_ "You can now select the CUPS printing service to run on your \
system.")
@@ -88,7 +91,7 @@ (define (run-console-services-cbt-page)
(let ((items (filter (lambda (service)
(eq? 'administration
(system-service-type service)))
- %system-services)))
+ (%system-services))))
(run-checkbox-tree-page
#:title (G_ "Console services")
#:info-text (G_ "Select miscellaneous services to run on your \
@@ -103,7 +106,11 @@ (define (run-console-services-cbt-page)
(define (run-network-management-page)
"Run a page to select among several network management methods."
- (let ((title (G_ "Network management")))
+ (let ((title (G_ "Network management"))
+ (items (filter (lambda (service)
+ (eq? 'network-management
+ (system-service-type service)))
+ (%system-services))))
(run-listbox-selection-page
#:title title
#:info-text (G_ "Choose the method to manage network connections.
@@ -112,10 +119,10 @@ (define (run-network-management-page)
client may be enough for a server.")
#:info-textbox-width 70
#:listbox-height 7
- #:listbox-items (filter (lambda (service)
- (eq? 'network-management
- (system-service-type service)))
- %system-services)
+ #:listbox-items `(,@items
+ ,@(if (target-hurd?)
+ (list system-service-none)
+ '()))
#:listbox-item->text (compose G_ system-service-name)
#:sort-listbox-items? #f
#:button-text (G_ "Exit")
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index b36b238d8b..ccddc64f11 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -152,7 +152,7 @@ (define-record-type* <user-partition>
(crypt-password user-partition-crypt-password ; <secret>
(default #f))
(fs-type user-partition-fs-type
- (default 'ext4))
+ (default (if (target-hurd?) 'ext2 'ext4)))
(bootable? user-partition-bootable?
(default #f))
(esp? user-partition-esp?
@@ -223,11 +223,13 @@ (define default-esp-mount-point
(define (efi-installation?)
"Return #t if an EFI installation should be performed, #f otherwise."
- (file-exists? "/sys/firmware/efi"))
+ (and (file-exists? "/sys/firmware/efi")
+ (not (target-hurd?))))
(define (user-fs-type-name fs-type)
"Return the name of FS-TYPE as specified by libparted."
(case fs-type
+ ((ext2) "ext2")
((ext4) "ext4")
((btrfs) "btrfs")
((fat16) "fat16")
@@ -240,6 +242,7 @@ (define (user-fs-type-name fs-type)
(define (user-fs-type->mount-type fs-type)
"Return the mount type of FS-TYPE."
(case fs-type
+ ((ext2) "ext2")
((ext4) "ext4")
((btrfs) "btrfs")
((fat16) "vfat")
@@ -255,6 +258,7 @@ (define (partition-filesystem-user-type partition)
(and fs-type
(let ((name (filesystem-type-name fs-type)))
(cond
+ ((string=? name "ext2") 'ext2)
((string=? name "ext4") 'ext4)
((string=? name "btrfs") 'btrfs)
((string=? name "fat16") 'fat16)
@@ -296,7 +300,7 @@ (define (partition->user-partition partition)
(file-name (partition-get-path partition))
(disk-file-name (device-path device))
(fs-type (or (partition-filesystem-user-type partition)
- 'ext4))
+ (if (target-hurd?) 'ext2 'ext4)))
(mount-point (and (esp-partition? partition)
(default-esp-mount-point)))
(bootable? (boot-partition? partition))
@@ -1045,18 +1049,20 @@ (define* (auto-partition! disk
non-boot-partitions)
(let* ((start-partition
- (if (efi-installation?)
- (and (not esp-partition)
- (user-partition
- (fs-type 'fat32)
- (esp? #t)
- (size new-esp-size)
- (mount-point (default-esp-mount-point))))
- (user-partition
- (fs-type 'ext4)
- (bootable? #t)
- (bios-grub? #t)
- (size bios-grub-size))))
+ (cond ((target-hurd?) #f)
+ ((efi-installation?)
+ (and (not esp-partition)
+ (user-partition
+ (fs-type 'fat32)
+ (esp? #t)
+ (size new-esp-size)
+ (mount-point (default-esp-mount-point)))))
+ (else
+ (user-partition
+ (fs-type 'ext4)
+ (bootable? #t)
+ (bios-grub? #t)
+ (size bios-grub-size)))))
(new-partitions
(cond
((or (eq? scheme 'entire-root)
@@ -1065,13 +1071,13 @@ (define* (auto-partition! disk
`(,@(if start-partition
`(,start-partition)
'())
- ,@(if encrypted?
+ ,@(if (or encrypted? (target-hurd?))
'()
`(,(user-partition
(fs-type 'swap)
(size swap-size))))
,(user-partition
- (fs-type 'ext4)
+ (fs-type (if (target-hurd?) 'ext2 'ext4))
(bootable? has-extended?)
(crypt-label (and encrypted? "cryptroot"))
(size "100%")
@@ -1083,7 +1089,7 @@ (define* (auto-partition! disk
`(,start-partition)
'())
,(user-partition
- (fs-type 'ext4)
+ (fs-type (if (target-hurd?) 'ext2 'ext4))
(bootable? has-extended?)
(crypt-label (and encrypted? "cryptroot"))
(size "33%")
@@ -1105,7 +1111,7 @@ (define* (auto-partition! disk
(type (if has-extended?
'logical
'normal))
- (fs-type 'ext4)
+ (fs-type (if (target-hurd?) 'ext2 'ext4))
(crypt-label (and encrypted? "crypthome"))
(size "100%")
(mount-point "/home")))))))
@@ -1186,6 +1192,15 @@ (define (create-btrfs-file-system partition)
"Create a btrfs file-system for PARTITION file-name."
((%run-command-in-installer) "mkfs.btrfs" "-f" partition))
+(define (create-ext2-file-system partition)
+ "Create an ext2 file-system for PARTITION file-name, when TARGET-HURD?,
+for the Hurd."
+ (apply (%run-command-in-installer)
+ `("mkfs.ext2" ,@(if (target-hurd?)
+ '("-o" "hurd")
+ '())
+ "-F" ,partition)))
+
(define (create-ext4-file-system partition)
"Create an ext4 file-system for PARTITION file-name."
;; Enable the 'large_dir' feature so users can have a store of several TiBs.
@@ -1291,6 +1306,10 @@ (define (format-user-partitions user-partitions)
(and need-formatting?
(not (eq? type 'extended))
(create-btrfs-file-system file-name)))
+ ((ext2)
+ (and need-formatting?
+ (not (eq? type 'extended))
+ (create-ext2-file-system file-name)))
((ext4)
(and need-formatting?
(not (eq? type 'extended))
@@ -1463,7 +1482,11 @@ (define (bootloader-configuration user-partitions)
"Return the bootloader configuration field for USER-PARTITIONS."
(let ((root-partition (find root-user-partition? user-partitions)))
(match user-partitions
- (() '())
+ (() (if (target-hurd?)
+ '(bootloader-configuration
+ (bootloader grub-minimal-bootloader)
+ (targets "/dev/sdaX"))
+ '()))
(_
(let ((root-partition-disk (user-partition-disk-file-name
root-partition)))
@@ -1471,7 +1494,9 @@ (define (bootloader-configuration user-partitions)
,@(if (efi-installation?)
`((bootloader grub-efi-bootloader)
(targets (list ,(default-esp-mount-point))))
- `((bootloader grub-bootloader)
+ `((bootloader ,(if (target-hurd?)
+ 'grub-minimal-bootloader
+ 'grub-bootloader))
(targets (list ,root-partition-disk))))
;; XXX: Assume we defined the 'keyboard-layout' field of
@@ -1491,22 +1516,28 @@ (define (user-partition-missing-modules user-partitions)
(const '())))
(delete-duplicates
(map user-partition-file-name
- (cons root devices)))))))
+ (filter identity
+ (cons root devices))))))))
(define (initrd-configuration user-partitions)
"Return an 'initrd-modules' field with everything needed for
USER-PARTITIONS, or return nothing."
- (match (user-partition-missing-modules user-partitions)
- (()
- '())
- ((modules ...)
- `((initrd-modules (append ',modules
- %base-initrd-modules))))))
+ (if (target-hurd?)
+ '((initrd #f)
+ (initrd-modules '()))
+ (match (user-partition-missing-modules user-partitions)
+ (()
+ '())
+ ((modules ...)
+ `((initrd-modules (append ',modules
+ %base-initrd-modules)))))))
(define (user-partitions->configuration user-partitions)
"Return the configuration field for USER-PARTITIONS."
(let* ((swap-user-partitions (find-swap-user-partitions user-partitions))
- (swap-devices (map user-partition-file-name swap-user-partitions))
+ (swap-devices (if (target-hurd?)
+ '()
+ (map user-partition-file-name swap-user-partitions)))
(encrypted-partitions
(filter user-partition-crypt-label user-partitions)))
`((bootloader ,@(bootloader-configuration user-partitions))
diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm
index 334af44a0c..22adad279c 100644
--- a/gnu/installer/record.scm
+++ b/gnu/installer/record.scm
@@ -30,6 +30,7 @@ (define-module (gnu installer record)
installer-exit
installer-exit-error
installer-final-page
+ installer-kernel-page
installer-keymap-page
installer-locale-page
installer-menu-page
@@ -69,6 +70,8 @@ (define-record-type* <installer>
(exit-error installer-exit-error)
;; procedure void -> void
(final-page installer-final-page)
+ ;; procedure void -> void
+ (kernel-page installer-kernel-page)
;; procedure (layouts context) -> (list layout variant options)
(keymap-page installer-keymap-page)
;; procedure: (#:key supported-locales iso639-languages iso3166-territories)
diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm
index 1cb9dc579c..d5a382606c 100644
--- a/gnu/installer/services.scm
+++ b/gnu/installer/services.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2022 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2021 Leo Famulari <leo@famulari.name>
;;; Copyright © 2023 Denys Nykula <vegan@libre.net.ua>
@@ -24,6 +24,7 @@
(define-module (gnu installer services)
#:use-module (guix records)
#:use-module (guix read-print)
+ #:use-module (guix utils)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:export (system-service?
@@ -34,6 +35,7 @@ (define-module (gnu installer services)
system-service-packages
desktop-system-service?
+ system-service-none
%system-services
system-services->configuration))
@@ -55,7 +57,13 @@ (define-record-type* <system-service>
(packages system-service-packages ;list of sexps
(default '())))
-(define %system-services
+(define system-service-none
+ (system-service
+ (name (G_ "None"))
+ (type 'network-management)
+ (snippet '())))
+
+(define (%system-services)
(let-syntax ((desktop-environment (syntax-rules ()
((_ fields ...)
(system-service
@@ -105,7 +113,11 @@ (define %system-services
(G_ "\
;; To configure OpenSSH, pass an 'openssh-configuration'
;; record as a second argument to 'service' below.\n"))
- (service openssh-service-type))))
+ ,(if (target-hurd?)
+ '(service openssh-service-type
+ (openssh-configuration
+ (openssh openssh-sans-x)))
+ '(service openssh-service-type)))))
(system-service
(name (G_ "Tor anonymous network router"))
(type 'networking)
@@ -115,7 +127,7 @@ (define %system-services
(system-service
(name (G_ "Network time service (NTP), to set the clock automatically"))
(type 'administration)
- (recommended? #t)
+ (recommended? (not (target-hurd?)))
(snippet '((service ntp-service-type))))
(system-service
(name (G_ "GPM mouse daemon, to use the mouse on the console"))
@@ -154,8 +166,12 @@ (define (system-services->configuration services)
(packages (append-map system-service-packages services))
(desktop? (find desktop-system-service? services))
(base (if desktop?
- '%desktop-services
- '%base-services))
+ (if (target-hurd?)
+ '%desktop-services/hurd
+ '%desktop-services)
+ (if (target-hurd?)
+ '%base-services/hurd
+ '%base-services)))
(native-console-font (match (getenv "LANGUAGE")
((or "be" "bg" "el" "eo" "kk" "ky"
"mk" "mn" "ru" "sr" "tg" "uk")
@@ -181,18 +197,28 @@ (define (system-services->configuration services)
(if (null? snippets)
`(,@(if (null? packages)
- '()
+ (if (target-hurd?)
+ `(,@package-heading
+ (packages %base-packages/hurd))
+ '())
`(,@package-heading
(packages (append (list ,@packages)
- %base-packages))))
+ ,(if (target-hurd?)
+ '%base-packages/hurd
+ '%base-packages)))))
,@service-heading
(services ,services))
`(,@(if (null? packages)
- '()
+ (if (target-hurd?)
+ `(,@package-heading
+ (packages %base-packages/hurd))
+ '())
`(,@package-heading
(packages (append (list ,@packages)
- %base-packages))))
+ ,(if (target-hurd?)
+ '%base-packages/hurd
+ '%base-packages)))))
,@service-heading
(services (append (list ,@snippets
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
index de0a852f02..34dd14c9d5 100644
--- a/gnu/installer/steps.scm
+++ b/gnu/installer/steps.scm
@@ -23,6 +23,7 @@ (define-module (gnu installer steps)
#:use-module (guix build utils)
#:use-module (guix i18n)
#:use-module (guix read-print)
+ #:use-module (guix utils)
#:use-module (gnu installer utils)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
@@ -240,17 +241,20 @@ (define (format-configuration steps results)
,(comment (G_ "\
;; Indicate which modules to import to access the variables
;; used in this configuration.\n"))
- (use-modules (gnu))
+ ,@(if (target-hurd?)
+ '((use-modules (gnu) (gnu system hurd))
+ (use-package-modules hurd ssh))
+ '((use-modules (gnu))))
(use-service-modules cups desktop networking ssh xorg))))
`(,@modules
,(vertical-space 1)
(operating-system ,@configuration))))
(define* (configuration->file configuration
- #:key (filename (%installer-configuration-file)))
- "Write the given CONFIGURATION to FILENAME."
- (mkdir-p (dirname filename))
- (call-with-output-file filename
+ #:key (file-name (%installer-configuration-file)))
+ "Write the given CONFIGURATION to FILE-NAME."
+ (mkdir-p (dirname file-name))
+ (call-with-output-file file-name
(lambda (port)
;; TRANSLATORS: This is a comment within a Scheme file. Each line must
;; start with ";; " (two semicolons and a space). Please keep line
diff --git a/gnu/installer/tests.scm b/gnu/installer/tests.scm
index 8785cd9a9f..a9a5d5d988 100644
--- a/gnu/installer/tests.scm
+++ b/gnu/installer/tests.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -35,6 +36,7 @@ (define-module (gnu installer tests)
choose-locale+keyboard
enter-host-name+passwords
+ choose-kernel
choose-services
choose-partitioning
start-installation
@@ -211,6 +213,15 @@ (define* (enter-host-name+passwords port
(password ,password)))
names passwords))))))
+(define* (choose-kernel port #:key (kernel "Linux Libre"))
+ "Converse over PORT with the guided installer to choose the specified
+KERNEL."
+ (converse port
+ ((list-selection (title "Kernel")
+ (multiple-choices? #f)
+ (items _))
+ kernel)))
+
(define* (choose-services port
#:key
(choose-desktop-environment? (const #f))
diff --git a/gnu/local.mk b/gnu/local.mk
index 872e55eb41..e2392962b4 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -863,6 +863,7 @@ INSTALLER_MODULES = \
%D%/installer/final.scm \
%D%/installer/hardware.scm \
%D%/installer/hostname.scm \
+ %D%/installer/kernel.scm \
%D%/installer/keymap.scm \
%D%/installer/locale.scm \
%D%/installer/newt.scm \
@@ -881,6 +882,7 @@ INSTALLER_MODULES = \
%D%/installer/newt/final.scm \
%D%/installer/newt/parameters.scm \
%D%/installer/newt/hostname.scm \
+ %D%/installer/newt/kernel.scm \
%D%/installer/newt/keymap.scm \
%D%/installer/newt/locale.scm \
%D%/installer/newt/menu.scm \
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index 283bae6f10..9a351529e8 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -48,6 +48,7 @@ (define-module (gnu system hurd)
#:export (%base-packages/hurd
%base-services/hurd
%base-services+qemu-networking/hurd
+ %desktop-services/hurd
%hurd-default-operating-system
%hurd-default-operating-system-kernel
%setuid-programs/hurd))
@@ -107,6 +108,8 @@ (define %base-services+qemu-networking/hurd
%qemu-static-networking))
%base-services/hurd))
+(define %desktop-services/hurd %base-services/hurd)
+
(define %setuid-programs/hurd
;; Default set of setuid-root programs.
(map file-like->setuid-program
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 36dbd9111f..c8dccd38b0 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -3,7 +3,7 @@
;;; Copyright © 2017, 2019, 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
-;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -1869,6 +1869,10 @@ (define* (gui-test-program marionette
#$marionette)
(screenshot "installer-services.ppm")
+ (when #$(target-x86?)
+ (marionette-eval* '(choose-kernel installer-socket) #$marionette)
+ (screenshot "installer-kernel.ppm"))
+
(marionette-eval* '(choose-services installer-socket
#:choose-desktop-environment?
(const #$desktop?)
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 17/18] installer: Add static-networking template.
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (15 preceding siblings ...)
2024-10-30 14:30 ` [bug#73927] [PATCH v4 16/18] installer: Add "Kernel" page to select the Hurd Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 18/18] installer: Support dry-run from Guile via store Janneke Nieuwenhuizen
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927; +Cc: Josselin Poiret, Ludovic Courtès, Mathieu Othacehe
* gnu/installer/services.scm (%system-services): Add
static-networking-service-type.
Change-Id: Iec6336f8d1f49e8b801e978d5c9eeb4f83a6e748
---
gnu/installer/services.scm | 22 ++++++++++++++++++++++
1 file changed, 22 insertions(+)
diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm
index d5a382606c..8b117d9a20 100644
--- a/gnu/installer/services.scm
+++ b/gnu/installer/services.scm
@@ -149,6 +149,28 @@ (define (%system-services)
(name (G_ "DHCP client (dynamic IP address assignment)"))
(type 'network-management)
(snippet '((service dhcp-client-service-type))))
+ (system-service
+ (name (G_ "Static networking service."))
+ (type 'network-management)
+ (snippet `((service
+ static-networking-service-type
+ (list %loopback-static-networking
+ (static-networking
+ (addresses
+ (list
+ (network-address
+ (device "eth0")
+ ,(comment (G_ ";; Fill-in your IP.\n"))
+ (value "192.168.178.10/24"))))
+ (routes
+ (list (network-route
+ (destination "default")
+ ,(comment (G_ ";; Fill-in your gateway IP.\n"))
+ (gateway "192.168.178.1"))))
+ (requirement '())
+ (provision '(networking))
+ ,(comment (G_ ";; Fill-in your nameservers.\n"))
+ (name-servers '("192.168.178.1"))))))))
;; Dealing with documents.
(system-service
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
* [bug#73927] [PATCH v4 18/18] installer: Support dry-run from Guile via store.
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
` (16 preceding siblings ...)
2024-10-30 14:30 ` [bug#73927] [PATCH v4 17/18] installer: Add static-networking template Janneke Nieuwenhuizen
@ 2024-10-30 14:30 ` Janneke Nieuwenhuizen
17 siblings, 0 replies; 61+ messages in thread
From: Janneke Nieuwenhuizen @ 2024-10-30 14:30 UTC (permalink / raw)
To: 73927; +Cc: Josselin Poiret, Ludovic Courtès, Mathieu Othacehe
This supports running the installer quasi-directly from Guile by only building
a Guile installer-script in the store. Do something like:
./pre-inst-env guile -c '((@ (gnu installer) run-installer) #:dry-run? #t)'
or and BE VERY CAREFUL WHEN NOT USING #:DRY-RUN #T!
sudo -E ./pre-inst-env guile -c '((@ (gnu installer) run-installer))'
for this to work, you also need connman.
* gnu/installer.scm (installer-script, run-installer): New procedures.
Change-Id: I8cc1746845ec99f738e35fa91bb2342a674cfa88
---
gnu/installer.scm | 85 +++++++++++++++++++++++++++++++++++++++++++++--
1 file changed, 83 insertions(+), 2 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 31c0ff7ff4..0a36f1f67b 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -21,10 +21,14 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu installer)
+ #:use-module (guix build utils)
+ #:use-module (guix derivations)
#:use-module (guix discovery)
- #:use-module (guix packages)
#:use-module (guix gexp)
#:use-module (guix modules)
+ #:use-module (guix monads)
+ #:use-module (guix packages)
+ #:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix ui)
#:use-module ((guix self) #:select (make-config.scm))
@@ -56,7 +60,9 @@ (define-module (gnu installer)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (web uri)
- #:export (installer-program))
+ #:export (installer-program
+ installer-steps
+ run-installer))
(define module-to-import?
;; Return true for modules that should be imported. For (gnu system …) and
@@ -562,3 +568,78 @@ (define* (installer-program #:key dry-run?)
(execl #$(program-file "installer-real" installer-builder
#:guile guile-3.0-latest)
"installer-real"))))
+
+(define* (installer-script #:key dry-run?
+ (steps (installer-steps #:dry-run? dry-run?)))
+ (program-file
+ "installer-script"
+ #~(begin
+ (use-modules (gnu installer)
+ (gnu installer record)
+ (gnu installer keymap)
+ (gnu installer steps)
+ (gnu installer dump)
+ (gnu installer final)
+ (gnu installer hostname)
+ (gnu installer kernel)
+ (gnu installer locale)
+ (gnu installer parted)
+ (gnu installer services)
+ (gnu installer timezone)
+ (gnu installer user)
+ (gnu installer utils)
+ (gnu installer newt)
+ ((gnu installer newt keymap)
+ #:select (keyboard-layout->configuration))
+ (gnu services herd)
+ (guix i18n)
+ (guix build utils)
+ (guix utils)
+ ((system repl debug)
+ #:select (terminal-width))
+ (ice-9 match)
+ (ice-9 textual-ports))
+ (terminal-width 200)
+ (let* ((current-installer newt-installer)
+ (steps (#$steps current-installer)))
+ (catch #t
+ (lambda _
+ ((installer-init current-installer))
+ (parameterize ((%run-command-in-installer
+ (if #$dry-run?
+ dry-run-command
+ (installer-run-command current-installer)))
+ (%installer-configuration-file
+ (if #$dry-run?
+ "config.scm"
+ (%installer-configuration-file))))
+ (let ((results (run-installer-steps
+ #:rewind-strategy 'menu
+ #:menu-proc
+ (installer-menu-page current-installer)
+ #:steps steps
+ #:dry-run? #$dry-run?)))
+ (result-step results 'final)
+ ((installer-exit current-installer)))))
+ (const #f)
+ (lambda (key . args)
+ (sleep 10)
+ ((installer-exit current-installer))
+ (display-backtrace (make-stack #t) (current-error-port))
+ (apply throw key args)))))))
+
+(define* (run-installer #:key dry-run?)
+ "To run the installer from Guile without building it:
+ ./pre-inst-env guile -c '((@ (gnu installer) run-installer) #:dry-run? #t)'
+when using #:dry-run? #t, no root access is required and the LOCALE, KEYMAP,
+and PARTITION pages are skipped."
+ (let* ((script (installer-script #:dry-run? dry-run?))
+ (store (open-connection))
+ (drv (run-with-store store
+ (lower-object script)))
+ (program (match (derivation->output-paths drv)
+ ((("out" . program)) program)))
+ (outputs (build-derivations store (list drv))))
+ (close-connection store)
+ (format #t "running installer: ~a\n" program)
+ (invoke "./pre-inst-env" "guile" program)))
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply related [flat|nested] 61+ messages in thread
end of thread, other threads:[~2024-10-30 14:36 UTC | newest]
Thread overview: 61+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
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 ` [bug#73927] [PATCH 14/16] installer: Add "Kernel" page to select the Hurd Janneke Nieuwenhuizen
2024-10-21 18:14 ` 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
2024-10-25 9:39 ` [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
2024-10-25 9:39 ` [bug#73927] [PATCH v3 01/17] gnu: guile-fibers: Fix cross-build for " Janneke Nieuwenhuizen
2024-10-25 9:39 ` [bug#73927] [PATCH v3 02/17] guix system: When installing the Hurd, create essential devices Janneke Nieuwenhuizen
2024-10-25 9:39 ` [bug#73927] [PATCH v3 03/17] bootloader: grub: Remove hardcoded partition number for the Hurd Janneke Nieuwenhuizen
2024-10-25 9:39 ` [bug#73927] [PATCH v3 04/17] system: hurd: Remove qemu networking from %base-services/hurd Janneke Nieuwenhuizen
2024-10-25 9:39 ` [bug#73927] [PATCH v3 05/17] system: hurd: Add swap-services to hurd-default-essential-services Janneke Nieuwenhuizen
2024-10-25 9:39 ` [bug#73927] [PATCH v3 06/17] gnu: hurd: Support second boot Janneke Nieuwenhuizen
2024-10-25 9:39 ` [bug#73927] [PATCH v3 07/17] hurd-boot: " Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 08/17] maint: Add installer dependencies to the manifest Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 09/17] installer: Remove unused (newt) imports Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 10/17] installer: Align comments Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 11/17] installer: Use "partitioning-page" consistently Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 12/17] installer: Fix file-name typos Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 13/17] installer: Use `%' for parameter %run-command-in-installer Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 14/17] installer: Add dry-run? Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 15/17] installer: Add "Kernel" page to select the Hurd Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 16/17] installer: Add static-networking template Janneke Nieuwenhuizen
2024-10-25 9:40 ` [bug#73927] [PATCH v3 17/17] installer: Support dry-run from Guile via store Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 01/18] gnu: guile-fibers: Fix cross-build for " Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 02/18] reconfigure: Use native bootloader package for running the installer Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 03/18] guix system: When installing the Hurd, create essential devices Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 04/18] bootloader: grub: Remove hardcoded partition number for the Hurd Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 05/18] system: hurd: Remove qemu networking from %base-services/hurd Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 06/18] system: hurd: Add swap-services to hurd-default-essential-services Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 07/18] gnu: hurd: Support second boot Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 08/18] hurd-boot: " Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 09/18] maint: Add installer dependencies to the manifest Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 10/18] installer: Remove unused (newt) imports Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 11/18] installer: Align comments Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 12/18] installer: Use "partitioning-page" consistently Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 13/18] installer: Fix file-name typos Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 14/18] installer: Use `%' for parameter %run-command-in-installer Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 15/18] installer: Add dry-run? Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 16/18] installer: Add "Kernel" page to select the Hurd Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 17/18] installer: Add static-networking template Janneke Nieuwenhuizen
2024-10-30 14:30 ` [bug#73927] [PATCH v4 18/18] installer: Support dry-run from Guile via store Janneke Nieuwenhuizen
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).