[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#53063] [PATCH v2 wip-harden-installer 15/18] installer: Add error p
From: |
Josselin Poiret |
Subject: |
[bug#53063] [PATCH v2 wip-harden-installer 15/18] installer: Add error page when running external commands. |
Date: |
Sat, 15 Jan 2022 14:50:08 +0100 |
* gnu/installer/newt.scm (newt-run-command): Add it.
* gnu/installer/newt/page.scm (%ok-button, %exit-button,
%default-buttons, make-newt-buttons, run-textbox-page): Add them.
---
gnu/installer/newt.scm | 54 +++++++++++++++++++++---
gnu/installer/newt/page.scm | 83 +++++++++++++++++++++++++++++++++++++
2 files changed, 132 insertions(+), 5 deletions(-)
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index fc851339d1..352d2997bd 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -41,6 +41,8 @@ (define-module (gnu installer newt)
#:use-module (guix discovery)
#:use-module (guix i18n)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
#:use-module (newt)
#:export (newt-installer))
@@ -80,11 +82,53 @@ (define (exit-error file report key args)
(clear-screen))
(define (newt-run-command . args)
- (newt-suspend)
- (clear-screen)
- (define result (run-command args))
- (newt-resume)
- result)
+ (define command-output "")
+ (define (line-accumulator line)
+ (set! command-output
+ (string-append/shared command-output line "\n")))
+ (define displayed-command
+ (string-join
+ (map (lambda (s) (string-append "\"" s "\"")) args)
+ " "))
+ (define result (run-external-command-with-line-hooks (list line-accumulator)
+ args))
+ (define exit-val (status:exit-val result))
+ (define term-sig (status:term-sig result))
+ (define stop-sig (status:stop-sig result))
+
+ (if (and exit-val (zero? exit-val))
+ #t
+ (let ((info-text
+ (cond
+ (exit-val
+ (format #f (G_ "External command ~s exited with code ~a")
+ args exit-val))
+ (term-sig
+ (format #f (G_ "External command ~s terminated by signal ~a")
+ args term-sig))
+ (stop-sig
+ (format #f (G_ "External command ~s stopped by signal ~a")
+ args stop-sig)))))
+ (run-textbox-page #:title (G_ "External command error")
+ #:info-text info-text
+ #:content command-output
+ #:buttons-spec
+ (list
+ (cons "Ignore" (const #t))
+ (cons "Abort"
+ (lambda ()
+ (abort-to-prompt 'installer-step 'abort)))
+ (cons "Dump"
+ (lambda ()
+ (raise
+ (condition
+ ((@@ (guix build utils)
+ &invoke-error)
+ (program (car args))
+ (arguments (cdr args))
+ (exit-status exit-val)
+ (term-signal term-sig)
+ (stop-signal stop-sig)))))))))))
(define (final-page result prev-steps)
(run-final-page result prev-steps))
diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
index 8c675fa837..b5d7c98094 100644
--- a/gnu/installer/newt/page.scm
+++ b/gnu/installer/newt/page.scm
@@ -44,6 +44,9 @@ (define-module (gnu installer newt page)
run-scale-page
run-checkbox-tree-page
run-file-textbox-page
+ %ok-button
+ %exit-button
+ run-textbox-page
run-form-with-clients))
@@ -816,3 +819,83 @@ (define result
(components=? argument edit-button))
(loop) ;recurse in tail position
result)))))
+
+(define %ok-button
+ (cons (G_ "Ok") (lambda () #t)))
+
+(define %exit-button
+ (cons (G_ "Exit") (lambda () (abort-to-prompt 'installer-step 'abort))))
+
+(define %default-buttons
+ (list %ok-button %exit-button))
+
+(define (make-newt-buttons buttons-spec)
+ (map
+ (match-lambda ((title . proc)
+ (cons (make-button -1 -1 title) proc)))
+ buttons-spec))
+
+(define* (run-textbox-page #:key
+ title
+ info-text
+ content
+ (buttons-spec %default-buttons))
+ "Run a page to display INFO-TEXT followed by CONTENT to the user, who has to
+choose an action among the buttons specified by BUTTONS-SPEC.
+
+BUTTONS-SPEC is an association list with button labels as keys, and callback
+procedures as values.
+
+This procedure returns the result of the callback procedure of the button
+chosen by the user."
+ (define info-textbox
+ (make-reflowed-textbox -1 -1 info-text
+ 50
+ #:flags FLAG-BORDER))
+ (define content-textbox
+ (make-textbox -1 -1
+ 50
+ 30
+ (logior FLAG-SCROLL FLAG-BORDER)))
+ (define buttons
+ (make-newt-buttons buttons-spec))
+ (define grid
+ (vertically-stacked-grid
+ GRID-ELEMENT-COMPONENT info-textbox
+ GRID-ELEMENT-COMPONENT content-textbox
+ GRID-ELEMENT-SUBGRID
+ (apply
+ horizontal-stacked-grid
+ (append-map (match-lambda ((button . proc)
+ (list GRID-ELEMENT-COMPONENT button)))
+ buttons))))
+ (define form (make-form #:flags FLAG-NOF12))
+ (add-form-to-grid grid form #t)
+ (make-wrapped-grid-window grid title)
+ (set-textbox-text content-textbox
+ (receive (_w _h text)
+ (reflow-text content
+ 50
+ 0 0)
+ text))
+
+ (receive (exit-reason argument)
+ (run-form-with-clients form
+ `(contents-dialog (title ,title)
+ (text ,info-text)
+ (content ,content)))
+ (destroy-form-and-pop form)
+ (match exit-reason
+ ('exit-component
+ (let ((proc (assq-ref buttons argument)))
+ (if proc
+ (proc)
+ (raise
+ (condition
+ (&serious)
+ (&message
+ (message (format #f "Unable to find corresponding PROC for \
+component ~a." argument))))))))
+ ;; TODO
+ ('exit-fd-ready
+ (raise (condition (&serious)))))))
--
2.34.0
- [bug#53063] [PATCH v2 wip-harden-installer 06/18] installer: Remove specific logging code., (continued)
- [bug#53063] [PATCH v2 wip-harden-installer 06/18] installer: Remove specific logging code., Josselin Poiret, 2022/01/15
- [bug#53063] [PATCH v2 wip-harden-installer 13/18] installer: Add nano to PATH., Josselin Poiret, 2022/01/15
- [bug#53063] [PATCH v2 wip-harden-installer 12/18] installer: Replace run-command by invoke in newt/page.scm., Josselin Poiret, 2022/01/15
- [bug#53063] [PATCH v2 wip-harden-installer 09/18] installer: Use run-command-in-installer in (gnu installer parted)., Josselin Poiret, 2022/01/15
- [bug#53063] [PATCH v2 wip-harden-installer 02/18] installer: Generalize logging facility., Josselin Poiret, 2022/01/15
- [bug#53063] [PATCH v2 wip-harden-installer 07/18] installer: Capture external commands output., Josselin Poiret, 2022/01/15
- [bug#53063] [PATCH v2 wip-harden-installer 05/18] installer: Keep PATH inside the install container., Josselin Poiret, 2022/01/15
- [bug#53063] [PATCH v2 wip-harden-installer 10/18] installer: Raise condition when mklabel fails., Josselin Poiret, 2022/01/15
- [bug#53063] [PATCH v2 wip-harden-installer 11/18] installer: Fix run-file-textbox-page when edit-button is #f., Josselin Poiret, 2022/01/15
- [bug#53063] [PATCH v2 wip-harden-installer 14/18] installer: Use named prompt to abort or break installer steps., Josselin Poiret, 2022/01/15
- [bug#53063] [PATCH v2 wip-harden-installer 15/18] installer: Add error page when running external commands.,
Josselin Poiret <=
- [bug#53063] [PATCH v2 wip-harden-installer 18/18] installer: Make dump archive creation optional and selective., Josselin Poiret, 2022/01/15
- [bug#53063] [PATCH v2 wip-harden-installer 01/18] installer: Use define instead of let at top-level., Josselin Poiret, 2022/01/15
- [bug#53063] [PATCH v2 wip-harden-installer 16/18] installer: Use dynamic-wind to setup installer., Josselin Poiret, 2022/01/15
- [bug#53063] [PATCH v2 wip-harden-installer 17/18] installer: Turn passwords into opaque records., Josselin Poiret, 2022/01/15
- [bug#53063] [PATCH wip-harden-installer 00/14] General improvements to the installer, Mathieu Othacehe, 2022/01/17
- [bug#53063] [PATCH] installer: Use system-wide guix for system init., Josselin Poiret, 2022/01/31
[bug#53063] [PATCH wip-harden-installer 10/14] installer: Raise condition when mklabel fails., Josselin Poiret, 2022/01/06
[bug#53063] [PATCH wip-harden-installer 09/14] installer: Use the command capturing facility for guix init., Josselin Poiret, 2022/01/06
[bug#53063] [PATCH wip-harden-installer 12/14] installer: Replace run-command by invoke in newt/page.scm., Josselin Poiret, 2022/01/06
[bug#53063] [PATCH wip-harden-installer 11/14] installer: Fix run-file-textbox-page when edit-button is #f., Josselin Poiret, 2022/01/06