amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00: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
Download patch file Download diff file Expand all files Collapse all files

79
gnu/installer.scm
View file

@ -134,7 +134,8 @@ version of this file."
(define* (compute-locale-step #:key (define* (compute-locale-step #:key
locales-name locales-name
iso639-languages-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 "Return a gexp that run the locale-page of INSTALLER, and install the
selected locale. The list of locales, languages and territories passed to selected locale. The list of locales, languages and territories passed to
locale-page are computed in derivations named respectively LOCALES-NAME, locale-page are computed in derivations named respectively LOCALES-NAME,
@ -177,8 +178,11 @@ been performed at build time."
((installer-locale-page current-installer) ((installer-locale-page current-installer)
#:supported-locales #$locales-loader #:supported-locales #$locales-loader
#:iso639-languages #$iso639-loader #:iso639-languages #$iso639-loader
#:iso3166-territories #$iso3166-loader))) #:iso3166-territories #$iso3166-loader
(#$apply-locale result) #:dry-run? #$dry-run?)))
(if #$dry-run?
'()
(#$apply-locale result))
result)))) result))))
(define apply-keymap (define apply-keymap
@ -188,7 +192,7 @@ been performed at build time."
(kmscon-update-keymap (default-keyboard-model) (kmscon-update-keymap (default-keyboard-model)
layout variant options)))) 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 "Return a gexp that runs the keymap-page of INSTALLER and install the
selected keymap." selected keymap."
#~(lambda (current-installer) #~(lambda (current-installer)
@ -200,15 +204,16 @@ selected keymap."
"/share/X11/xkb/rules/base.xml"))) "/share/X11/xkb/rules/base.xml")))
(lambda (models layouts) (lambda (models layouts)
((installer-keymap-page current-installer) ((installer-keymap-page current-installer)
layouts '#$context))))) layouts '#$context #$dry-run?)))))
(and result (#$apply-keymap result)) (and result (#$apply-keymap result))
result))) result)))
(define (installer-steps) (define* (installer-steps #:key dry-run?)
(let ((locale-step (compute-locale-step (let ((locale-step (compute-locale-step
#:locales-name "locales" #:locales-name "locales"
#:iso639-languages-name "iso639-languages" #:iso639-languages-name "iso639-languages"
#:iso3166-territories-name "iso3166-territories")) #:iso3166-territories-name "iso3166-territories"
#:dry-run? dry-run?))
(timezone-data #~(string-append #$tzdata (timezone-data #~(string-append #$tzdata
"/share/zoneinfo/zone.tab"))) "/share/zoneinfo/zone.tab")))
#~(lambda (current-installer) #~(lambda (current-installer)
@ -216,7 +221,7 @@ selected keymap."
(lambda () (lambda ()
((installer-parameters-page current-installer) ((installer-parameters-page current-installer)
(lambda _ (lambda _
(#$(compute-keymap-step 'param) (#$(compute-keymap-step 'param dry-run?)
current-installer))))) current-installer)))))
(list (list
;; Ask the user to choose a locale among those supported by ;; Ask the user to choose a locale among those supported by
@ -262,8 +267,10 @@ selected keymap."
(id 'keymap) (id 'keymap)
(description (G_ "Keyboard mapping selection")) (description (G_ "Keyboard mapping selection"))
(compute (lambda _ (compute (lambda _
(#$(compute-keymap-step 'default) (if #$dry-run?
current-installer))) '("en" "US" #f)
(#$(compute-keymap-step 'default dry-run?)
current-installer))))
(configuration-formatter keyboard-layout->configuration)) (configuration-formatter keyboard-layout->configuration))
;; Ask the user to input a hostname for the system. ;; Ask the user to input a hostname for the system.
@ -280,14 +287,18 @@ selected keymap."
(id 'network) (id 'network)
(description (G_ "Network selection")) (description (G_ "Network selection"))
(compute (lambda _ (compute (lambda _
((installer-network-page current-installer))))) (if #$dry-run?
'()
((installer-network-page current-installer))))))
;; Ask whether to enable substitute server discovery. ;; Ask whether to enable substitute server discovery.
(installer-step (installer-step
(id 'substitutes) (id 'substitutes)
(description (G_ "Substitute server discovery")) (description (G_ "Substitute server discovery"))
(compute (lambda _ (compute (lambda _
((installer-substitutes-page current-installer))))) (if #$dry-run?
'()
((installer-substitutes-page current-installer))))))
;; Prompt for users (name, group and home directory). ;; Prompt for users (name, group and home directory).
(installer-step (installer-step
@ -313,7 +324,9 @@ selected keymap."
(id 'partition) (id 'partition)
(description (G_ "Partitioning")) (description (G_ "Partitioning"))
(compute (lambda _ (compute (lambda _
((installer-partitioning-page current-installer)))) (if #$dry-run?
'()
((installer-partitioning-page current-installer)))))
(configuration-formatter user-partitions->configuration)) (configuration-formatter user-partitions->configuration))
(installer-step (installer-step
@ -322,7 +335,7 @@ selected keymap."
(compute (compute
(lambda (result prev-steps) (lambda (result prev-steps)
((installer-final-page current-installer) ((installer-final-page current-installer)
result prev-steps)))))))) result prev-steps #$dry-run?))))))))
(define (provenance-sexp) (define (provenance-sexp)
"Return an sexp representing the currently-used channels, for logging "Return an sexp representing the currently-used channels, for logging
@ -343,7 +356,7 @@ purposes."
`(channel ,(channel-name channel) ,url ,(channel-commit channel)))) `(channel ,(channel-name channel) ,url ,(channel-commit channel))))
channels)))) channels))))
(define (installer-program) (define* (installer-program #:key dry-run?)
"Return a file-like object that runs the given INSTALLER." "Return a file-like object that runs the given INSTALLER."
(define init-gettext (define init-gettext
;; Initialize gettext support, so that installer messages can be ;; Initialize gettext support, so that installer messages can be
@ -377,7 +390,7 @@ purposes."
(lambda () (lambda ()
(set-path-environment-variable "PATH" '("bin" "sbin") inputs))))) (set-path-environment-variable "PATH" '("bin" "sbin") inputs)))))
(define steps (installer-steps)) (define steps (installer-steps #:dry-run? dry-run?))
(define modules (define modules
(scheme-modules* (scheme-modules*
(string-append (current-source-directory) "/..") (string-append (current-source-directory) "/..")
@ -425,9 +438,10 @@ purposes."
;; Enable core dump generation. ;; Enable core dump generation.
(setrlimit 'core #f #f) (setrlimit 'core #f #f)
(call-with-output-file "/proc/sys/kernel/core_pattern" (unless #$dry-run?
(lambda (port) (call-with-output-file "/proc/sys/kernel/core_pattern"
(format port %core-dump))) (lambda (port)
(format port %core-dump))))
;; Initialize gettext support so that installers can use ;; Initialize gettext support so that installers can use
;; (guix i18n) module. ;; (guix i18n) module.
@ -466,24 +480,29 @@ purposes."
(lambda () (lambda ()
(parameterize (parameterize
((%run-command-in-installer ((%run-command-in-installer
(installer-run-command current-installer))) (if #$dry-run?
dry-run-command
(installer-run-command current-installer))))
(catch #t (catch #t
(lambda () (lambda ()
(define results (define results
(run-installer-steps (run-installer-steps
#:rewind-strategy 'menu #:rewind-strategy 'menu
#:menu-proc (installer-menu-page current-installer) #:menu-proc (installer-menu-page current-installer)
#:steps steps)) #:steps steps
#:dry-run? #$dry-run?))
(match (result-step results 'final) (let ((result (result-step results 'final)))
('success (unless #$dry-run?
;; We did it! Let's reboot! (match (result-step results 'final)
(sync) ('success
(stop-service 'root)) ;; We did it! Let's reboot!
(_ (sync)
;; The installation failed, exit so that it is (stop-service 'root))
;; restarted by login. (_
#f))) ;; The installation failed, exit so that it is
;; restarted by login.
#f)))))
(const #f) (const #f)
(lambda (key . args) (lambda (key . args)
(installer-log-line "crashing due to uncaught exception: ~s ~s" (installer-log-line "crashing due to uncaught exception: ~s ~s"

14
gnu/installer/newt.scm
View file

@ -158,17 +158,19 @@ report it by email to ~a.") uploaded-name %guix-bug-report-address)
(term-signal term-sig) (term-signal term-sig)
(stop-signal stop-sig))))))))))) (stop-signal stop-sig)))))))))))
(define (final-page result prev-steps) (define (final-page result prev-steps dry-run?)
(run-final-page result prev-steps)) (run-final-page result prev-steps dry-run?))
(define* (locale-page #:key (define* (locale-page #:key
supported-locales supported-locales
iso639-languages iso639-languages
iso3166-territories) iso3166-territories
dry-run?)
(run-locale-page (run-locale-page
#:supported-locales supported-locales #:supported-locales supported-locales
#:iso639-languages iso639-languages #:iso639-languages iso639-languages
#:iso3166-territories iso3166-territories)) #:iso3166-territories iso3166-territories
#:dry-run? dry-run?))
(define (timezone-page zonetab) (define (timezone-page zonetab)
(run-timezone-page zonetab)) (run-timezone-page zonetab))
@ -179,8 +181,8 @@ report it by email to ~a.") uploaded-name %guix-bug-report-address)
(define (menu-page steps) (define (menu-page steps)
(run-menu-page steps)) (run-menu-page steps))
(define* (keymap-page layouts context) (define (keymap-page layouts context dry-run?)
(run-keymap-page layouts #:context context)) (run-keymap-page layouts #:context context #:dry-run? dry-run?))
(define (network-page) (define (network-page)
(run-network-page)) (run-network-page))

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

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -106,7 +107,7 @@ a specific step, or restart the installer."))
(newt-resume) (newt-resume)
install-ok?)) install-ok?))
(define (run-final-page result prev-steps) (define (run-final-page-install result prev-steps)
(define (wait-for-clients) (define (wait-for-clients)
(unless (null? (current-clients)) (unless (null? (current-clients))
(installer-log-line "waiting with clients before starting final step") (installer-log-line "waiting with clients before starting final step")
@ -133,3 +134,20 @@ a specific step, or restart the installer."))
(if install-ok? (if install-ok?
(run-install-success-page) (run-install-success-page)
(run-install-failed-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 © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de> ;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -153,7 +154,7 @@ and #f."
"grp:alt_shift_toggle")) "grp:alt_shift_toggle"))
(list layout variant #f))) (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 "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 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 second layout and toggle options will be added automatically. Return a list
@ -201,7 +202,7 @@ options."
"xkeyboard-config"))))) "xkeyboard-config")))))
(toggleable-latin-layout layout variant))) (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)) (layout (result-step result 'layout))
(variant (result-step result 'variant))) (variant (result-step result 'variant)))
(and layout (and layout

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

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -92,7 +93,8 @@ symbol.")
(define* (run-locale-page #:key (define* (run-locale-page #:key
supported-locales supported-locales
iso639-languages iso639-languages
iso3166-territories) iso3166-territories
dry-run?)
"Run a page asking the user to select a locale language and possibly "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 territory, codeset and modifier. Use SUPPORTED-LOCALES as the list of glibc
available locales. ISO639-LANGUAGES is an association list associating a available locales. ISO639-LANGUAGES is an association list associating a
@ -212,4 +214,4 @@ glibc locale string and return it."
;; step, turn the result into a glibc locale string and return it. ;; step, turn the result into a glibc locale string and return it.
(result->locale-string (result->locale-string
supported-locales 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 © 2018, 2019, 2022 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;

27
gnu/installer/parted.scm
View file

@ -1461,19 +1461,22 @@ from (gnu system mapped-devices) and return it."
(define (bootloader-configuration user-partitions) (define (bootloader-configuration user-partitions)
"Return the bootloader configuration field for USER-PARTITIONS." "Return the bootloader configuration field for USER-PARTITIONS."
(let* ((root-partition (find root-user-partition? (let ((root-partition (find root-user-partition? user-partitions)))
user-partitions)) (match user-partitions
(root-partition-disk (user-partition-disk-file-name root-partition))) (() '())
`((bootloader-configuration (_
,@(if (efi-installation?) (let ((root-partition-disk (user-partition-disk-file-name
`((bootloader grub-efi-bootloader) root-partition)))
(targets (list ,(default-esp-mount-point)))) `((bootloader-configuration
`((bootloader grub-bootloader) ,@(if (efi-installation?)
(targets (list ,root-partition-disk)))) `((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 ;; XXX: Assume we defined the 'keyboard-layout' field of
;; <operating-system> right above. ;; <operating-system> right above.
(keyboard-layout keyboard-layout))))) (keyboard-layout keyboard-layout))))))))
(define (user-partition-missing-modules user-partitions) (define (user-partition-missing-modules user-partitions)
"Return the list of kernel modules missing from the default set of kernel "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 ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -84,7 +85,8 @@
(define* (run-installer-steps #:key (define* (run-installer-steps #:key
steps steps
(rewind-strategy 'previous) (rewind-strategy 'previous)
(menu-proc (const #f))) (menu-proc (const #f))
dry-run?)
"Run the COMPUTE procedure of all <installer-step> records in STEPS "Run the COMPUTE procedure of all <installer-step> records in STEPS
sequentially, inside a the 'installer-step prompt. When aborted to with a sequentially, inside a the 'installer-step prompt. When aborted to with a
parameter of 'abort, fallback to a previous install-step, accordingly to the parameter of 'abort, fallback to a previous install-step, accordingly to the
@ -191,10 +193,14 @@ computation is over."
;; prematurely. ;; prematurely.
(sigaction SIGPIPE SIG_IGN) (sigaction SIGPIPE SIG_IGN)
(with-server-socket (if dry-run?
(run '() (run '()
#:todo-steps steps #:todo-steps steps
#:done-steps '()))) #:done-steps '())
(with-server-socket
(run '()
#:todo-steps steps
#:done-steps '()))))
(define (find-step-by-id steps id) (define (find-step-by-id steps id)
"Find and return the step in STEPS whose id is equal to 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 @@
run-external-command-with-handler run-external-command-with-handler
run-external-command-with-handler/tty run-external-command-with-handler/tty
run-external-command-with-line-hooks run-external-command-with-line-hooks
dry-run-command
run-command run-command
%run-command-in-installer %run-command-in-installer
@ -222,6 +223,9 @@ in a pseudoterminal."
(pause) (pause)
succeeded?) succeeded?)
(define (dry-run-command . args)
(format #t "dry-run-command: skipping: ~a\n" args))
(define %run-command-in-installer (define %run-command-in-installer
(make-parameter (make-parameter
(lambda (. args) (lambda (. args)