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 <othacehe@gnu.org>
This commit is contained in:
Josselin Poiret 2022-01-15 14:50:11 +01:00 committed by Mathieu Othacehe
parent 112ef30b84
commit ad55ccf9b1
No known key found for this signature in database
GPG key ID: 8354763531769CA6
7 changed files with 187 additions and 112 deletions

View file

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