mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
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:
parent
112ef30b84
commit
ad55ccf9b1
7 changed files with 187 additions and 112 deletions
|
@ -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))))))
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue