03/17: home: services: bash: Properly quote shell aliases.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 7d9fdfb19d17dc99a4cf2548942c4f8ae7433572
Author: Ludovic Courtès <ludovic.courtes@inria.fr>
AuthorDate: Thu Jul 6 16:53:21 2023 +0200

    home: services: bash: Properly quote shell aliases.
    
    Fixes <https://issues.guix.gnu.org/63048>.
    Reported by Ekaitz Zarraga <ekaitz@elenq.tech>.
    
    * gnu/home/services.scm (with-shell-quotation-bindings): New procedure.
    (environment-variable-shell-definitions): Use it instead of inline copy.
    * gnu/home/services/shells.scm (bash-serialize-aliases): Use it.  Add
    clause for 'literal-string?'.
    * tests/guix-home.sh: Add 'aliases' to 'home-bash-extension' and test it.
---
 gnu/home/services.scm        | 53 +++++++++++++++++++++++++-------------------
 gnu/home/services/shells.scm | 28 ++++++++++++++---------
 tests/guix-home.sh           |  7 +++++-
 3 files changed, 54 insertions(+), 34 deletions(-)

diff --git a/gnu/home/services.scm b/gnu/home/services.scm
index b17a34d19d..042eba4780 100644
--- a/gnu/home/services.scm
+++ b/gnu/home/services.scm
@@ -53,6 +53,7 @@
             literal-string?
             literal-string-value
 
+            with-shell-quotation-bindings
             environment-variable-shell-definitions
             home-files-directory
             xdg-configuration-files-directory
@@ -183,11 +184,10 @@ configuration files that the user has declared in their
   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* ((quote-string
+(define (with-shell-quotation-bindings exp)
+  "Insert EXP, a gexp, in a lexical environment providing the
+'shell-single-quote' and 'shell-double-quote' bindings."
+#~(let* ((quote-string
             (lambda (value quoted-chars)
               (list->string (string-fold-right
                              (lambda (chr lst)
@@ -206,24 +206,31 @@ ensures variable values are properly quoted."
               ;; 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 . (or (? string? value)
-                             (? file-like? value)
-                             (? gexp? value)))
-                  #~(string-append "export " #$key "="
-                                   (shell-double-quote #$value)
-                                   "\n"))
-                 ((key . (? literal-string? value))
-                  #~(string-append "export " #$key "="
-                                   (shell-single-quote
-                                    #$(literal-string-value value))
-                                   "\n")))
-               variables))))
+      #$exp))
+
+(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."
+  (with-shell-quotation-bindings
+   #~(string-append
+      #$@(map (match-lambda
+                ((key . #f)
+                 "")
+                ((key . #t)
+                 #~(string-append "export " #$key "\n"))
+                ((key . (or (? string? value)
+                            (? file-like? value)
+                            (? gexp? value)))
+                 #~(string-append "export " #$key "="
+                                  (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)
   "Return a file that can be sourced by a POSIX compliant shell which
diff --git a/gnu/home/services/shells.scm b/gnu/home/services/shells.scm
index 415b5470c5..7960590e7c 100644
--- a/gnu/home/services/shells.scm
+++ b/gnu/home/services/shells.scm
@@ -313,16 +313,24 @@ source ~/.profile
 ;;;
 
 (define (bash-serialize-aliases field-name val)
-  #~(string-append
-     #$@(map
-         (match-lambda
-           ((key . #f)
-            "")
-           ((key . #t)
-            #~(string-append "alias " #$key "\n"))
-           ((key . value)
-            #~(string-append "alias " #$key "=\"" #$value "\"\n")))
-         val)))
+  (with-shell-quotation-bindings
+   #~(string-append
+      #$@(map
+          (match-lambda
+            ((key . #f)
+             "")
+            ((key . #t)
+             #~(string-append "alias " #$key "\n"))
+            ((key . (? literal-string? value))
+             #~(string-append "alias " #$key "="
+                              (shell-single-quote
+                               #$(literal-string-value value))
+                              "\n"))
+            ((key . value)
+             #~(string-append "alias " #$key "="
+                              (shell-double-quote #$value)
+                              "\n")))
+          val))))
 
 (define-configuration home-bash-configuration
   (package
diff --git a/tests/guix-home.sh b/tests/guix-home.sh
index e9ef76c862..e6d16d7fab 100644
--- a/tests/guix-home.sh
+++ b/tests/guix-home.sh
@@ -1,7 +1,7 @@
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2021-2023 Andrew Tropin <andrew@trop.in>
 # Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
-# Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2022, 2023 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -94,6 +94,9 @@ trap 'chmod -Rf +w "$test_directory"; rm -rf 
"$test_directory"' EXIT
                    (home-bash-extension
                     (environment-variables
                       '(("PS1" . "$GUIX_ENVIRONMENT λ ")))
+                    (aliases
+                      `(("run" . "guix shell")
+                        ("path" . ,(literal-string "echo $PATH"))))
                     (bashrc
                      (list
                       (plain-file
@@ -149,6 +152,8 @@ EOF
     test -d "${HOME}/.guix-home"
     test -h "${HOME}/.bash_profile"
     test -h "${HOME}/.bashrc"
+    grep 'alias run="guix shell"' "$HOME/.bashrc"
+    grep "alias path='echo \$PATH'" "$HOME/.bashrc"
     test "$(tail -n 2 "${HOME}/.bashrc")" == "\
 # dot-bashrc test file for guix home
 # the content of bashrc-test-config.sh"