From patchwork Thu Jan 6 22:48:11 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36056 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id B7D0027BBEA; Thu, 6 Jan 2022 22:49:43 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 6FB1B27BBE9 for ; Thu, 6 Jan 2022 22:49:42 +0000 (GMT) Received: from localhost ([::1]:46086 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n5bZl-0000ha-LB for patchwork@mira.cbaines.net; Thu, 06 Jan 2022 17:49:41 -0500 Received: from eggs.gnu.org ([209.51.188.92]:57594) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n5bZF-0007gc-0d for guix-patches@gnu.org; Thu, 06 Jan 2022 17:49:09 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:49736) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n5bZE-00076M-Lw for guix-patches@gnu.org; Thu, 06 Jan 2022 17:49:08 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n5bZD-00006e-KU for guix-patches@gnu.org; Thu, 06 Jan 2022 17:49:07 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH wip-harden-installer 13/14] installer: Use named prompt to abort or break installer steps. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 06 Jan 2022 22:49:07 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 53063 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 53063@debbugs.gnu.org Cc: Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.164150932932747 (code B ref 53063); Thu, 06 Jan 2022 22:49:07 +0000 Received: (at 53063) by debbugs.gnu.org; 6 Jan 2022 22:48:49 +0000 Received: from localhost ([127.0.0.1]:42626 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n5bYu-0008W1-HM for submit@debbugs.gnu.org; Thu, 06 Jan 2022 17:48:49 -0500 Received: from jpoiret.xyz ([206.189.101.64]:36708) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n5bYo-0008Uo-Tp for 53063@debbugs.gnu.org; Thu, 06 Jan 2022 17:48:44 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id 231B3184F80; Thu, 6 Jan 2022 22:48:42 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1641509322; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=DAxEQKvyMfo/Xih4brOMPePoGAvUlusna/GoEYajyO0=; b=dCotqraAhSazmyCbX/Vs1qiJpr7sJsTe8ktwmhTjqtwjw2IGvf3yunClNk7rt/ZiFENf2h XIIdKvFyvh61EjHZnVSg7hfAXkMuLdx5jRHCNmexQf23qbegBR9Vaqsw1dZ7w4E0qsNDH9 EcrLo+QJ27n3qxXqWMQWxqFDLHpazjsoIT95ybDUuXZxJX9QuIK3aetb9mmzvChEVIGUpk aPBpt5CHsRggRv698zVkTDc0FZEiE2Vo4mW9W+Bc+SpffaT6C8yhV8F7jcEAWsAxn2Sr3Y G8UirPAfRr3QF9g5SgEAf/dysC4JzYg31A3jNpHrHuEFikpqT+t15ym4T5fy1g== Date: Thu, 6 Jan 2022 23:48:11 +0100 Message-Id: <9c265e5c19afad5c3a1f8aa397657fb29389064c.1641507696.git.dev@jpoiret.xyz> In-Reply-To: References: MIME-Version: 1.0 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * 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. --- gnu/installer/newt/ethernet.scm | 8 +- gnu/installer/newt/final.scm | 8 +- gnu/installer/newt/keymap.scm | 8 +- gnu/installer/newt/locale.scm | 25 ++---- gnu/installer/newt/network.scm | 16 +--- gnu/installer/newt/page.scm | 4 +- gnu/installer/newt/partition.scm | 6 +- gnu/installer/newt/services.scm | 16 +--- gnu/installer/newt/timezone.scm | 4 +- gnu/installer/newt/user.scm | 5 +- gnu/installer/newt/welcome.scm | 2 +- gnu/installer/newt/wifi.scm | 4 +- gnu/installer/steps.scm | 127 +++++++++++++------------------ 13 files changed, 85 insertions(+), 148 deletions(-) diff --git a/gnu/installer/newt/ethernet.scm b/gnu/installer/newt/ethernet.scm index ecd22efbb2..d75a640519 100644 --- a/gnu/installer/newt/ethernet.scm +++ b/gnu/installer/newt/ethernet.scm @@ -65,9 +65,7 @@ (define (run-ethernet-page) (run-error-page (G_ "No ethernet service available, please try again.") (G_ "No service")) - (raise - (condition - (&installer-step-abort)))) + (abort-to-prompt 'installer-step 'abort)) ((service) ;; Only one service is available so return it directly. service) @@ -81,7 +79,5 @@ (define (run-ethernet-page) #:button-text (G_ "Exit") #:button-callback-procedure (lambda _ - (raise - (condition - (&installer-step-abort)))) + (abort-to-prompt 'installer-step 'abort)) #:listbox-callback-procedure connect-ethernet-service)))) diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm index 07e8cf3864..bd1b53b9f3 100644 --- a/gnu/installer/newt/final.scm +++ b/gnu/installer/newt/final.scm @@ -59,9 +59,7 @@ (define* (run-config-display-page #:key locale) #:file-textbox-height height #:exit-button-callback-procedure (lambda () - (raise - (condition - (&installer-step-abort))))))) + (abort-to-prompt 'installer-step 'abort))))) (define (run-install-success-page) (match (current-clients) @@ -88,9 +86,7 @@ (define (run-install-failed-page) (G_ "Restart the installer") (G_ "The final system installation step failed. You can resume from \ a specific step, or restart the installer.")) - (1 (raise - (condition - (&installer-step-abort)))) + (1 (abort-to-prompt 'installer-step 'abort)) (2 ;; Keep going, the installer will be restarted later on. #t))) diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm index 92f7f46f34..c5d4be6792 100644 --- a/gnu/installer/newt/keymap.scm +++ b/gnu/installer/newt/keymap.scm @@ -59,9 +59,7 @@ (define (run-layout-page layouts layout->text context) ((param) (const #f)) (else (lambda _ - (raise - (condition - (&installer-step-abort))))))))) + (abort-to-prompt 'installer-step 'abort))))))) (define (run-variant-page variants variant->text) (let ((title (G_ "Variant"))) @@ -74,9 +72,7 @@ (define (run-variant-page variants variant->text) #:button-text (G_ "Back") #:button-callback-procedure (lambda _ - (raise - (condition - (&installer-step-abort))))))) + (abort-to-prompt 'installer-step 'abort))))) (define (sort-layouts layouts) "Sort LAYOUTS list by putting the US layout ahead and return it." diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm index bfd89aca2c..01171e253f 100644 --- a/gnu/installer/newt/locale.scm +++ b/gnu/installer/newt/locale.scm @@ -43,9 +43,7 @@ (define result #:button-text (G_ "Exit") #:button-callback-procedure (lambda _ - (raise - (condition - (&installer-step-abort)))))) + (abort-to-prompt 'installer-step 'abort)))) ;; Immediately install the chosen language so that the territory page that ;; comes after (optionally) is displayed in the chosen language. @@ -63,9 +61,7 @@ (define (run-territory-page territories territory->text) #:button-text (G_ "Back") #:button-callback-procedure (lambda _ - (raise - (condition - (&installer-step-abort))))))) + (abort-to-prompt 'installer-step 'abort))))) (define (run-codeset-page codesets) (let ((title (G_ "Locale codeset"))) @@ -78,9 +74,7 @@ (define (run-codeset-page codesets) #:button-text (G_ "Back") #:button-callback-procedure (lambda _ - (raise - (condition - (&installer-step-abort))))))) + (abort-to-prompt 'installer-step 'abort))))) (define (run-modifier-page modifiers modifier->text) (let ((title (G_ "Locale modifier"))) @@ -94,9 +88,7 @@ (define (run-modifier-page modifiers modifier->text) #:button-text (G_ "Back") #:button-callback-procedure (lambda _ - (raise - (condition - (&installer-step-abort))))))) + (abort-to-prompt 'installer-step 'abort))))) (define* (run-locale-page #:key supported-locales @@ -110,11 +102,10 @@ (define* (run-locale-page #:key glibc format is returned." (define (break-on-locale-found locales) - "Raise the &installer-step-break condition if LOCALES contains exactly one + "Break to the installer step if LOCALES contains exactly one element." (and (= (length locales) 1) - (raise - (condition (&installer-step-break))))) + (abort-to-prompt 'installer-step 'break))) (define (filter-locales locales result) "Filter the list of locale records LOCALES using the RESULT returned by @@ -218,8 +209,8 @@ (define locale-steps ;; If run-installer-steps returns locally, it means that the user had to go ;; through all steps (language, territory, codeset and modifier) to select a - ;; locale. In that case, like if we exited by raising &installer-step-break - ;; condition, turn the result into a glibc locale string and return it. + ;; locale. In that case, like if we exited by breaking to the installer + ;; step, turn the result into a glibc locale string and return it. (result->locale-string supported-locales (run-installer-steps #:steps locale-steps))) diff --git a/gnu/installer/newt/network.scm b/gnu/installer/newt/network.scm index fb221483c3..0477a489be 100644 --- a/gnu/installer/newt/network.scm +++ b/gnu/installer/newt/network.scm @@ -65,12 +65,8 @@ (define (technology-items) (G_ "Exit") (G_ "The install process requires Internet access but no \ network devices were found. Do you want to continue anyway?")) - ((1) (raise - (condition - (&installer-step-break)))) - ((2) (raise - (condition - (&installer-step-abort)))))) + ((1) (abort-to-prompt 'installer-step 'break)) + ((2) (abort-to-prompt 'installer-step 'abort)))) ((technology) ;; Since there's only one technology available, skip the selection ;; screen. @@ -86,9 +82,7 @@ (define (technology-items) #:button-text (G_ "Exit") #:button-callback-procedure (lambda _ - (raise - (condition - (&installer-step-abort)))))))) + (abort-to-prompt 'installer-step 'abort)))))) (define (find-technology-by-type technologies type) "Find and return a technology with the given TYPE in TECHNOLOGIES list." @@ -156,9 +150,7 @@ (define (online?) (G_ "The selected network does not provide access to the \ Internet and the Guix substitute server, please try again.") (G_ "Connection error")) - (raise - (condition - (&installer-step-abort)))))) + (abort-to-prompt 'installer-step 'abort)))) (define (run-network-page) "Run a page to allow the user to configure connman so that it can access the diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm index 695c7d875f..8c675fa837 100644 --- a/gnu/installer/newt/page.scm +++ b/gnu/installer/newt/page.scm @@ -488,7 +488,7 @@ (define (choice->item str) (string=? str (listbox-item->text item)))) keys) ((key . item) item) - (#f (raise (condition (&installer-step-abort)))))) + (#f (abort-to-prompt 'installer-step 'abort)))) ;; On every listbox element change, check if we need to skip it. If yes, ;; depending on the 'last-listbox-key', jump forward or backward. If no, @@ -690,7 +690,7 @@ (define (choice->item str) (string=? str (item->text item)))) keys) ((key . item) item) - (#f (raise (condition (&installer-step-abort)))))) + (#f (abort-to-prompt 'installer-step 'abort)))) (add-form-to-grid grid form #t) (make-wrapped-grid-window grid title) diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm index 6a3aa3daff..e7a97810ac 100644 --- a/gnu/installer/newt/partition.scm +++ b/gnu/installer/newt/partition.scm @@ -36,10 +36,8 @@ (define-module (gnu installer newt partition) #:export (run-partitioning-page)) (define (button-exit-action) - "Raise the &installer-step-abort condition." - (raise - (condition - (&installer-step-abort)))) + "Abort the installer step." + (abort-to-prompt 'installer-step 'abort)) (define (run-scheme-page) "Run a page asking the user for a partitioning scheme." diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm index 1af4e7df2d..0a2fc834e1 100644 --- a/gnu/installer/newt/services.scm +++ b/gnu/installer/newt/services.scm @@ -45,9 +45,7 @@ (define (run-desktop-environments-cbt-page) #:checkbox-tree-height 9 #:exit-button-callback-procedure (lambda () - (raise - (condition - (&installer-step-abort))))))) + (abort-to-prompt 'installer-step 'abort))))) (define (run-networking-cbt-page) "Run a page allowing the user to select networking services." @@ -64,9 +62,7 @@ (define (run-networking-cbt-page) #:checkbox-tree-height 5 #:exit-button-callback-procedure (lambda () - (raise - (condition - (&installer-step-abort))))))) + (abort-to-prompt 'installer-step 'abort))))) (define (run-other-services-cbt-page) "Run a page allowing the user to select other services." @@ -86,9 +82,7 @@ (define (run-other-services-cbt-page) #:checkbox-tree-height 9 #:exit-button-callback-procedure (lambda () - (raise - (condition - (&installer-step-abort))))))) + (abort-to-prompt 'installer-step 'abort))))) (define (run-network-management-page) "Run a page to select among several network management methods." @@ -110,9 +104,7 @@ (define (run-network-management-page) #:button-text (G_ "Exit") #:button-callback-procedure (lambda _ - (raise - (condition - (&installer-step-abort))))))) + (abort-to-prompt 'installer-step 'abort))))) (define (run-services-page) (let ((desktop (run-desktop-environments-cbt-page))) diff --git a/gnu/installer/newt/timezone.scm b/gnu/installer/newt/timezone.scm index 67bf41ff84..bed9f9d5cb 100644 --- a/gnu/installer/newt/timezone.scm +++ b/gnu/installer/newt/timezone.scm @@ -65,9 +65,7 @@ (define (loop path) #:button-callback-procedure (if (null? path) (lambda _ - (raise - (condition - (&installer-step-abort)))) + (abort-to-prompt 'installer-step 'abort)) (lambda _ (loop (all-but-last path)))) #:listbox-callback-procedure diff --git a/gnu/installer/newt/user.scm b/gnu/installer/newt/user.scm index 58bb86bf96..97141cfe64 100644 --- a/gnu/installer/newt/user.scm +++ b/gnu/installer/newt/user.scm @@ -20,7 +20,6 @@ (define-module (gnu installer newt user) #:use-module (gnu installer user) - #:use-module ((gnu installer steps) #:select (&installer-step-abort)) #:use-module (gnu installer newt page) #:use-module (gnu installer newt utils) #:use-module (gnu installer utils) @@ -257,9 +256,7 @@ (define (run users) (run users)) (reverse users)) ((components=? argument exit-button) - (raise - (condition - (&installer-step-abort)))))) + (abort-to-prompt 'installer-step 'abort)))) ('exit-fd-ready ;; Read the complete user list at once. (match argument diff --git a/gnu/installer/newt/welcome.scm b/gnu/installer/newt/welcome.scm index 5f461279e2..7a7ddfb7bd 100644 --- a/gnu/installer/newt/welcome.scm +++ b/gnu/installer/newt/welcome.scm @@ -84,7 +84,7 @@ (define (choice->item str) (string=? str (listbox-item->text item)))) keys) ((key . item) item) - (#f (raise (condition (&installer-step-abort)))))) + (#f (abort-to-prompt 'installer-step 'abort)))) (set-textbox-text logo-textbox (read-all logo)) diff --git a/gnu/installer/newt/wifi.scm b/gnu/installer/newt/wifi.scm index f5d8f1fdbf..8a87cbdf4b 100644 --- a/gnu/installer/newt/wifi.scm +++ b/gnu/installer/newt/wifi.scm @@ -237,9 +237,7 @@ (define (run-wifi-page) (run-wifi-scan-page) (run-wifi-page)) ((components=? argument exit-button) - (raise - (condition - (&installer-step-abort)))) + (abort-to-prompt 'installer-step 'abort)) ((components=? argument listbox) (let ((result (connect-wifi-service listbox service-items))) (unless result diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm index d9b3d6d07e..bd99e1fa2a 100644 --- a/gnu/installer/steps.scm +++ b/gnu/installer/steps.scm @@ -28,13 +28,7 @@ (define-module (gnu installer steps) #: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 @@ (define-module (gnu installer steps) ;; 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 @@ (define* (run-installer-steps #:key (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 @@ (define* (run-installer-steps #:key 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 @@ (define* (run result #:key todo-steps done-steps) (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."