mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-18 13:36:36 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

installer: Add dry-run?

Browse source 
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
This commit is contained in:
Janneke Nieuwenhuizen 2024-10-15 23:27:17 +02:00 committed by Jan (janneke) Nieuwenhuizen
parent cca544513b
commit 9aeb8e3dee
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
9 changed files with 114 additions and 58 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

79
gnu/installer.scm
View file

@ -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))
#:steps steps
#:dry-run? #$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)))
(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"

14
gnu/installer/newt.scm
View file

@ -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))

20
gnu/installer/newt/final.scm
View file

@ -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)))

5
gnu/installer/newt/keymap.scm
View file

@ -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

6
gnu/installer/newt/locale.scm
View file

@ -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?)))

1
gnu/installer/newt/partition.scm
View file

@ -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.
;;;

27
gnu/installer/parted.scm
View file

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

16
gnu/installer/steps.scm
View file

@ -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."

4
gnu/installer/utils.scm
View file

@ -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)