[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
09/20: installer: Add installer-specific run command process.
From: |
guix-commits |
Subject: |
09/20: installer: Add installer-specific run command process. |
Date: |
Wed, 2 Feb 2022 10:47:05 -0500 (EST) |
mothacehe pushed a commit to branch master
in repository guix.
commit 408427a36c6545115068d5f06de2ea21407374c6
Author: Josselin Poiret <dev@jpoiret.xyz>
AuthorDate: Sat Jan 15 14:50:01 2022 +0100
installer: Add installer-specific run command process.
* gnu/installer/record.scm (installer)[run-command]: Add field.
* gnu/installer/utils.scm (run-command-in-installer): Add parameter.
* gnu/installer.scm (installer-program): Parameterize
run-command-in-installer with current installer's run-command.
* gnu/installer/newt.scm (newt-run-command): New variable.
(newt-installer): Use it.
Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
---
gnu/installer.scm | 79 +++++++++++++++++++++++++-----------------------
gnu/installer/newt.scm | 10 +++++-
gnu/installer/record.scm | 7 +++--
gnu/installer/utils.scm | 10 ++++++
4 files changed, 65 insertions(+), 41 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index d0d012f04b..3cc5c79d4e 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -416,44 +416,47 @@ selected keymap."
(define steps (#$steps current-installer))
((installer-init 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)))
- (const #f)
- (lambda (key . args)
- (installer-log-line "crashing due to uncaught exception: ~s ~s"
- key args)
- (let ((error-file "/tmp/last-installer-error")
- (dump-archive "/tmp/dump.tgz"))
- (call-with-output-file error-file
- (lambda (port)
- (display-backtrace (make-stack #t) port)
- (print-exception port
- (stack-ref (make-stack #t) 1)
- key args)))
- (make-dump dump-archive
- #:result %current-result
- #:backtrace error-file)
- (let ((report
- ((installer-dump-page current-installer)
- dump-archive)))
- ((installer-exit-error current-installer)
- error-file report key args)))
- (primitive-exit 1)))
+ (parameterize
+ ((run-command-in-installer
+ (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)))
+ (const #f)
+ (lambda (key . args)
+ (installer-log-line "crashing due to uncaught exception: ~s
~s"
+ key args)
+ (let ((error-file "/tmp/last-installer-error")
+ (dump-archive "/tmp/dump.tgz"))
+ (call-with-output-file error-file
+ (lambda (port)
+ (display-backtrace (make-stack #t) port)
+ (print-exception port
+ (stack-ref (make-stack #t) 1)
+ key args)))
+ (make-dump dump-archive
+ #:result %current-result
+ #:backtrace error-file)
+ (let ((report
+ ((installer-dump-page current-installer)
+ dump-archive)))
+ ((installer-exit-error current-installer)
+ error-file report key args)))
+ (primitive-exit 1))))
((installer-exit current-installer))))))
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index 61fb9cf2ca..fc851339d1 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -79,6 +79,13 @@ problem. The backtrace is displayed below~a. Please report
it by email to \
(newt-finish)
(clear-screen))
+(define (newt-run-command . args)
+ (newt-suspend)
+ (clear-screen)
+ (define result (run-command args))
+ (newt-resume)
+ result)
+
(define (final-page result prev-steps)
(run-final-page result prev-steps))
@@ -150,4 +157,5 @@ problem. The backtrace is displayed below~a. Please report
it by email to \
(welcome-page welcome-page)
(parameters-menu parameters-menu)
(parameters-page parameters-page)
- (dump-page dump-page)))
+ (dump-page dump-page)
+ (run-command newt-run-command)))
diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm
index e7cd45ee83..23db3edd70 100644
--- a/gnu/installer/record.scm
+++ b/gnu/installer/record.scm
@@ -42,7 +42,8 @@
installer-welcome-page
installer-parameters-menu
installer-parameters-page
- installer-dump-page))
+ installer-dump-page
+ installer-run-command))
;;;
@@ -94,4 +95,6 @@
;; procedure (keyboard-layout-selection) -> void
(parameters-page installer-parameters-page)
;; procedure (dump) -> void
- (dump-page installer-dump-page))
+ (dump-page installer-dump-page)
+ ;; procedure command -> bool
+ (run-command installer-run-command))
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index 66c41ac2a1..fb62fb8896 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -25,6 +25,7 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
#:use-module (ice-9 control)
#:use-module (ice-9 match)
#:use-module (ice-9 popen)
@@ -39,6 +40,7 @@
run-external-command-with-handler
run-external-command-with-line-hooks
run-command
+ run-command-in-installer
syslog-port
%syslog-line-hook
@@ -168,6 +170,14 @@ successfully, #f otherwise."
(pause)
succeeded?)
+(define run-command-in-installer
+ (make-parameter
+ (lambda (. args)
+ (raise
+ (condition
+ (&serious)
+ (&message (message "run-command-in-installer not set")))))))
+
;;;
;;; Logging.
- branch master updated (8f58508327 -> 4943ac86e4), guix-commits, 2022/02/02
- 20/20: installer: Use system-wide guix for system init., guix-commits, 2022/02/02
- 11/20: installer: Raise condition when mklabel fails., guix-commits, 2022/02/02
- 01/20: installer: Add crash dump upload support., guix-commits, 2022/02/02
- 02/20: installer: Use define instead of let at top-level., guix-commits, 2022/02/02
- 04/20: installer: Use new installer-log-line everywhere., guix-commits, 2022/02/02
- 09/20: installer: Add installer-specific run command process.,
guix-commits <=
- 06/20: installer: Keep PATH inside the install container., guix-commits, 2022/02/02
- 12/20: installer: Fix run-file-textbox-page when edit-button is #f., guix-commits, 2022/02/02
- 17/20: installer: Use dynamic-wind to setup installer., guix-commits, 2022/02/02
- 13/20: installer: Replace run-command by invoke in newt/page.scm., guix-commits, 2022/02/02
- 03/20: installer: Generalize logging facility., guix-commits, 2022/02/02
- 15/20: installer: Use named prompt to abort or break installer steps., guix-commits, 2022/02/02
- 14/20: installer: Add nano to PATH., guix-commits, 2022/02/02
- 19/20: installer: Make dump archive creation optional and selective., guix-commits, 2022/02/02
- 16/20: installer: Add error page when running external commands., guix-commits, 2022/02/02
- 10/20: installer: Use run-command-in-installer in (gnu installer parted)., guix-commits, 2022/02/02