me
/
guix
Archived
1
0
Fork 0
Code

installer: Use dynamic-wind to setup installer. 

* gnu/installer.scm (installer-program): Use dynamic-wind, so that
completely uncaught exceptions can be printed properly.

Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
master
Josselin Poiret 2022-01-15 14:50:09 +01:00 committed by Mathieu Othacehe
parent 7cbd95a9f6
commit 41eb0f01fc
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
1 changed files with 44 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
gnu/installer.scm
View File

@ -416,51 +416,52 @@ selected keymap."
(define current-installer newt-installer) (define current-installer newt-installer)
(define steps (#$steps current-installer)) (define steps (#$steps current-installer))
((installer-init current-installer)) (dynamic-wind
(installer-init current-installer)
(lambda ()
(parameterize
((run-command-in-installer
(installer-run-command current-installer)))
(catch #t
(lambda ()
(define results
(run-installer-steps
#:rewind-strategy 'menu
#:menu-proc (installer-menu-page current-installer)
#:steps steps))
(parameterize (match (result-step results 'final)
((run-command-in-installer ('success
(installer-run-command current-installer))) ;; We did it! Let's reboot!
(catch #t (sync)
(lambda () (stop-service 'root))
(define results (_
(run-installer-steps ;; The installation failed, exit so that it is restarted
#:rewind-strategy 'menu ;; by login.
#:menu-proc (installer-menu-page current-installer) #f)))
#:steps steps)) (const #f)
(lambda (key . args)
(installer-log-line "crashing due to uncaught exception: ~s ~s"
key args)
(let ((error-file "/tmp/last-installer-error")
(dump-archive "/tmp/dump.tgz"))
(call-with-output-file error-file
(lambda (port)
(display-backtrace (make-stack #t) port)
(print-exception port
(stack-ref (make-stack #t) 1)
key args)))
(make-dump dump-archive
#:result %current-result
#:backtrace error-file)
(let ((report
((installer-dump-page current-installer)
dump-archive)))
((installer-exit-error current-installer)
error-file report key args)))
(primitive-exit 1)))))
(match (result-step results 'final) (installer-exit current-installer))))))
('success
;; We did it! Let's reboot!
(sync)
(stop-service 'root))
(_
;; The installation failed, exit so that it is restarted
;; by login.
#f)))
(const #f)
(lambda (key . args)
(installer-log-line "crashing due to uncaught exception: ~s ~s"
key args)
(let ((error-file "/tmp/last-installer-error")
(dump-archive "/tmp/dump.tgz"))
(call-with-output-file error-file
(lambda (port)
(display-backtrace (make-stack #t) port)
(print-exception port
(stack-ref (make-stack #t) 1)
key args)))
(make-dump dump-archive
#:result %current-result
#:backtrace error-file)
(let ((report
((installer-dump-page current-installer)
dump-archive)))
((installer-exit-error current-installer)
error-file report key args)))
(primitive-exit 1))))
((installer-exit current-installer))))))
(program-file (program-file
"installer" "installer"