summary refs log tree commit diff
diff options
context:
space:
mode:
authorJosselin Poiret <dev@jpoiret.xyz>2022-01-15 14:50:09 +0100
committerMathieu Othacehe <othacehe@gnu.org>2022-01-17 08:48:21 +0100
commit16b2bd9d04f25d35b36b687ca8d488f59e8ca1c3 (patch)
tree6d6b962d3bc611b99bb4b7dfbc2e3baf189f25f5
parent98d23fd53ad9bb13ad1b15138b4bcdad36be9f60 (diff)
downloadguix-16b2bd9d04f25d35b36b687ca8d488f59e8ca1c3.tar.gz
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>
-rw-r--r--gnu/installer.scm91
1 files changed, 46 insertions, 45 deletions
diff --git a/gnu/installer.scm b/gnu/installer.scm
index c7e0921a19..1cfd9d1bc9 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -416,51 +416,52 @@ selected keymap."
 
             (define current-installer newt-installer)
             (define steps (#$steps current-installer))
-            ((installer-init current-installer))
-
-            (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))
-
-                  (match (result-step results 'final)
-                    ('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))))))
+            (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))
+
+                      (match (result-step results 'final)
+                        ('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
    "installer"