bug#40039: 'wrap-script' introduces spurious argument

[Brendan Tildesley via Bug reports for GNU Guix <bug-guix@gnu.org>]

[-- Attachment #1.1: Type: text/plain, Size: 91 bytes --]

Same patch as before, but with a test case. Have a play with it and see if it makes sense.

[-- Attachment #1.2: Type: text/html, Size: 241 bytes --]

[-- Attachment #2: 0001-utils-Fix-wrap-script-argument-handling.patch --]
[-- Type: text/x-patch, Size: 5484 bytes --]

From 21d5f4e01be7f9b86649f4176f53e14854b58d53 Mon Sep 17 00:00:00 2001
From: Brendan Tildesley <mail@brendan.scot>
Date: Thu, 29 Apr 2021 20:33:08 +1000
Subject: [PATCH] utils: Fix wrap-script argument handling.

* guix/build/utils.scm (wrap-script):
Don't add (car cl) one too many times, cl its self contains it's car.
Split the aguments string with string-tokenize to avoid leaving an empty
string argument when there should be none. These two bugs seemed to
be partially cancelling each other out so that scripts still worked when
ran with no arguments.

* tests/build-utils.scm: Adjust wrap-script to above changes.
Add two tests to ensure the command line arguments appear identical to a
script and its wrapped version.
---
 guix/build/utils.scm  |  8 +++----
 tests/build-utils.scm | 55 +++++++++++++++++++++++++++++++++++++++----
 2 files changed, 54 insertions(+), 9 deletions(-)

diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 419c10195b..cc2a020fbf 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2015, 2018 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1295,10 +1296,9 @@ not supported."
                                    `(let ((cl (command-line)))
                                       (apply execl ,interpreter
                                              (car cl)
-                                             (cons (car cl)
-                                                   (append
-                                                    ',(string-split args #\space)
-                                                    cl))))))
+                                             (append
+                                              ',(string-tokenize args char-set:graphic)
+                                              cl)))))
                    (template (string-append prog ".XXXXXX"))
                    (out      (mkstemp! template))
                    (st       (stat prog))
diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index 654b480ed9..f3f31deaf6 100644
--- a/tests/build-utils.scm
+++ b/tests/build-utils.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2015, 2016, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -165,9 +166,7 @@ echo hello world"))
                                    "/some/path:/some/other/path"))))
              '(let ((cl (command-line)))
                 (apply execl "/anything/cabbage-bash-1.2.3/bin/sh"
-                       (car cl)
-                       (cons (car cl)
-                             (append '("") cl)))))
+                       (car cl) cl)))
      script-contents)
     (call-with-temporary-directory
      (lambda (directory)
@@ -206,8 +205,7 @@ print('hello world')"))
              `(let ((cl (command-line)))
                 (apply execl "/anything/cabbage-bash-1.2.3/bin/python3"
                        (car cl)
-                       (cons (car cl)
-                             (append '("" "-and" "-args") cl)))))
+                       (append '("-and" "-args") cl))))
      script-contents)
     (call-with-temporary-directory
      (lambda (directory)
@@ -241,4 +239,51 @@ print('hello world')"))
                                            "/some/other/path")))
          #f)))))
 
+(define (arg-test bash-args)
+  (call-with-temporary-directory
+   (lambda (directory)
+     (let ((script-file-name (string-append directory "/bash-test.sh")))
+       (call-with-output-file script-file-name
+         (lambda (port)
+           (display (string-append "\
+#!" (which "bash") bash-args "
+echo \"$#$0$*${A}\"")
+                    port)))
+
+       (display "Unwrapped script contents:\n")
+       (call-with-input-file script-file-name
+         (lambda (port) (display (get-string-all port))))
+       (newline) (newline)
+       (chmod script-file-name #o777)
+       (setenv "A" "A")
+       (let* ((run-script (lambda _
+                            (open-pipe*
+                             OPEN_READ
+                             script-file-name "1" "2" "3 3" "4")))
+              (pipe (run-script))
+              (unwrapped-output (get-string-all pipe)))
+         (close-pipe pipe)
+
+         (wrap-script script-file-name `("A" = ("A\nA")))
+
+         (display "Wrapped script contents:\n")
+         (call-with-input-file script-file-name
+           (lambda (port) (display (get-string-all port))))
+         (newline) (newline)
+
+         (let* ((pipe (run-script))
+                (wrapped-output (get-string-all pipe)))
+           (close-pipe pipe)
+           (display "./bash-test.sh 1 2 3\\ 3 4 # Output:\n")
+           (display unwrapped-output) (newline)
+           (display "./bash-test.sh 1 2 3\\ 3 4 # Output (wrapped):\n")
+           (display wrapped-output) (newline)
+           (string=? (string-append unwrapped-output "A\n") wrapped-output)))))))
+
+(test-assert "wrap-script, argument handling"
+  (arg-test ""))
+
+(test-assert "wrap-script, argument handling, bash --norc"
+  (arg-test " --norc"))
+
 (test-end)
-- 
2.31.1