ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

installer: Add installer-specific run command process.

Browse source 
* 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>
This commit is contained in:
Josselin Poiret 2022-01-15 14:50:01 +01:00 committed by Mathieu Othacehe
parent 0b9fbbb4dd
commit 408427a36c
No known key found for this signature in database
GPG key ID: 8354763531769CA6
4 changed files with 64 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

77
gnu/installer.scm
View file

@ -416,44 +416,47 @@ (define current-installer newt-installer)
(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))))))

10
gnu/installer/newt.scm
View file

@ -79,6 +79,13 @@ (define (exit-error file report key args)
(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 @@ (define newt-installer
(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)))

7
gnu/installer/record.scm
View file

@ -42,7 +42,8 @@ (define-module (gnu installer record)
installer-welcome-page
installer-parameters-menu
installer-parameters-page
installer-dump-page))
installer-dump-page
installer-run-command))
;;;
@ -94,4 +95,6 @@ (define-record-type* <installer>
;; 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))

10
gnu/installer/utils.scm
View file

@ -25,6 +25,7 @@ (define-module (gnu installer utils)
#: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 @@ (define-module (gnu installer utils)
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 @@ (define succeeded?
(pause)
succeeded?)
(define run-command-in-installer
(make-parameter
(lambda (. args)
(raise
(condition
(&serious)
(&message (message "run-command-in-installer not set")))))))
;;;
;;; Logging.