[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#73927] [PATCH v3 14/17] installer: Add dry-run?
|
From: |
Janneke Nieuwenhuizen |
|
Subject: |
[bug#73927] [PATCH v3 14/17] installer: Add dry-run? |
|
Date: |
Fri, 25 Oct 2024 11:40:06 +0200 |
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
- [bug#73927] [PATCH v2 14/16] installer: Add "Kernel" page to select the Hurd., (continued)
- [bug#73927] [PATCH v3 00/17] Installer support for (cross) installing the Hurd., Janneke Nieuwenhuizen, 2024/10/25
- [bug#73927] [PATCH v3 05/17] system: hurd: Add swap-services to hurd-default-essential-services., Janneke Nieuwenhuizen, 2024/10/25
- [bug#73927] [PATCH v3 04/17] system: hurd: Remove qemu networking from %base-services/hurd., Janneke Nieuwenhuizen, 2024/10/25
- [bug#73927] [PATCH v3 07/17] hurd-boot: Support second boot., Janneke Nieuwenhuizen, 2024/10/25
- [bug#73927] [PATCH v3 03/17] bootloader: grub: Remove hardcoded partition number for the Hurd., Janneke Nieuwenhuizen, 2024/10/25
- [bug#73927] [PATCH v3 02/17] guix system: When installing the Hurd, create essential devices., Janneke Nieuwenhuizen, 2024/10/25
- [bug#73927] [PATCH v3 01/17] gnu: guile-fibers: Fix cross-build for the Hurd., Janneke Nieuwenhuizen, 2024/10/25
- [bug#73927] [PATCH v3 08/17] maint: Add installer dependencies to the manifest., Janneke Nieuwenhuizen, 2024/10/25
- [bug#73927] [PATCH v3 11/17] installer: Use "partitioning-page" consistently., Janneke Nieuwenhuizen, 2024/10/25
- [bug#73927] [PATCH v3 14/17] installer: Add dry-run?,
Janneke Nieuwenhuizen <=
- [bug#73927] [PATCH v3 13/17] installer: Use `%' for parameter %run-command-in-installer., Janneke Nieuwenhuizen, 2024/10/25
- [bug#73927] [PATCH v3 16/17] installer: Add static-networking template., Janneke Nieuwenhuizen, 2024/10/25
- [bug#73927] [PATCH v3 15/17] installer: Add "Kernel" page to select the Hurd., Janneke Nieuwenhuizen, 2024/10/25
- [bug#73927] [PATCH v3 17/17] installer: Support dry-run from Guile via store., Janneke Nieuwenhuizen, 2024/10/25
- [bug#73927] [PATCH v3 06/17] gnu: hurd: Support second boot., Janneke Nieuwenhuizen, 2024/10/25
- [bug#73927] [PATCH v3 09/17] installer: Remove unused (newt) imports., Janneke Nieuwenhuizen, 2024/10/25
- [bug#73927] [PATCH v3 10/17] installer: Align comments., Janneke Nieuwenhuizen, 2024/10/25
- [bug#73927] [PATCH v3 12/17] installer: Fix file-name typos., Janneke Nieuwenhuizen, 2024/10/25
- [bug#73927] [PATCH v4 00/18] Installer support for (cross) installing the Hurd., Janneke Nieuwenhuizen, 2024/10/30