diff options
Diffstat (limited to 'gnu/installer')
| -rw-r--r-- | gnu/installer/newt.scm | 14 | ||||
| -rw-r--r-- | gnu/installer/newt/final.scm | 20 | ||||
| -rw-r--r-- | gnu/installer/newt/keymap.scm | 5 | ||||
| -rw-r--r-- | gnu/installer/newt/locale.scm | 6 | ||||
| -rw-r--r-- | gnu/installer/newt/partition.scm | 1 | ||||
| -rw-r--r-- | gnu/installer/parted.scm | 29 | ||||
| -rw-r--r-- | gnu/installer/steps.scm | 16 | ||||
| -rw-r--r-- | gnu/installer/utils.scm | 4 |
8 files changed, 66 insertions, 29 deletions
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 @@ report it by email to ~a.") uploaded-name %guix-bug-report-address) (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 @@ report it by email to ~a.") uploaded-name %guix-bug-report-address) (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 @@ a specific step, or restart the installer.")) (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 @@ a specific step, or restart the installer.")) (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 @@ and #f." "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 @@ options." "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 @@ symbol.") (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 @@ glibc locale string and return it." ;; 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 @@ from (gnu system mapped-devices) and return it." (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* (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 @@ computation is over." ;; 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 @@ 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 @@ in a pseudoterminal." (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) |