summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
Diffstat (limited to 'gnu')
-rw-r--r--gnu/home/services.scm48
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)