summaryrefslogtreecommitdiff
path: root/gnu/installer
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2022-10-14 17:28:27 +0200
committerMathieu Othacehe <othacehe@gnu.org>2022-10-20 10:50:50 +0200
commit96bb00d20336f43fac2c42662e4b1d300e624738 (patch)
treeeb2af74ea2671aac1825fa94b88a875fdfcd26ac /gnu/installer
parent4716cea6256523a8ecf90a426d675bfb7620f3e4 (diff)
installer: Run the "guix system init" command in a PTY.
Fixes: <https://issues.guix.gnu.org/55360> * gnu/installer/utils.scm (run-external-command-with-handler/tty): New procedure. (run-external-command-with-line-hooks, run-command): Add a TTY? argument. * gnu/installer/final.scm (install-system): Call run-command with TTY? argument set to #true.
Diffstat (limited to 'gnu/installer')
-rw-r--r--gnu/installer/final.scm2
-rw-r--r--gnu/installer/utils.scm50
2 files changed, 42 insertions, 10 deletions
diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm
index 3f6dacc490..044f79372b 100644
--- a/gnu/installer/final.scm
+++ b/gnu/installer/final.scm
@@ -211,7 +211,7 @@ or #f. Return #t on success and #f on failure."
(setenv "PATH" "/run/current-system/profile/bin/")
- (set! ret (run-command install-command)))
+ (set! ret (run-command install-command #:tty? #t)))
(lambda ()
;; Restart guix-daemon so that it does no keep the MNT namespace
;; alive.
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index 5fd2e2d425..061493e6a7 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -20,6 +20,7 @@
(define-module (gnu installer utils)
#:use-module (gnu services herd)
#:use-module (guix utils)
+ #:use-module ((guix build syscalls) #:select (openpty login-tty))
#:use-module (guix build utils)
#:use-module (guix i18n)
#:use-module (srfi srfi-1)
@@ -45,6 +46,7 @@
nearest-exact-integer
read-percentage
run-external-command-with-handler
+ run-external-command-with-handler/tty
run-external-command-with-line-hooks
run-command
run-command-in-installer
@@ -124,10 +126,37 @@ the child process as returned by waitpid."
(close-port input)
(close-pipe dummy-pipe)))
-(define (run-external-command-with-line-hooks line-hooks command)
+(define (run-external-command-with-handler/tty handler command)
+ "Run command specified by the list COMMAND in a child operating in a
+pseudoterminal with output handler HANDLER. HANDLER is a procedure taking an
+input port, to which the command will write its standard output and error.
+Returns the integer status value of the child process as returned by waitpid."
+ (define-values (controller inferior)
+ (openpty))
+
+ (match (primitive-fork)
+ (0
+ (catch #t
+ (lambda ()
+ (close-fdes controller)
+ (login-tty inferior)
+ (apply execlp (car command) command))
+ (lambda _
+ (primitive-exit 127))))
+ (pid
+ (close-fdes inferior)
+ (let* ((port (fdopen controller "r0"))
+ (result (false-if-exception
+ (handler port))))
+ (close-port port)
+ (cdr (waitpid pid))))))
+
+(define* (run-external-command-with-line-hooks line-hooks command
+ #:key (tty? #false))
"Run command specified by the list COMMAND in a child, processing each
-output line with the procedures in LINE-HOOKS. Returns the integer status
-value of the child process as returned by waitpid."
+output line with the procedures in LINE-HOOKS. If TTY is set to #true, the
+COMMAND will be run in a pseudoterminal. Returns the integer status value of
+the child process as returned by waitpid."
(define (handler input)
(and
(and=> (get-line input)
@@ -136,14 +165,17 @@ value of the child process as returned by waitpid."
#f
(begin (for-each (lambda (f) (f line))
(append line-hooks
- %default-installer-line-hooks))
+ %default-installer-line-hooks))
#t))))
(handler input)))
- (run-external-command-with-handler handler command))
+ (if tty?
+ (run-external-command-with-handler/tty handler command)
+ (run-external-command-with-handler handler command)))
-(define* (run-command command)
+(define* (run-command command #:key (tty? #f))
"Run COMMAND, a list of strings. Return true if COMMAND exited
-successfully, #f otherwise."
+successfully, #f otherwise. If TTY is set to #true, the COMMAND will be run
+in a pseudoterminal."
(define (pause)
(format #t (G_ "Press Enter to continue.~%"))
(send-to-clients '(pause))
@@ -154,8 +186,8 @@ successfully, #f otherwise."
(installer-log-line "running command ~s" command)
(define result (run-external-command-with-line-hooks
- (list %display-line-hook)
- command))
+ (list %display-line-hook) command
+ #:tty? tty?))
(define exit-val (status:exit-val result))
(define term-sig (status:term-sig result))
(define stop-sig (status:stop-sig result))