From ad55ccf9b18000144a4e0f28a0f9e57132f94edc Mon Sep 17 00:00:00 2001 From: Josselin Poiret Date: Sat, 15 Jan 2022 14:50:11 +0100 Subject: installer: Make dump archive creation optional and selective. * gnu/installer.scm (installer-program): Let the installer customize the dump archive. * gnu/installer/dump.scm (prepare-dump, make-dump): Split make-dump in prepare-dump, which copies the files necessary for the dump, and make-dump which creates the archive. * gnu/installer/record.scm (installer): Add report-page field. Change documented return value of exit-error. * gnu/installer/newt.scm (exit-error): Change arguments to be a string containing the error. Let the user choose between exiting and initiating a dump. (report-page): Add new variable. * gnu/installer/newt/page.scm (run-dump-page): New variable. * gnu/installer/newt/dump.scm: Delete it. Signed-off-by: Mathieu Othacehe --- gnu/installer.scm | 43 +++++++++++++++++++++++-------------------- 1 file changed, 23 insertions(+), 20 deletions(-) (limited to 'gnu/installer.scm') diff --git a/gnu/installer.scm b/gnu/installer.scm index 1cfd9d1bc9..7b2914be98 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -386,7 +386,8 @@ selected keymap." (guix build utils) ((system repl debug) #:select (terminal-width)) - (ice-9 match)) + (ice-9 match) + (ice-9 textual-ports)) ;; Initialize gettext support so that installers can use ;; (guix i18n) module. @@ -416,6 +417,7 @@ selected keymap." (define current-installer newt-installer) (define steps (#$steps current-installer)) + (dynamic-wind (installer-init current-installer) (lambda () @@ -436,30 +438,31 @@ selected keymap." (sync) (stop-service 'root)) (_ - ;; The installation failed, exit so that it is restarted - ;; by login. + ;; 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))))) + (define dump-dir + (prepare-dump key args #:result %current-result)) + (define action + ((installer-exit-error current-installer) + (get-string-all + (open-input-file + (string-append dump-dir "/installer-backtrace"))))) + (match action + ('dump + (let* ((dump-files + ((installer-dump-page current-installer) + dump-dir)) + (dump-archive + (make-dump dump-dir dump-files))) + ((installer-report-page current-installer) + dump-archive))) + (_ #f)) + (exit 1))))) (installer-exit current-installer)))))) -- cgit v1.2.3