diff options
| author | Josselin Poiret <dev@jpoiret.xyz> | 2022-01-15 14:50:09 +0100 |
|---|---|---|
| committer | Mathieu Othacehe <othacehe@gnu.org> | 2022-02-02 16:46:44 +0100 |
| commit | 41eb0f01fcf05902be9972cc993fdb332edb928c (patch) | |
| tree | cd3b5ec6658691073759f28ebe3556521387bd70 /gnu/installer.scm | |
| parent | 7cbd95a9f662bf52a00dde2ea0123ed0dc640214 (diff) | |
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>
Diffstat (limited to 'gnu/installer.scm')
| -rw-r--r-- | gnu/installer.scm | 91 |
1 files changed, 46 insertions, 45 deletions
diff --git a/gnu/installer.scm b/gnu/installer.scm index c7e0921a198..1cfd9d1bc98 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm | |||
| @@ -416,51 +416,52 @@ selected keymap." | |||
| 416 | 416 | ||
| 417 | (define current-installer newt-installer) | 417 | (define current-installer newt-installer) |
| 418 | (define steps (#$steps current-installer)) | 418 | (define steps (#$steps current-installer)) |
| 419 | ((installer-init current-installer)) | 419 | (dynamic-wind |
| 420 | 420 | (installer-init current-installer) | |
| 421 | (parameterize | 421 | (lambda () |
| 422 | ((run-command-in-installer | 422 | (parameterize |
| 423 | (installer-run-command current-installer))) | 423 | ((run-command-in-installer |
| 424 | (catch #t | 424 | (installer-run-command current-installer))) |
| 425 | (lambda () | 425 | (catch #t |
| 426 | (define results | 426 | (lambda () |
| 427 | (run-installer-steps | 427 | (define results |
| 428 | #:rewind-strategy 'menu | 428 | (run-installer-steps |
| 429 | #:menu-proc (installer-menu-page current-installer) | 429 | #:rewind-strategy 'menu |
| 430 | #:steps steps)) | 430 | #:menu-proc (installer-menu-page current-installer) |
| 431 | 431 | #:steps steps)) | |
| 432 | (match (result-step results 'final) | 432 | |
| 433 | ('success | 433 | (match (result-step results 'final) |
| 434 | ;; We did it! Let's reboot! | 434 | ('success |
| 435 | (sync) | 435 | ;; We did it! Let's reboot! |
| 436 | (stop-service 'root)) | 436 | (sync) |
| 437 | (_ | 437 | (stop-service 'root)) |
| 438 | ;; The installation failed, exit so that it is restarted | 438 | (_ |
| 439 | ;; by login. | 439 | ;; The installation failed, exit so that it is restarted |
| 440 | #f))) | 440 | ;; by login. |
| 441 | (const #f) | 441 | #f))) |
| 442 | (lambda (key . args) | 442 | (const #f) |
| 443 | (installer-log-line "crashing due to uncaught exception: ~s ~s" | 443 | (lambda (key . args) |
| 444 | key args) | 444 | (installer-log-line "crashing due to uncaught exception: ~s ~s" |
| 445 | (let ((error-file "/tmp/last-installer-error") | 445 | key args) |
| 446 | (dump-archive "/tmp/dump.tgz")) | 446 | (let ((error-file "/tmp/last-installer-error") |
| 447 | (call-with-output-file error-file | 447 | (dump-archive "/tmp/dump.tgz")) |
| 448 | (lambda (port) | 448 | (call-with-output-file error-file |
| 449 | (display-backtrace (make-stack #t) port) | 449 | (lambda (port) |
| 450 | (print-exception port | 450 | (display-backtrace (make-stack #t) port) |
| 451 | (stack-ref (make-stack #t) 1) | 451 | (print-exception port |
| 452 | key args))) | 452 | (stack-ref (make-stack #t) 1) |
| 453 | (make-dump dump-archive | 453 | key args))) |
| 454 | #:result %current-result | 454 | (make-dump dump-archive |
| 455 | #:backtrace error-file) | 455 | #:result %current-result |
| 456 | (let ((report | 456 | #:backtrace error-file) |
| 457 | ((installer-dump-page current-installer) | 457 | (let ((report |
| 458 | dump-archive))) | 458 | ((installer-dump-page current-installer) |
| 459 | ((installer-exit-error current-installer) | 459 | dump-archive))) |
| 460 | error-file report key args))) | 460 | ((installer-exit-error current-installer) |
| 461 | (primitive-exit 1)))) | 461 | error-file report key args))) |
| 462 | 462 | (primitive-exit 1))))) | |
| 463 | ((installer-exit current-installer)))))) | 463 | |
| 464 | (installer-exit current-installer)))))) | ||
| 464 | 465 | ||
| 465 | (program-file | 466 | (program-file |
| 466 | "installer" | 467 | "installer" |
