summaryrefslogtreecommitdiff
path: root/gnu
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
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')
-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 3f6dacc4903..044f79372b1 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."
211 211
212 (setenv "PATH" "/run/current-system/profile/bin/") 212 (setenv "PATH" "/run/current-system/profile/bin/")
213 213
214 (set! ret (run-command install-command))) 214 (set! ret (run-command install-command #:tty? #t)))
215 (lambda () 215 (lambda ()
216 ;; Restart guix-daemon so that it does no keep the MNT namespace 216 ;; Restart guix-daemon so that it does no keep the MNT namespace
217 ;; alive. 217 ;; alive.
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index 5fd2e2d4257..061493e6a79 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -20,6 +20,7 @@
20(define-module (gnu installer utils) 20(define-module (gnu installer utils)
21 #:use-module (gnu services herd) 21 #:use-module (gnu services herd)
22 #:use-module (guix utils) 22 #:use-module (guix utils)
23 #:use-module ((guix build syscalls) #:select (openpty login-tty))
23 #:use-module (guix build utils) 24 #:use-module (guix build utils)
24 #:use-module (guix i18n) 25 #:use-module (guix i18n)
25 #:use-module (srfi srfi-1) 26 #:use-module (srfi srfi-1)
@@ -45,6 +46,7 @@
45 nearest-exact-integer 46 nearest-exact-integer
46 read-percentage 47 read-percentage
47 run-external-command-with-handler 48 run-external-command-with-handler
49 run-external-command-with-handler/tty
48 run-external-command-with-line-hooks 50 run-external-command-with-line-hooks
49 run-command 51 run-command
50 run-command-in-installer 52 run-command-in-installer
@@ -124,10 +126,37 @@ the child process as returned by waitpid."
124 (close-port input) 126 (close-port input)
125 (close-pipe dummy-pipe))) 127 (close-pipe dummy-pipe)))
126 128
127(define (run-external-command-with-line-hooks line-hooks command) 129(define (run-external-command-with-handler/tty handler command)
130 "Run command specified by the list COMMAND in a child operating in a
131pseudoterminal with output handler HANDLER. HANDLER is a procedure taking an
132input port, to which the command will write its standard output and error.
133Returns the integer status value of the child process as returned by waitpid."
134 (define-values (controller inferior)
135 (openpty))
136
137 (match (primitive-fork)
138 (0
139 (catch #t
140 (lambda ()
141 (close-fdes controller)
142 (login-tty inferior)
143 (apply execlp (car command) command))
144 (lambda _
145 (primitive-exit 127))))
146 (pid
147 (close-fdes inferior)
148 (let* ((port (fdopen controller "r0"))
149 (result (false-if-exception
150 (handler port))))
151 (close-port port)
152 (cdr (waitpid pid))))))
153
154(define* (run-external-command-with-line-hooks line-hooks command
155 #:key (tty? #false))
128 "Run command specified by the list COMMAND in a child, processing each 156 "Run command specified by the list COMMAND in a child, processing each
129output line with the procedures in LINE-HOOKS. Returns the integer status 157output line with the procedures in LINE-HOOKS. If TTY is set to #true, the
130value of the child process as returned by waitpid." 158COMMAND will be run in a pseudoterminal. Returns the integer status value of
159the child process as returned by waitpid."
131 (define (handler input) 160 (define (handler input)
132 (and 161 (and
133 (and=> (get-line input) 162 (and=> (get-line input)
@@ -136,14 +165,17 @@ value of the child process as returned by waitpid."
136 #f 165 #f
137 (begin (for-each (lambda (f) (f line)) 166 (begin (for-each (lambda (f) (f line))
138 (append line-hooks 167 (append line-hooks
139 %default-installer-line-hooks)) 168 %default-installer-line-hooks))
140 #t)))) 169 #t))))
141 (handler input))) 170 (handler input)))
142 (run-external-command-with-handler handler command)) 171 (if tty?
172 (run-external-command-with-handler/tty handler command)
173 (run-external-command-with-handler handler command)))
143 174
144(define* (run-command command) 175(define* (run-command command #:key (tty? #f))
145 "Run COMMAND, a list of strings. Return true if COMMAND exited 176 "Run COMMAND, a list of strings. Return true if COMMAND exited
146successfully, #f otherwise." 177successfully, #f otherwise. If TTY is set to #true, the COMMAND will be run
178in a pseudoterminal."
147 (define (pause) 179 (define (pause)
148 (format #t (G_ "Press Enter to continue.~%")) 180 (format #t (G_ "Press Enter to continue.~%"))
149 (send-to-clients '(pause)) 181 (send-to-clients '(pause))
@@ -154,8 +186,8 @@ successfully, #f otherwise."
154 186
155 (installer-log-line "running command ~s" command) 187 (installer-log-line "running command ~s" command)
156 (define result (run-external-command-with-line-hooks 188 (define result (run-external-command-with-line-hooks
157 (list %display-line-hook) 189 (list %display-line-hook) command
158 command)) 190 #:tty? tty?))
159 (define exit-val (status:exit-val result)) 191 (define exit-val (status:exit-val result))
160 (define term-sig (status:term-sig result)) 192 (define term-sig (status:term-sig result))
161 (define stop-sig (status:stop-sig result)) 193 (define stop-sig (status:stop-sig result))