TakeV/guix
1
0
Fork 0
Code Issues Pull requests 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 @@ (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))))

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

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

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

@ -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."

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

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

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

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

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

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

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

@ -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."

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

@ -46,9 +46,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."
@ -65,9 +63,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-printing-services-cbt-page)
"Run a page allowing the user to select document services such as CUPS."
@ -85,9 +81,7 @@ (define (run-printing-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-console-services-cbt-page)
"Run a page to select various system adminstration services for non-graphical
@ -130,9 +124,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)))

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

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

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 @@ (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

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

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

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

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

127
gnu/installer/steps.scm
View file

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