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'.master
Ludovic Courtès
parent
8af749224f
commit
af4c103595
|
|
@ -46,6 +46,7 @@
|
|||
home-run-on-change-service-type
|
||||
home-provenance-service-type
|
||||
|
||||
environment-variable-shell-definitions
|
||||
home-files-directory
|
||||
xdg-configuration-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
|
||||
@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)
|
||||
"Return a file that can be sourced by a POSIX compliant shell which
|
||||
initializes the environment. The file will source the home
|
||||
|
|
@ -199,8 +228,11 @@ exported."
|
|||
`(("setup-environment"
|
||||
;; TODO: It's necessary to source ~/.guix-profile too
|
||||
;; 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
|
||||
GUIX_PROFILE=\"$HOME_ENVIRONMENT/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 ;;
|
||||
esac
|
||||
|
||||
"
|
||||
|
||||
(append-map
|
||||
(match-lambda
|
||||
((key . #f)
|
||||
'())
|
||||
((key . #t)
|
||||
(list "export " key "\n"))
|
||||
((key . value)
|
||||
(list "export " key "=" value "\n")))
|
||||
vars)))))))
|
||||
" port)
|
||||
(display
|
||||
#$(environment-variable-shell-definitions vars)
|
||||
port)))))))))
|
||||
|
||||
(define home-environment-variables-service-type
|
||||
(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-posix-env-vars field-name val)
|
||||
#~(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")))
|
||||
val))))
|
||||
(environment-variable-shell-definitions val))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
|
|||
|
|
@ -79,6 +79,10 @@ trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
|
|||
(guix-defaults? #t)
|
||||
(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
|
||||
home-bash-service-type
|
||||
(home-bash-extension
|
||||
|
|
@ -141,6 +145,7 @@ EOF
|
|||
# the content of bashrc-test-config.sh"
|
||||
grep -q "the content of ~/.config/test.conf" "${HOME}/.config/test.conf"
|
||||
grep '^export PS1="\$GUIX_ENVIRONMENT λ "$' "${HOME}/.bash_profile"
|
||||
( . "${HOME}/.guix-home/setup-environment"; test "$TODAY" = "26 messidor" )
|
||||
|
||||
# This one should still be here.
|
||||
grep "stay around" "$HOME/.config/random-file"
|
||||
|
|
|
|||
Reference in New Issue