home: services: environment-variables: Double-quote values.

Fixes <https://issues.guix.gnu.org/54469>.
Reported by Maxime Devos <maximedevos@telenet.be>.

* gnu/home/services.scm (environment-variable-shell-definitions): New
procedure, with code formerly in 'serialize-posix-env-vars'.
(environment-variables->setup-environment-script): Change
"setup-environment" from 'mixed-text-file' to 'computed-file', and use
'environment-variable-shell-definitions'.
* tests/guix-home.sh: Test it.
* gnu/home/services/shells.scm (serialize-posix-env-vars): Delegate to
'environment-variable-shell-definitions'.
This commit is contained in:
Ludovic Courtès 2022-07-14 00:54:40 +02:00
parent 8af749224f
commit af4c103595
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 44 additions and 37 deletions

@ -46,6 +46,7 @@
home-run-on-change-service-type home-run-on-change-service-type
home-provenance-service-type home-provenance-service-type
environment-variable-shell-definitions
home-files-directory home-files-directory
xdg-configuration-files-directory xdg-configuration-files-directory
xdg-data-files-directory xdg-data-files-directory
@ -169,6 +170,34 @@ packages, configuration files, activation script, and so on.")))
configuration files that the user has declared in their configuration files that the user has declared in their
@code{home-environment} record."))) @code{home-environment} record.")))
(define (environment-variable-shell-definitions variables)
"Return a gexp that evaluates to a list of POSIX shell statements defining
VARIABLES, a list of environment variable name/value pairs. The returned code
ensures variable values are properly quoted."
#~(let ((shell-quote
(lambda (value)
;; Double-quote VALUE, leaving dollar sign as is.
(let ((quoted (list->string
(string-fold-right
(lambda (chr lst)
(case chr
((#\" #\\)
(append (list chr #\\) lst))
(else (cons chr lst))))
'()
value))))
(string-append "\"" quoted "\"")))))
(string-append
#$@(map (match-lambda
((key . #f)
"")
((key . #t)
#~(string-append "export " #$key "\n"))
((key . value)
#~(string-append "export " #$key "="
(shell-quote #$value) "\n")))
variables))))
(define (environment-variables->setup-environment-script vars) (define (environment-variables->setup-environment-script vars)
"Return a file that can be sourced by a POSIX compliant shell which "Return a file that can be sourced by a POSIX compliant shell which
initializes the environment. The file will source the home initializes the environment. The file will source the home
@ -199,8 +228,11 @@ exported."
`(("setup-environment" `(("setup-environment"
;; TODO: It's necessary to source ~/.guix-profile too ;; TODO: It's necessary to source ~/.guix-profile too
;; on foreign distros ;; on foreign distros
,(apply mixed-text-file "setup-environment" ,(computed-file "setup-environment"
"\ #~(call-with-output-file #$output
(lambda (port)
(set-port-encoding! port "UTF-8")
(display "\
HOME_ENVIRONMENT=$HOME/.guix-home HOME_ENVIRONMENT=$HOME/.guix-home
GUIX_PROFILE=\"$HOME_ENVIRONMENT/profile\" GUIX_PROFILE=\"$HOME_ENVIRONMENT/profile\"
PROFILE_FILE=\"$HOME_ENVIRONMENT/profile/etc/profile\" PROFILE_FILE=\"$HOME_ENVIRONMENT/profile/etc/profile\"
@ -227,17 +259,10 @@ case $XCURSOR_PATH in
*) export XCURSOR_PATH=$HOME_ENVIRONMENT/profile/share/icons:$XCURSOR_PATH ;; *) export XCURSOR_PATH=$HOME_ENVIRONMENT/profile/share/icons:$XCURSOR_PATH ;;
esac esac
" " port)
(display
(append-map #$(environment-variable-shell-definitions vars)
(match-lambda port)))))))))
((key . #f)
'())
((key . #t)
(list "export " key "\n"))
((key . value)
(list "export " key "=" value "\n")))
vars)))))))
(define home-environment-variables-service-type (define home-environment-variables-service-type
(service-type (name 'home-environment-variables) (service-type (name 'home-environment-variables)

@ -111,30 +111,7 @@ service type can be extended with a list of file-like objects.")))
(define (serialize-boolean field-name val) "") (define (serialize-boolean field-name val) "")
(define (serialize-posix-env-vars field-name val) (define (serialize-posix-env-vars field-name val)
#~(let ((shell-quote (environment-variable-shell-definitions val))
(lambda (value)
;; Double-quote VALUE, leaving dollar sign as is.
(let ((quoted (list->string
(string-fold-right
(lambda (chr lst)
(case chr
((#\" #\\)
(append (list chr #\\) lst))
(else (cons chr lst))))
'()
value))))
(string-append "\"" quoted "\"")))))
(string-append
#$@(map
(match-lambda
((key . #f)
"")
((key . #t)
#~(string-append "export " #$key "\n"))
((key . value)
#~(string-append "export " #$key "="
(shell-quote #$value) "\n")))
val))))
;;; ;;;

@ -79,6 +79,10 @@ trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
(guix-defaults? #t) (guix-defaults? #t)
(bashrc (list (local-file "dot-bashrc"))))) (bashrc (list (local-file "dot-bashrc")))))
(simple-service 'add-environment-variable
home-environment-variables-service-type
'(("TODAY" . "26 messidor")))
(simple-service 'home-bash-service-extension-test (simple-service 'home-bash-service-extension-test
home-bash-service-type home-bash-service-type
(home-bash-extension (home-bash-extension
@ -141,6 +145,7 @@ EOF
# the content of bashrc-test-config.sh" # the content of bashrc-test-config.sh"
grep -q "the content of ~/.config/test.conf" "${HOME}/.config/test.conf" grep -q "the content of ~/.config/test.conf" "${HOME}/.config/test.conf"
grep '^export PS1="\$GUIX_ENVIRONMENT λ "$' "${HOME}/.bash_profile" grep '^export PS1="\$GUIX_ENVIRONMENT λ "$' "${HOME}/.bash_profile"
( . "${HOME}/.guix-home/setup-environment"; test "$TODAY" = "26 messidor" )
# This one should still be here. # This one should still be here.
grep "stay around" "$HOME/.config/random-file" grep "stay around" "$HOME/.config/random-file"