mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-02-07 19:39:34 +01: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 @@ selected keymap."
(define steps (#$steps current-installer)) (define steps (#$steps current-installer))
((installer-init current-installer)) ((installer-init current-installer))
(catch #t (parameterize
(lambda () ((run-command-in-installer
(define results (installer-run-command current-installer)))
(run-installer-steps (catch #t
#:rewind-strategy 'menu (lambda ()
#:menu-proc (installer-menu-page current-installer) (define results
#:steps steps)) (run-installer-steps
#:rewind-strategy 'menu
#:menu-proc (installer-menu-page current-installer)
#:steps steps))
(match (result-step results 'final) (match (result-step results 'final)
('success ('success
;; We did it! Let's reboot! ;; We did it! Let's reboot!
(sync) (sync)
(stop-service 'root)) (stop-service 'root))
(_ (_
;; The installation failed, exit so that it is restarted ;; The installation failed, exit so that it is restarted
;; by login. ;; by login.
#f))) #f)))
(const #f) (const #f)
(lambda (key . args) (lambda (key . args)
(installer-log-line "crashing due to uncaught exception: ~s ~s" (installer-log-line "crashing due to uncaught exception: ~s ~s"
key args) key args)
(let ((error-file "/tmp/last-installer-error") (let ((error-file "/tmp/last-installer-error")
(dump-archive "/tmp/dump.tgz")) (dump-archive "/tmp/dump.tgz"))
(call-with-output-file error-file (call-with-output-file error-file
(lambda (port) (lambda (port)
(display-backtrace (make-stack #t) port) (display-backtrace (make-stack #t) port)
(print-exception port (print-exception port
(stack-ref (make-stack #t) 1) (stack-ref (make-stack #t) 1)
key args))) key args)))
(make-dump dump-archive (make-dump dump-archive
#:result %current-result #:result %current-result
#:backtrace error-file) #:backtrace error-file)
(let ((report (let ((report
((installer-dump-page current-installer) ((installer-dump-page current-installer)
dump-archive))) dump-archive)))
((installer-exit-error current-installer) ((installer-exit-error current-installer)
error-file report key args))) error-file report key args)))
(primitive-exit 1))) (primitive-exit 1))))
((installer-exit current-installer)))))) ((installer-exit current-installer))))))

10
gnu/installer/newt.scm
View file

@ -79,6 +79,13 @@ problem. The backtrace is displayed below~a. Please report it by email to \
(newt-finish) (newt-finish)
(clear-screen)) (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) (define (final-page result prev-steps)
(run-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) (welcome-page welcome-page)
(parameters-menu parameters-menu) (parameters-menu parameters-menu)
(parameters-page parameters-page) (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 @@
installer-welcome-page installer-welcome-page
installer-parameters-menu installer-parameters-menu
installer-parameters-page installer-parameters-page
installer-dump-page)) installer-dump-page
installer-run-command))
;;; ;;;
@ -94,4 +95,6 @@
;; procedure (keyboard-layout-selection) -> void ;; procedure (keyboard-layout-selection) -> void
(parameters-page installer-parameters-page) (parameters-page installer-parameters-page)
;; procedure (dump) -> void ;; 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 @@
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-19) #:use-module (srfi srfi-19)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 control) #:use-module (ice-9 control)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 popen) #:use-module (ice-9 popen)
@ -39,6 +40,7 @@
run-external-command-with-handler run-external-command-with-handler
run-external-command-with-line-hooks run-external-command-with-line-hooks
run-command run-command
run-command-in-installer
syslog-port syslog-port
%syslog-line-hook %syslog-line-hook
@ -168,6 +170,14 @@ successfully, #f otherwise."
(pause) (pause)
succeeded?) succeeded?)
(define run-command-in-installer
(make-parameter
(lambda (. args)
(raise
(condition
(&serious)
(&message (message "run-command-in-installer not set")))))))
;;; ;;;
;;; Logging. ;;; Logging.