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