installer: Run commands without hopping through the shell.

* gnu/installer/utils.scm (run-shell-command): Rename to...
(run-command): Remove call to 'call-with-temporary-output-file' and hop
through Bash.  Expect COMMAND to be a list of strings rather than a
string.
* gnu/installer/final.scm (install-system): Turn INSTALL-COMMAND into a
list of strings and pass it to 'run-command'.
* gnu/installer/newt/page.scm (edit-file): Likewise.
This commit is contained in:
Ludovic Courtès 2020-02-19 22:47:56 +01:00
parent f901f5d2bc
commit 8a4b11c6a9
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 39 additions and 41 deletions

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -111,10 +111,9 @@ cow-store service."
Start COW-STORE service on target directory and launch guix install command in Start COW-STORE service on target directory and launch guix install command in
a subshell. LOCALE must be the locale name under which that command will run, a subshell. LOCALE must be the locale name under which that command will run,
or #f. Return #t on success and #f on failure." or #f. Return #t on success and #f on failure."
(let ((install-command (let ((install-command (list "guix" "system" "init" "--fallback"
(format #f "guix system init --fallback ~a ~a" (%installer-configuration-file)
(%installer-configuration-file) (%installer-target-dir))))
(%installer-target-dir))))
(mkdir-p (%installer-target-dir)) (mkdir-p (%installer-target-dir))
;; We want to initialize user passwords but we don't want to store them in ;; We want to initialize user passwords but we don't want to store them in
@ -128,7 +127,7 @@ or #f. Return #t on success and #f on failure."
(lambda () (lambda ()
(start-service 'cow-store (list (%installer-target-dir)))) (start-service 'cow-store (list (%installer-target-dir))))
(lambda () (lambda ()
(run-shell-command install-command #:locale locale)) (run-command install-command #:locale locale))
(lambda () (lambda ()
(stop-service 'cow-store) (stop-service 'cow-store)
;; Remove the store overlay created at cow-store service start. ;; Remove the store overlay created at cow-store service start.

@ -719,9 +719,8 @@ ITEMS when 'Ok' is pressed."
(newt-suspend) (newt-suspend)
;; Use Nano because it syntax-highlights Scheme by default. ;; Use Nano because it syntax-highlights Scheme by default.
;; TODO: Add a menu to choose an editor? ;; TODO: Add a menu to choose an editor?
(run-shell-command (string-append "/run/current-system/profile/bin/nano " (run-command (list "/run/current-system/profile/bin/nano" file)
file) #:locale locale)
#:locale locale)
(newt-resume)) (newt-resume))
(define* (run-file-textbox-page #:key (define* (run-file-textbox-page #:key

@ -32,7 +32,7 @@
read-all read-all
nearest-exact-integer nearest-exact-integer
read-percentage read-percentage
run-shell-command run-command
syslog-port syslog-port
syslog syslog
@ -68,48 +68,48 @@ number. If no percentage is found, return #f"
(and result (and result
(string->number (match:substring result 1))))) (string->number (match:substring result 1)))))
(define* (run-shell-command command #:key locale) (define* (run-command command #:key locale)
"Run COMMAND, a string, with Bash, and in the given LOCALE. Return true if "Run COMMAND, a list of strings, in the given LOCALE. Return true if
COMMAND exited successfully, #f otherwise." COMMAND exited successfully, #f otherwise."
(define env (environ))
(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))
(environ env) ;restore environment variables
(match (select (cons (current-input-port) (current-clients)) (match (select (cons (current-input-port) (current-clients))
'() '()) '() '())
(((port _ ...) _ _) (((port _ ...) _ _)
(read-line port)))) (read-line port))))
(call-with-temporary-output-file (setenv "PATH" "/run/current-system/profile/bin")
(lambda (file port)
(when locale
(let ((supported? (false-if-exception
(setlocale LC_ALL locale))))
;; If LOCALE is not supported, then set LANGUAGE, which might at
;; least give us translated messages.
(if supported?
(format port "export LC_ALL=\"~a\"~%" locale)
(format port "export LANGUAGE=\"~a\"~%"
(string-take locale
(string-index locale #\_))))))
(format port "exec ~a~%" command) (when locale
(close port) (let ((supported? (false-if-exception
(setlocale LC_ALL locale))))
;; If LOCALE is not supported, then set LANGUAGE, which might at
;; least give us translated messages.
(if supported?
(setenv "LC_ALL" locale)
(setenv "LANGUAGE"
(string-take locale
(string-index locale #\_))))))
(guard (c ((invoke-error? c) (guard (c ((invoke-error? c)
(newline) (newline)
(format (current-error-port) (format (current-error-port)
(G_ "Command failed with exit code ~a.~%") (G_ "Command failed with exit code ~a.~%")
(invoke-error-exit-status c)) (invoke-error-exit-status c))
(syslog "command ~s failed with exit code ~a" (syslog "command ~s failed with exit code ~a"
command (invoke-error-exit-status c)) command (invoke-error-exit-status c))
(pause) (pause)
#f)) #f))
(syslog "running command ~s~%" command) (syslog "running command ~s~%" command)
(invoke "bash" "--init-file" file) (apply invoke command)
(syslog "command ~s succeeded~%" command) (syslog "command ~s succeeded~%" command)
(newline) (newline)
(pause) (pause)
#t)))) #t))
;;; ;;;