me
/
guix
Archived
1
0
Fork 0
Code

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 <othacehe@gnu.org>
master
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

73
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,17 +134,27 @@ 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
(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 (case rewind-strategy
((previous) ((previous)
(match done-steps (match done-steps
(() (()
;; We cannot go previous the first step. So re-raise ;; We cannot go previous the first step. Abort again to
;; the exception. It might be useful in the case of ;; 'installer-step prompt. It might be useful in the case
;; nested run-installer-steps. Abort to 'raise-above ;; of nested run-installer-steps.
;; prompt to prevent the condition from being catched (abort-to-prompt 'installer-step action))
;; by one of the previously installed guard.
(abort-to-prompt 'raise-above c))
((prev-done ... last-done) ((prev-done ... last-done)
(run (pop-result result) (run (pop-result result)
#:todo-steps (cons last-done todo-steps) #:todo-steps (cons last-done todo-steps)
@ -178,34 +173,22 @@ return the accumalated result so far."
(if (null? done-steps) (if (null? done-steps)
;; Same as above, it makes no sense to jump to start ;; Same as above, it makes no sense to jump to start
;; when we are at the first installer-step. Abort to ;; when we are at the first installer-step. Abort to
;; 'raise-above prompt to re-raise the condition. ;; 'installer-step prompt again.
(abort-to-prompt 'raise-above c) (abort-to-prompt 'installer-step action)
(run '() (run '()
#:todo-steps steps #:todo-steps steps
#:done-steps '()))))) #:done-steps '())))))
((installer-step-break? c) ('break
(reverse result))) (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))))))))
;; 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
(lambda ()
(run '() (run '()
#:todo-steps steps #:todo-steps steps
#:done-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."