home: services: environment-variables: Add support for literal strings.

* gnu/home/services.scm (<literal-string>): New record type.
(environment-variable-shell-definitions): Split 'shell-quote' into
'quote-string' and 'shell-double-quote'.  Add 'shell-single-quote'.
Add clause for 'literal-string' records.
* tests/guix-home.sh: Test it.
* doc/guix.texi (Essential Home Services): Document it.
This commit is contained in:
Ludovic Courtès 2022-12-26 19:11:27 +01:00
parent 2c757e8fb4
commit 73684dc90e
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 50 additions and 16 deletions

View file

@ -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-quote #$value) "\n")))
(shell-double-quote #$value)
"\n"))
((key . (? literal-string? value))
#~(string-append "export " #$key "="
(shell-single-quote
#$(literal-string-value value))
"\n")))
variables))))
(define (environment-variables->setup-environment-script vars)