mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
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:
parent
2c757e8fb4
commit
73684dc90e
3 changed files with 50 additions and 16 deletions
|
@ -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)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue