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.
This commit is contained in:
		
							parent
							
								
									4716cea625
								
							
						
					
					
						commit
						96bb00d203
					
				
					 2 changed files with 42 additions and 10 deletions
				
			
		|  | @ -211,7 +211,7 @@ or #f.  Return #t on success and #f on failure." | ||||||
| 
 | 
 | ||||||
|              (setenv "PATH" "/run/current-system/profile/bin/") |              (setenv "PATH" "/run/current-system/profile/bin/") | ||||||
| 
 | 
 | ||||||
|              (set! ret (run-command install-command))) |              (set! ret (run-command install-command #:tty? #t))) | ||||||
|            (lambda () |            (lambda () | ||||||
|              ;; Restart guix-daemon so that it does no keep the MNT namespace |              ;; Restart guix-daemon so that it does no keep the MNT namespace | ||||||
|              ;; alive. |              ;; alive. | ||||||
|  |  | ||||||
|  | @ -20,6 +20,7 @@ | ||||||
| (define-module (gnu installer utils) | (define-module (gnu installer utils) | ||||||
|   #:use-module (gnu services herd) |   #:use-module (gnu services herd) | ||||||
|   #:use-module (guix utils) |   #:use-module (guix utils) | ||||||
|  |   #:use-module ((guix build syscalls) #:select (openpty login-tty)) | ||||||
|   #:use-module (guix build utils) |   #:use-module (guix build utils) | ||||||
|   #:use-module (guix i18n) |   #:use-module (guix i18n) | ||||||
|   #:use-module (srfi srfi-1) |   #:use-module (srfi srfi-1) | ||||||
|  | @ -45,6 +46,7 @@ | ||||||
|             nearest-exact-integer |             nearest-exact-integer | ||||||
|             read-percentage |             read-percentage | ||||||
|             run-external-command-with-handler |             run-external-command-with-handler | ||||||
|  |             run-external-command-with-handler/tty | ||||||
|             run-external-command-with-line-hooks |             run-external-command-with-line-hooks | ||||||
|             run-command |             run-command | ||||||
|             run-command-in-installer |             run-command-in-installer | ||||||
|  | @ -124,10 +126,37 @@ the child process as returned by waitpid." | ||||||
|     (close-port input) |     (close-port input) | ||||||
|     (close-pipe dummy-pipe))) |     (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 |   "Run command specified by the list COMMAND in a child, processing each | ||||||
| output line with the procedures in LINE-HOOKS.  Returns the integer status | output line with the procedures in LINE-HOOKS.  If TTY is set to #true, the | ||||||
| value of the child process as returned by waitpid." | COMMAND will be run in a pseudoterminal.  Returns the integer status value of | ||||||
|  | the child process as returned by waitpid." | ||||||
|   (define (handler input) |   (define (handler input) | ||||||
|     (and |     (and | ||||||
|      (and=> (get-line input) |      (and=> (get-line input) | ||||||
|  | @ -136,14 +165,17 @@ value of the child process as returned by waitpid." | ||||||
|                   #f |                   #f | ||||||
|                   (begin (for-each (lambda (f) (f line)) |                   (begin (for-each (lambda (f) (f line)) | ||||||
|                                    (append line-hooks |                                    (append line-hooks | ||||||
|                                        %default-installer-line-hooks)) |                                            %default-installer-line-hooks)) | ||||||
|                          #t)))) |                          #t)))) | ||||||
|      (handler input))) |      (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 |   "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) |   (define (pause) | ||||||
|     (format #t (G_ "Press Enter to continue.~%")) |     (format #t (G_ "Press Enter to continue.~%")) | ||||||
|     (send-to-clients '(pause)) |     (send-to-clients '(pause)) | ||||||
|  | @ -154,8 +186,8 @@ successfully, #f otherwise." | ||||||
| 
 | 
 | ||||||
|   (installer-log-line "running command ~s" command) |   (installer-log-line "running command ~s" command) | ||||||
|   (define result (run-external-command-with-line-hooks |   (define result (run-external-command-with-line-hooks | ||||||
|                   (list %display-line-hook) |                   (list %display-line-hook) command | ||||||
|                   command)) |                   #:tty? tty?)) | ||||||
|   (define exit-val (status:exit-val result)) |   (define exit-val (status:exit-val result)) | ||||||
|   (define term-sig (status:term-sig result)) |   (define term-sig (status:term-sig result)) | ||||||
|   (define stop-sig (status:stop-sig result)) |   (define stop-sig (status:stop-sig result)) | ||||||
|  |  | ||||||
		Reference in a new issue