diff options
Diffstat (limited to 'gnu/home')
| -rw-r--r-- | gnu/home/services.scm | 48 |
1 files changed, 36 insertions, 12 deletions
diff --git a/gnu/home/services.scm b/gnu/home/services.scm index e154f5c443..692354c644 100644 --- a/gnu/home/services.scm +++ b/gnu/home/services.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> +;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,6 +34,7 @@ #:use-module (guix i18n) #:use-module (guix modules) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) #:use-module (ice-9 match) #:use-module (ice-9 vlist) @@ -47,6 +49,10 @@ home-run-on-change-service-type home-provenance-service-type + literal-string + literal-string? + literal-string-value + environment-variable-shell-definitions home-files-directory xdg-configuration-files-directory @@ -171,32 +177,50 @@ packages, configuration files, activation script, and so on."))) configuration files that the user has declared in their @code{home-environment} record."))) +;; Representation of a literal string. +(define-record-type <literal-string> + (literal-string str) + literal-string? + (str literal-string-value)) + (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 + #~(let* ((quote-string + (lambda (value quoted-chars) + (list->string (string-fold-right (lambda (chr lst) - (case chr - ((#\" #\\) - (append (list chr #\\) lst)) - (else (cons chr lst)))) + (if (memq chr quoted-chars) + (append (list chr #\\) lst) + (cons chr lst))) '() value)))) - (string-append "\"" quoted "\""))))) + (shell-double-quote + (lambda (value) + ;; Double-quote VALUE, leaving dollar sign as is. + (string-append "\"" (quote-string value '(#\" #\\)) + "\""))) + (shell-single-quote + (lambda (value) + ;; Single-quote VALUE to enter a literal string. + (string-append "'" (quote-string value '(#\' #\\)) + "'")))) (string-append #$@(map (match-lambda ((key . #f) "") ((key . #t) #~(string-append "export " #$key "\n")) - ((key . value) + ((key . (? string? value)) + #~(string-append "export " #$key "=" + (shell-double-quote #$value) + "\n")) + ((key . (? literal-string? value)) #~(string-append "export " #$key "=" - (shell-quote #$value) "\n"))) + (shell-single-quote + #$(literal-string-value value)) + "\n"))) variables)))) (define (environment-variables->setup-environment-script vars) |