guix
/
guix
mirror of git://git.savannah.gnu.org/guix.git
3
4
Fork 0
Code Issues Releases Wiki Activity

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>
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
(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 @@ connection is pending."
#: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))))

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

@ -59,9 +59,7 @@ This will take a few minutes.")
#: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 @@ press the button to reboot.")))
(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)))

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

@ -59,9 +59,7 @@ different layout at any time from the parameters menu.")))
((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 @@ different layout at any time from the parameters menu.")))
#: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."

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

@ -43,9 +43,7 @@ installation process and for the installed system.")
#: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 @@ installation process and for the installed system.")
#: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 @@ installation process and for the installed system.")
#: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 @@ symbol.")
#: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 @@ associating a territory code with a territory name. The formatted locale, under
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 @@ glibc locale string and return it."
;; 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)))

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_ "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 @@ network devices were found. Do you want to continue anyway?"))
#: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 @@ FULL-VALUE tentatives, spaced by 1 second."
(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

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))))
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 @@ ITEMS when 'Ok' is pressed."
(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)

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

@ -36,10 +36,8 @@
#: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."

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
#: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."
@ -65,9 +63,7 @@ system.")
#:checkbox-tree-height 5
#:exit-button-callback-procedure
(lambda ()
(raise
(condition
(&installer-step-abort)))))))
(abort-to-prompt 'installer-step 'abort)))))
(define (run-printing-services-cbt-page)
"Run a page allowing the user to select document services such as CUPS."
@ -85,9 +81,7 @@ system.")
#:checkbox-tree-height 9
#:exit-button-callback-procedure
(lambda ()
(raise
(condition
(&installer-step-abort)))))))
(abort-to-prompt 'installer-step 'abort)))))
(define (run-console-services-cbt-page)
"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-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)))

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

@ -65,9 +65,7 @@ returned."
#: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

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

@ -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 @@ administrator (\"root\").")
(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

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))))
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))

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

@ -237,9 +237,7 @@ force a wifi scan."
(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

127
gnu/installer/steps.scm
View File

@ -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?
<installer-step>
#:export (<installer-step>
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 <installer-step> 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."