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:
parent
8af749224f
commit
af4c103595
@ -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"
|
||||||
|
Loading…
Reference in New Issue
Block a user