diff options
| author | Mathieu Othacehe <othacehe@gnu.org> | 2022-10-14 17:28:27 +0200 |
|---|---|---|
| committer | Mathieu Othacehe <othacehe@gnu.org> | 2022-10-20 10:50:50 +0200 |
| commit | 96bb00d20336f43fac2c42662e4b1d300e624738 (patch) | |
| tree | eb2af74ea2671aac1825fa94b88a875fdfcd26ac /gnu | |
| parent | 4716cea6256523a8ecf90a426d675bfb7620f3e4 (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.scm | 2 | ||||
| -rw-r--r-- | gnu/installer/utils.scm | 50 |
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 | ||
| 131 | pseudoterminal with output handler HANDLER. HANDLER is a procedure taking an | ||
| 132 | input port, to which the command will write its standard output and error. | ||
| 133 | Returns 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 |
| 129 | output line with the procedures in LINE-HOOKS. Returns the integer status | 157 | output line with the procedures in LINE-HOOKS. If TTY is set to #true, the |
| 130 | value of the child process as returned by waitpid." | 158 | COMMAND will be run in a pseudoterminal. Returns the integer status value of |
| 159 | the 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 |
| 146 | successfully, #f otherwise." | 177 | successfully, #f otherwise. If TTY is set to #true, the COMMAND will be run |
| 178 | in 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)) |
