From 726d0bd2f36363392ba2fcefd6e5d4aeed27dc9e Mon Sep 17 00:00:00 2001 From: Josselin Poiret Date: Sat, 15 Jan 2022 14:50:07 +0100 Subject: installer: Use named prompt to abort or break installer steps. * gnu/installer/steps.scm (run-installer-steps): Set up 'installer-step prompt. * gnu/installer/newt/ethernet.scm (run-ethernet-page) * gnu/installer/newt/final.scm (run-config-display-page, run-install-failed-page) * gnu/installer/newt/keymap.scm (run-layout-page, run-variant-page) * gnu/installer/newt/locale.scm (run-language-page, run-territory-page, run-codeset-page, run-modifier-page, run-locale-page) * gnu/installer/newt/network.scm (run-technology-page, wait-service-online) * gnu/installer/newt/page.scm (run-listbox-selection-page, run-checkbox-tree-page) * gnu/installer/newt/partition.scm (button-exit-action) * gnu/installer/newt/services.scm (run-desktop-environments-cbt-page, run-networking-cbt-page, run-other-services-cbt-page, run-network-management-page) * gnu/installer/newt/timezone.scm (run-timezone-page) * gnu/installer/newt/user.scm (run-user-page) * gnu/installer/newt/welcome.scm (run-menu-page) * gnu/installer/newt/wifi.scm (run-wifi-page): Use the 'installer-step prompt to abort. Signed-off-by: Mathieu Othacehe --- gnu/installer/steps.scm | 127 +++++++++++++++++++++--------------------------- 1 file changed, 55 insertions(+), 72 deletions(-) (limited to 'gnu/installer/steps.scm') diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm index d9b3d6d07e..8bc38181a7 100644 --- a/gnu/installer/steps.scm +++ b/gnu/installer/steps.scm @@ -28,13 +28,7 @@ #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (rnrs io ports) - #:export (&installer-step-abort - installer-step-abort? - - &installer-step-break - installer-step-break? - - + #:export ( installer-step make-installer-step installer-step? @@ -60,14 +54,6 @@ ;; purposes. (define %current-result (make-hash-table)) -;; This condition may be raised to abort the current step. -(define-condition-type &installer-step-abort &condition - installer-step-abort?) - -;; This condition may be raised to break out from the steps execution. -(define-condition-type &installer-step-break &condition - installer-step-break?) - ;; An installer-step record is basically an id associated to a compute ;; procedure. The COMPUTE procedure takes exactly one argument, an association ;; list containing the results of previously executed installer-steps (see @@ -94,8 +80,10 @@ (rewind-strategy 'previous) (menu-proc (const #f))) "Run the COMPUTE procedure of all records in STEPS -sequentially. If the &installer-step-abort condition is raised, fallback to a -previous install-step, accordingly to the specified REWIND-STRATEGY. +sequentially, inside a the 'installer-step prompt. When aborted to with a +parameter of 'abort, fallback to a previous install-step, accordingly to the +specified REWIND-STRATEGY. When aborted to with a parameter of 'break, stop +the computation and return the accumalated result so far. REWIND-STRATEGY possible values are 'previous, 'menu and 'start. If 'previous is selected, the execution will resume at the previous installer-step. If @@ -112,10 +100,7 @@ the form: where STEP-ID is the ID field of the installer-step and COMPUTE-RESULT the result of the associated COMPUTE procedure. This result association list is passed as argument of every COMPUTE procedure. It is finally returned when the -computation is over. - -If the &installer-step-break condition is raised, stop the computation and -return the accumalated result so far." +computation is over." (define (pop-result list) (cdr list)) @@ -149,63 +134,61 @@ return the accumalated result so far." (match todo-steps (() (reverse result)) ((step . rest-steps) - (guard (c ((installer-step-abort? c) - (case rewind-strategy - ((previous) - (match done-steps - (() - ;; We cannot go previous the first step. So re-raise - ;; the exception. It might be useful in the case of - ;; nested run-installer-steps. Abort to 'raise-above - ;; prompt to prevent the condition from being catched - ;; by one of the previously installed guard. - (abort-to-prompt 'raise-above c)) - ((prev-done ... last-done) - (run (pop-result result) - #:todo-steps (cons last-done todo-steps) - #:done-steps prev-done)))) - ((menu) - (let ((goto-step (menu-proc - (append done-steps (list step))))) - (if (eq? goto-step step) - (run result - #:todo-steps todo-steps - #:done-steps done-steps) - (skip-to-step goto-step result - #:todo-steps todo-steps - #:done-steps done-steps)))) - ((start) - (if (null? done-steps) - ;; Same as above, it makes no sense to jump to start - ;; when we are at the first installer-step. Abort to - ;; 'raise-above prompt to re-raise the condition. - (abort-to-prompt 'raise-above c) - (run '() - #:todo-steps steps - #:done-steps '()))))) - ((installer-step-break? c) - (reverse result))) - (installer-log-line "running step '~a'" (installer-step-id step)) - (let* ((id (installer-step-id step)) - (compute (installer-step-compute step)) - (res (compute result done-steps))) - (hash-set! %current-result id res) - (run (alist-cons id res result) - #:todo-steps rest-steps - #:done-steps (append done-steps (list step)))))))) + (call-with-prompt 'installer-step + (lambda () + (installer-log-line "running step '~a'" (installer-step-id step)) + (let* ((id (installer-step-id step)) + (compute (installer-step-compute step)) + (res (compute result done-steps))) + (hash-set! %current-result id res) + (run (alist-cons id res result) + #:todo-steps rest-steps + #:done-steps (append done-steps (list step))))) + (lambda (k action) + (match action + ('abort + (case rewind-strategy + ((previous) + (match done-steps + (() + ;; We cannot go previous the first step. Abort again to + ;; 'installer-step prompt. It might be useful in the case + ;; of nested run-installer-steps. + (abort-to-prompt 'installer-step action)) + ((prev-done ... last-done) + (run (pop-result result) + #:todo-steps (cons last-done todo-steps) + #:done-steps prev-done)))) + ((menu) + (let ((goto-step (menu-proc + (append done-steps (list step))))) + (if (eq? goto-step step) + (run result + #:todo-steps todo-steps + #:done-steps done-steps) + (skip-to-step goto-step result + #:todo-steps todo-steps + #:done-steps done-steps)))) + ((start) + (if (null? done-steps) + ;; Same as above, it makes no sense to jump to start + ;; when we are at the first installer-step. Abort to + ;; 'installer-step prompt again. + (abort-to-prompt 'installer-step action) + (run '() + #:todo-steps steps + #:done-steps '()))))) + ('break + (reverse result)))))))) ;; Ignore SIGPIPE so that we don't die if a client closes the connection ;; prematurely. (sigaction SIGPIPE SIG_IGN) (with-server-socket - (call-with-prompt 'raise-above - (lambda () - (run '() - #:todo-steps steps - #:done-steps '())) - (lambda (k condition) - (raise condition))))) + (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." -- cgit v1.2.3