installer: Add installer-specific run command process.
* gnu/installer/record.scm (installer)[run-command]: Add field. * gnu/installer/utils.scm (run-command-in-installer): Add parameter. * gnu/installer.scm (installer-program): Parameterize run-command-in-installer with current installer's run-command. * gnu/installer/newt.scm (newt-run-command): New variable. (newt-installer): Use it. Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>master
Josselin Poiret
Mathieu Othacehe
parent
0b9fbbb4dd
commit
408427a36c
|
|
@ -416,44 +416,47 @@ selected keymap."
|
|||
(define steps (#$steps current-installer))
|
||||
((installer-init current-installer))
|
||||
|
||||
(catch #t
|
||||
(lambda ()
|
||||
(define results
|
||||
(run-installer-steps
|
||||
#:rewind-strategy 'menu
|
||||
#:menu-proc (installer-menu-page current-installer)
|
||||
#:steps steps))
|
||||
(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)))
|
||||
(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))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -79,6 +79,13 @@ problem. The backtrace is displayed below~a. Please report it by email to \
|
|||
(newt-finish)
|
||||
(clear-screen))
|
||||
|
||||
(define (newt-run-command . args)
|
||||
(newt-suspend)
|
||||
(clear-screen)
|
||||
(define result (run-command args))
|
||||
(newt-resume)
|
||||
result)
|
||||
|
||||
(define (final-page result prev-steps)
|
||||
(run-final-page result prev-steps))
|
||||
|
||||
|
|
@ -150,4 +157,5 @@ problem. The backtrace is displayed below~a. Please report it by email to \
|
|||
(welcome-page welcome-page)
|
||||
(parameters-menu parameters-menu)
|
||||
(parameters-page parameters-page)
|
||||
(dump-page dump-page)))
|
||||
(dump-page dump-page)
|
||||
(run-command newt-run-command)))
|
||||
|
|
|
|||
|
|
@ -42,7 +42,8 @@
|
|||
installer-welcome-page
|
||||
installer-parameters-menu
|
||||
installer-parameters-page
|
||||
installer-dump-page))
|
||||
installer-dump-page
|
||||
installer-run-command))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
@ -94,4 +95,6 @@
|
|||
;; procedure (keyboard-layout-selection) -> void
|
||||
(parameters-page installer-parameters-page)
|
||||
;; procedure (dump) -> void
|
||||
(dump-page installer-dump-page))
|
||||
(dump-page installer-dump-page)
|
||||
;; procedure command -> bool
|
||||
(run-command installer-run-command))
|
||||
|
|
|
|||
|
|
@ -25,6 +25,7 @@
|
|||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-19)
|
||||
#:use-module (srfi srfi-34)
|
||||
#:use-module (srfi srfi-35)
|
||||
#:use-module (ice-9 control)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 popen)
|
||||
|
|
@ -39,6 +40,7 @@
|
|||
run-external-command-with-handler
|
||||
run-external-command-with-line-hooks
|
||||
run-command
|
||||
run-command-in-installer
|
||||
|
||||
syslog-port
|
||||
%syslog-line-hook
|
||||
|
|
@ -168,6 +170,14 @@ successfully, #f otherwise."
|
|||
(pause)
|
||||
succeeded?)
|
||||
|
||||
(define run-command-in-installer
|
||||
(make-parameter
|
||||
(lambda (. args)
|
||||
(raise
|
||||
(condition
|
||||
(&serious)
|
||||
(&message (message "run-command-in-installer not set")))))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Logging.
|
||||
|
|
|
|||
Reference in New Issue