futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

installer: Use named prompt to abort or break installer steps.

Browse Source 
* 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 <othacehe@gnu.org>
This commit is contained in:
Josselin Poiret 2022-01-15 14:50:07 +01:00 committed by Mathieu Othacehe
parent 59fec4a1a2
commit 726d0bd2f3
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
13 changed files with 85 additions and 148 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gnu/installer/newt/ethernet.scm
View File

@ -65,9 +65,7 @@ connection is pending."
(run-error-page (run-error-page
(G_ "No ethernet service available, please try again.") (G_ "No ethernet service available, please try again.")
(G_ "No service")) (G_ "No service"))
(raise (abort-to-prompt 'installer-step 'abort))
(condition
(&installer-step-abort))))
((service) ((service)
;; Only one service is available so return it directly. ;; Only one service is available so return it directly.
service) service)
@ -81,7 +79,5 @@ connection is pending."
#:button-text (G_ "Exit") #:button-text (G_ "Exit")
#:button-callback-procedure #:button-callback-procedure
(lambda _ (lambda _
(raise (abort-to-prompt 'installer-step 'abort))
(condition
(&installer-step-abort))))
#:listbox-callback-procedure connect-ethernet-service)))) #:listbox-callback-procedure connect-ethernet-service))))

8
gnu/installer/newt/final.scm
View File

@ -59,9 +59,7 @@ This will take a few minutes.")
#:file-textbox-height height #:file-textbox-height height
#:exit-button-callback-procedure #:exit-button-callback-procedure
(lambda () (lambda ()
(raise (abort-to-prompt 'installer-step 'abort)))))
(condition
(&installer-step-abort)))))))
(define (run-install-success-page) (define (run-install-success-page)
(match (current-clients) (match (current-clients)
@ -88,9 +86,7 @@ press the button to reboot.")))
(G_ "Restart the installer") (G_ "Restart the installer")
(G_ "The final system installation step failed. You can resume from \ (G_ "The final system installation step failed. You can resume from \
a specific step, or restart the installer.")) a specific step, or restart the installer."))
(1 (raise (1 (abort-to-prompt 'installer-step 'abort))
(condition
(&installer-step-abort))))
(2 (2
;; Keep going, the installer will be restarted later on. ;; Keep going, the installer will be restarted later on.
#t))) #t)))

8
gnu/installer/newt/keymap.scm
View File

@ -59,9 +59,7 @@ different layout at any time from the parameters menu.")))
((param) (const #f)) ((param) (const #f))
(else (else
(lambda _ (lambda _
(raise (abort-to-prompt 'installer-step 'abort)))))))
(condition
(&installer-step-abort)))))))))
(define (run-variant-page variants variant->text) (define (run-variant-page variants variant->text)
(let ((title (G_ "Variant"))) (let ((title (G_ "Variant")))
@ -74,9 +72,7 @@ different layout at any time from the parameters menu.")))
#:button-text (G_ "Back") #:button-text (G_ "Back")
#:button-callback-procedure #:button-callback-procedure
(lambda _ (lambda _
(raise (abort-to-prompt 'installer-step 'abort)))))
(condition
(&installer-step-abort)))))))
(define (sort-layouts layouts) (define (sort-layouts layouts)
"Sort LAYOUTS list by putting the US layout ahead and return it." "Sort LAYOUTS list by putting the US layout ahead and return it."

25
gnu/installer/newt/locale.scm
View File

@ -43,9 +43,7 @@ installation process and for the installed system.")
#:button-text (G_ "Exit") #:button-text (G_ "Exit")
#:button-callback-procedure #:button-callback-procedure
(lambda _ (lambda _
(raise (abort-to-prompt 'installer-step 'abort))))
(condition
(&installer-step-abort))))))
;; Immediately install the chosen language so that the territory page that ;; Immediately install the chosen language so that the territory page that
;; comes after (optionally) is displayed in the chosen language. ;; comes after (optionally) is displayed in the chosen language.
@ -63,9 +61,7 @@ installation process and for the installed system.")
#:button-text (G_ "Back") #:button-text (G_ "Back")
#:button-callback-procedure #:button-callback-procedure
(lambda _ (lambda _
(raise (abort-to-prompt 'installer-step 'abort)))))
(condition
(&installer-step-abort)))))))
(define (run-codeset-page codesets) (define (run-codeset-page codesets)
(let ((title (G_ "Locale codeset"))) (let ((title (G_ "Locale codeset")))
@ -78,9 +74,7 @@ installation process and for the installed system.")
#:button-text (G_ "Back") #:button-text (G_ "Back")
#:button-callback-procedure #:button-callback-procedure
(lambda _ (lambda _
(raise (abort-to-prompt 'installer-step 'abort)))))
(condition
(&installer-step-abort)))))))
(define (run-modifier-page modifiers modifier->text) (define (run-modifier-page modifiers modifier->text)
(let ((title (G_ "Locale modifier"))) (let ((title (G_ "Locale modifier")))
@ -94,9 +88,7 @@ symbol.")
#:button-text (G_ "Back") #:button-text (G_ "Back")
#:button-callback-procedure #:button-callback-procedure
(lambda _ (lambda _
(raise (abort-to-prompt 'installer-step 'abort)))))
(condition
(&installer-step-abort)))))))
(define* (run-locale-page #:key (define* (run-locale-page #:key
supported-locales supported-locales
@ -110,11 +102,10 @@ associating a territory code with a territory name. The formatted locale, under
glibc format is returned." glibc format is returned."
(define (break-on-locale-found locales) (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." element."
(and (= (length locales) 1) (and (= (length locales) 1)
(raise (abort-to-prompt 'installer-step 'break)))
(condition (&installer-step-break)))))
(define (filter-locales locales result) (define (filter-locales locales result)
"Filter the list of locale records LOCALES using the RESULT returned by "Filter the list of locale records LOCALES using the RESULT returned by
@ -218,8 +209,8 @@ glibc locale string and return it."
;; If run-installer-steps returns locally, it means that the user had to go ;; 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 ;; through all steps (language, territory, codeset and modifier) to select a
;; locale. In that case, like if we exited by raising &installer-step-break ;; locale. In that case, like if we exited by breaking to the installer
;; condition, turn the result into a glibc locale string and return it. ;; step, turn the result into a glibc locale string and return it.
(result->locale-string (result->locale-string
supported-locales supported-locales
(run-installer-steps #:steps locale-steps))) (run-installer-steps #:steps locale-steps)))

16
gnu/installer/newt/network.scm
View File

@ -65,12 +65,8 @@ Internet and return the selected technology. For now, only technologies with
(G_ "Exit") (G_ "Exit")
(G_ "The install process requires Internet access but no \ (G_ "The install process requires Internet access but no \
network devices were found. Do you want to continue anyway?")) network devices were found. Do you want to continue anyway?"))
((1) (raise ((1) (abort-to-prompt 'installer-step 'break))
(condition ((2) (abort-to-prompt 'installer-step 'abort))))
(&installer-step-break))))
((2) (raise
(condition
(&installer-step-abort))))))
((technology) ((technology)
;; Since there's only one technology available, skip the selection ;; Since there's only one technology available, skip the selection
;; screen. ;; screen.
@ -86,9 +82,7 @@ network devices were found. Do you want to continue anyway?"))
#:button-text (G_ "Exit") #:button-text (G_ "Exit")
#:button-callback-procedure #:button-callback-procedure
(lambda _ (lambda _
(raise (abort-to-prompt 'installer-step 'abort))))))
(condition
(&installer-step-abort))))))))
(define (find-technology-by-type technologies type) (define (find-technology-by-type technologies type)
"Find and return a technology with the given TYPE in TECHNOLOGIES list." "Find and return a technology with the given TYPE in TECHNOLOGIES list."
@ -156,9 +150,7 @@ FULL-VALUE tentatives, spaced by 1 second."
(G_ "The selected network does not provide access to the \ (G_ "The selected network does not provide access to the \
Internet and the Guix substitute server, please try again.") Internet and the Guix substitute server, please try again.")
(G_ "Connection error")) (G_ "Connection error"))
(raise (abort-to-prompt 'installer-step 'abort))))
(condition
(&installer-step-abort))))))
(define (run-network-page) (define (run-network-page)
"Run a page to allow the user to configure connman so that it can access the "Run a page to allow the user to configure connman so that it can access the

4
gnu/installer/newt/page.scm
View File

@ -488,7 +488,7 @@ the current listbox item has to be selected by key."
(string=? str (listbox-item->text item)))) (string=? str (listbox-item->text item))))
keys) keys)
((key . item) item) ((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, ;; 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, ;; depending on the 'last-listbox-key', jump forward or backward. If no,
@ -690,7 +690,7 @@ ITEMS when 'Ok' is pressed."
(string=? str (item->text item)))) (string=? str (item->text item))))
keys) keys)
((key . item) item) ((key . item) item)
(#f (raise (condition (&installer-step-abort)))))) (#f (abort-to-prompt 'installer-step 'abort))))
(add-form-to-grid grid form #t) (add-form-to-grid grid form #t)
(make-wrapped-grid-window grid title) (make-wrapped-grid-window grid title)

6
gnu/installer/newt/partition.scm
View File

@ -36,10 +36,8 @@
#:export (run-partitioning-page)) #:export (run-partitioning-page))
(define (button-exit-action) (define (button-exit-action)
"Raise the &installer-step-abort condition." "Abort the installer step."
(raise (abort-to-prompt 'installer-step 'abort))
(condition
(&installer-step-abort))))
(define (run-scheme-page) (define (run-scheme-page)
"Run a page asking the user for a partitioning scheme." "Run a page asking the user for a partitioning scheme."

16
gnu/installer/newt/services.scm
View File

@ -46,9 +46,7 @@ to choose from them later when you log in.")
#:checkbox-tree-height 9 #:checkbox-tree-height 9
#:exit-button-callback-procedure #:exit-button-callback-procedure
(lambda () (lambda ()
(raise (abort-to-prompt 'installer-step 'abort)))))
(condition
(&installer-step-abort)))))))
(define (run-networking-cbt-page) (define (run-networking-cbt-page)
"Run a page allowing the user to select networking services." "Run a page allowing the user to select networking services."
@ -65,9 +63,7 @@ system.")
#:checkbox-tree-height 5 #:checkbox-tree-height 5
#:exit-button-callback-procedure #:exit-button-callback-procedure
(lambda () (lambda ()
(raise (abort-to-prompt 'installer-step 'abort)))))
(condition
(&installer-step-abort)))))))
(define (run-printing-services-cbt-page) (define (run-printing-services-cbt-page)
"Run a page allowing the user to select document services such as CUPS." "Run a page allowing the user to select document services such as CUPS."
@ -85,9 +81,7 @@ system.")
#:checkbox-tree-height 9 #:checkbox-tree-height 9
#:exit-button-callback-procedure #:exit-button-callback-procedure
(lambda () (lambda ()
(raise (abort-to-prompt 'installer-step 'abort)))))
(condition
(&installer-step-abort)))))))
(define (run-console-services-cbt-page) (define (run-console-services-cbt-page)
"Run a page to select various system adminstration services for non-graphical "Run a page to select various system adminstration services for non-graphical
@ -130,9 +124,7 @@ client may be enough for a server.")
#:button-text (G_ "Exit") #:button-text (G_ "Exit")
#:button-callback-procedure #:button-callback-procedure
(lambda _ (lambda _
(raise (abort-to-prompt 'installer-step 'abort)))))
(condition
(&installer-step-abort)))))))
(define (run-services-page) (define (run-services-page)
(let ((desktop (run-desktop-environments-cbt-page))) (let ((desktop (run-desktop-environments-cbt-page)))

4
gnu/installer/newt/timezone.scm
View File

@ -65,9 +65,7 @@ returned."
#:button-callback-procedure #:button-callback-procedure
(if (null? path) (if (null? path)
(lambda _ (lambda _
(raise (abort-to-prompt 'installer-step 'abort))
(condition
(&installer-step-abort))))
(lambda _ (lambda _
(loop (all-but-last path)))) (loop (all-but-last path))))
#:listbox-callback-procedure #:listbox-callback-procedure

5
gnu/installer/newt/user.scm
View File

@ -20,7 +20,6 @@
(define-module (gnu installer newt user) (define-module (gnu installer newt user)
#:use-module (gnu installer 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 page)
#:use-module (gnu installer newt utils) #:use-module (gnu installer newt utils)
#:use-module (gnu installer utils) #:use-module (gnu installer utils)
@ -257,9 +256,7 @@ administrator (\"root\").")
(run users)) (run users))
(reverse users)) (reverse users))
((components=? argument exit-button) ((components=? argument exit-button)
(raise (abort-to-prompt 'installer-step 'abort))))
(condition
(&installer-step-abort))))))
('exit-fd-ready ('exit-fd-ready
;; Read the complete user list at once. ;; Read the complete user list at once.
(match argument (match argument

2
gnu/installer/newt/welcome.scm
View File

@ -84,7 +84,7 @@ we want this page to occupy all the screen space available."
(string=? str (listbox-item->text item)))) (string=? str (listbox-item->text item))))
keys) keys)
((key . item) item) ((key . item) item)
(#f (raise (condition (&installer-step-abort)))))) (#f (abort-to-prompt 'installer-step 'abort))))
(set-textbox-text logo-textbox (read-all logo)) (set-textbox-text logo-textbox (read-all logo))

4
gnu/installer/newt/wifi.scm
View File

@ -237,9 +237,7 @@ force a wifi scan."
(run-wifi-scan-page) (run-wifi-scan-page)
(run-wifi-page)) (run-wifi-page))
((components=? argument exit-button) ((components=? argument exit-button)
(raise (abort-to-prompt 'installer-step 'abort))
(condition
(&installer-step-abort))))
((components=? argument listbox) ((components=? argument listbox)
(let ((result (connect-wifi-service listbox service-items))) (let ((result (connect-wifi-service listbox service-items)))
(unless result (unless result

127
gnu/installer/steps.scm
View File

@ -28,13 +28,7 @@
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (srfi srfi-35) #:use-module (srfi srfi-35)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:export (&installer-step-abort #:export (<installer-step>
installer-step-abort?
&installer-step-break
installer-step-break?
<installer-step>
installer-step installer-step
make-installer-step make-installer-step
installer-step? installer-step?
@ -60,14 +54,6 @@
;; purposes. ;; purposes.
(define %current-result (make-hash-table)) (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 ;; An installer-step record is basically an id associated to a compute
;; procedure. The COMPUTE procedure takes exactly one argument, an association ;; procedure. The COMPUTE procedure takes exactly one argument, an association
;; list containing the results of previously executed installer-steps (see ;; list containing the results of previously executed installer-steps (see
@ -94,8 +80,10 @@
(rewind-strategy 'previous) (rewind-strategy 'previous)
(menu-proc (const #f))) (menu-proc (const #f)))
"Run the COMPUTE procedure of all <installer-step> records in STEPS "Run the COMPUTE procedure of all <installer-step> records in STEPS
sequentially. If the &installer-step-abort condition is raised, fallback to a sequentially, inside a the 'installer-step prompt. When aborted to with a
previous install-step, accordingly to the specified REWIND-STRATEGY. 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 REWIND-STRATEGY possible values are 'previous, 'menu and 'start. If 'previous
is selected, the execution will resume at the previous installer-step. If 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 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 result of the associated COMPUTE procedure. This result association list is
passed as argument of every COMPUTE procedure. It is finally returned when the passed as argument of every COMPUTE procedure. It is finally returned when the
computation is over. computation is over."
If the &installer-step-break condition is raised, stop the computation and
return the accumalated result so far."
(define (pop-result list) (define (pop-result list)
(cdr list)) (cdr list))
@ -149,63 +134,61 @@ return the accumalated result so far."
(match todo-steps (match todo-steps
(() (reverse result)) (() (reverse result))
((step . rest-steps) ((step . rest-steps)
(guard (c ((installer-step-abort? c) (call-with-prompt 'installer-step
(case rewind-strategy (lambda ()
((previous) (installer-log-line "running step '~a'" (installer-step-id step))
(match done-steps (let* ((id (installer-step-id step))
(() (compute (installer-step-compute step))
;; We cannot go previous the first step. So re-raise (res (compute result done-steps)))
;; the exception. It might be useful in the case of (hash-set! %current-result id res)
;; nested run-installer-steps. Abort to 'raise-above (run (alist-cons id res result)
;; prompt to prevent the condition from being catched #:todo-steps rest-steps
;; by one of the previously installed guard. #:done-steps (append done-steps (list step)))))
(abort-to-prompt 'raise-above c)) (lambda (k action)
((prev-done ... last-done) (match action
(run (pop-result result) ('abort
#:todo-steps (cons last-done todo-steps) (case rewind-strategy
#:done-steps prev-done)))) ((previous)
((menu) (match done-steps
(let ((goto-step (menu-proc (()
(append done-steps (list step))))) ;; We cannot go previous the first step. Abort again to
(if (eq? goto-step step) ;; 'installer-step prompt. It might be useful in the case
(run result ;; of nested run-installer-steps.
#:todo-steps todo-steps (abort-to-prompt 'installer-step action))
#:done-steps done-steps) ((prev-done ... last-done)
(skip-to-step goto-step result (run (pop-result result)
#:todo-steps todo-steps #:todo-steps (cons last-done todo-steps)
#:done-steps done-steps)))) #:done-steps prev-done))))
((start) ((menu)
(if (null? done-steps) (let ((goto-step (menu-proc
;; Same as above, it makes no sense to jump to start (append done-steps (list step)))))
;; when we are at the first installer-step. Abort to (if (eq? goto-step step)
;; 'raise-above prompt to re-raise the condition. (run result
(abort-to-prompt 'raise-above c) #:todo-steps todo-steps
(run '() #:done-steps done-steps)
#:todo-steps steps (skip-to-step goto-step result
#:done-steps '()))))) #:todo-steps todo-steps
((installer-step-break? c) #:done-steps done-steps))))
(reverse result))) ((start)
(installer-log-line "running step '~a'" (installer-step-id step)) (if (null? done-steps)
(let* ((id (installer-step-id step)) ;; Same as above, it makes no sense to jump to start
(compute (installer-step-compute step)) ;; when we are at the first installer-step. Abort to
(res (compute result done-steps))) ;; 'installer-step prompt again.
(hash-set! %current-result id res) (abort-to-prompt 'installer-step action)
(run (alist-cons id res result) (run '()
#:todo-steps rest-steps #:todo-steps steps
#:done-steps (append done-steps (list step)))))))) #:done-steps '())))))
('break
(reverse result))))))))
;; Ignore SIGPIPE so that we don't die if a client closes the connection ;; Ignore SIGPIPE so that we don't die if a client closes the connection
;; prematurely. ;; prematurely.
(sigaction SIGPIPE SIG_IGN) (sigaction SIGPIPE SIG_IGN)
(with-server-socket (with-server-socket
(call-with-prompt 'raise-above (run '()
(lambda () #:todo-steps steps
(run '() #:done-steps '())))
#:todo-steps steps
#:done-steps '()))
(lambda (k condition)
(raise condition)))))
(define (find-step-by-id steps id) (define (find-step-by-id steps id)
"Find and return the step in STEPS whose id is equal to ID." "Find and return the step in STEPS whose id is equal to ID."