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

View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; 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.
;;;
@ -111,10 +111,9 @@ (define* (install-system locale #:key (users '()))
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,
or #f. Return #t on success and #f on failure."
(let ((install-command
(format #f "guix system init --fallback ~a ~a"
(%installer-configuration-file)
(%installer-target-dir))))
(let ((install-command (list "guix" "system" "init" "--fallback"
(%installer-configuration-file)
(%installer-target-dir))))
(mkdir-p (%installer-target-dir))
;; We want to initialize user passwords but we don't want to store them in
@ -128,7 +127,7 @@ (define* (install-system locale #:key (users '()))
(lambda ()
(start-service 'cow-store (list (%installer-target-dir))))
(lambda ()
(run-shell-command install-command #:locale locale))
(run-command install-command #:locale locale))
(lambda ()
(stop-service 'cow-store)
;; Remove the store overlay created at cow-store service start.

View file

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

View file

@ -32,7 +32,7 @@ (define-module (gnu installer utils)
read-all
nearest-exact-integer
read-percentage
run-shell-command
run-command
syslog-port
syslog
@ -68,48 +68,48 @@ (define (read-percentage percentage)
(and result
(string->number (match:substring result 1)))))
(define* (run-shell-command command #:key locale)
"Run COMMAND, a string, with Bash, and in the given LOCALE. Return true if
(define* (run-command command #:key locale)
"Run COMMAND, a list of strings, in the given LOCALE. Return true if
COMMAND exited successfully, #f otherwise."
(define env (environ))
(define (pause)
(format #t (G_ "Press Enter to continue.~%"))
(send-to-clients '(pause))
(environ env) ;restore environment variables
(match (select (cons (current-input-port) (current-clients))
'() '())
(((port _ ...) _ _)
(read-line port))))
(call-with-temporary-output-file
(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 #\_))))))
(setenv "PATH" "/run/current-system/profile/bin")
(format port "exec ~a~%" command)
(close 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?
(setenv "LC_ALL" locale)
(setenv "LANGUAGE"
(string-take locale
(string-index locale #\_))))))
(guard (c ((invoke-error? c)
(newline)
(format (current-error-port)
(G_ "Command failed with exit code ~a.~%")
(invoke-error-exit-status c))
(syslog "command ~s failed with exit code ~a"
command (invoke-error-exit-status c))
(pause)
#f))
(syslog "running command ~s~%" command)
(invoke "bash" "--init-file" file)
(syslog "command ~s succeeded~%" command)
(newline)
(pause)
#t))))
(guard (c ((invoke-error? c)
(newline)
(format (current-error-port)
(G_ "Command failed with exit code ~a.~%")
(invoke-error-exit-status c))
(syslog "command ~s failed with exit code ~a"
command (invoke-error-exit-status c))
(pause)
#f))
(syslog "running command ~s~%" command)
(apply invoke command)
(syslog "command ~s succeeded~%" command)
(newline)
(pause)
#t))
;;;