Fixes <https://issues.guix.gnu.org/74450>.
* guix/build/utils.scm (patch-shebang): Match an additional second potential
argument with regexp to be checked for the "env -S CMD" form.
Change-Id: Ib6f8528a83721dd3ceef34e7fceacf6274b857e5
---
guix/build/utils.scm | 84 ++++++++++++++++++++++++++++++--------------
1 file changed, 57 insertions(+), 27 deletions(-)
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 94714bf397..451c6322cb 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -10,6 +10,7 @@
;;; Copyright © 2021, 2022 Maxime Devos <maximede...@telenet.be>
;;; Copyright © 2021 Brendan Tildesley <m...@brendan.scot>
;;; Copyright © 2023 Carlo Zancanaro <ca...@zancanaro.id.au>
+;;; Copyright © 2025 aurtzy <aur...@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -1114,7 +1115,18 @@ (define (get-char* p)
(x x)))
(define patch-shebang
- (let ((shebang-rx (make-regexp
"^[[:blank:]]*(/[[:graph:]]+)[[:blank:]]*([[:graph:]]*)(.*)$")))
+ ;; This procedure assumes that the operating system only splits on whitespace
+ ;; immediately after the interpreter, so the rest of the string is considered
+ ;; a singular argument. Sometimes when a package desires more than one
+ ;; argument in a shebang, "#!.../env -S CMD ..." is commonly used, so we also
+ ;; patch CMD as a special case.
+
+ ;; Whitespace-split just the first two substrings (if any) from the optional
+ ;; singular argument so we can check if the form "env -S CMD" is present and
+ ;; patch it.
+ (let ((shebang-rx
+ (make-regexp
+
"^[[:blank:]]*(/[[:graph:]]+)[[:blank:]]*([[:graph:]]*)[[:blank:]]*([[:graph:]]*)[[:blank:]]*(.*)$")))
(lambda* (file
#:optional
(path (search-path-as-string->list (getenv "PATH")))
@@ -1123,7 +1135,7 @@ (define patch-shebang
PATH, when FILE actually starts with a shebang. Return #t when FILE was
patched, #f otherwise. When KEEP-MTIME? is true, the atime/mtime of
FILE are kept unchanged."
- (define (patch p interpreter rest-of-line)
+ (define (patch p interpreter . arguments)
(let* ((template (string-append file ".XXXXXX"))
(out (mkstemp! template))
(st (stat file))
@@ -1131,7 +1143,9 @@ (define patch-shebang
(with-throw-handler #t
(lambda ()
(format out "#!~a~a~%"
- interpreter rest-of-line)
+ interpreter
+ (string-join (filter (negate string-null?) arguments)
+ " " 'prefix))
(dump-port p out)
(close out)
(chmod template mode)
@@ -1146,6 +1160,9 @@ (define patch-shebang
(false-if-exception (delete-file template))
#f))))
+ (define (bin-from-path cmd-or-filepath)
+ (search-path path (basename cmd-or-filepath)))
+
(call-with-ascii-input-file file
(lambda (p)
(and (eq? #\# (get-char* p))
@@ -1153,34 +1170,47 @@ (define patch-shebang
(let ((line (false-if-exception (read-line p))))
(and=> (and line (regexp-exec shebang-rx line))
(lambda (m)
- (let* ((interp (match:substring m 1))
+ (let* ((arg0 (match:substring m 1))
(arg1 (match:substring m 2))
- (rest (match:substring m 3))
- (has-env (string-suffix? "/env" interp))
- (cmd (if has-env arg1 (basename interp)))
- (bin (search-path path cmd)))
- (if bin
- (if (string=? bin interp)
- #f ; nothing to do
- (if has-env
+ (arg2 (match:substring m 3))
+ (rest (match:substring m 4))
+ (has-env? (string-suffix? "/env" arg0)))
+ (catch 'binary-not-found
+ (lambda ()
+ (cond
+ ((and has-env? (string=? arg1 "-S"))
+ (let ((arg0-bin (bin-from-path "env"))
+ (arg2-bin (bin-from-path arg2)))
+ (unless arg0-bin (throw 'binary-not-found
arg0))
+ (unless arg2-bin (throw 'binary-not-found
arg2))
+ (format (current-error-port)
+ "patch-shebang: ~a: changing `~a'
to `~a'~%"
+ file
+ (string-join (list arg0 arg1 arg2))
+ (string-join (list arg0-bin arg1
arg2-bin)))
+ (patch p arg0-bin arg1 arg2-bin rest)))
+ (has-env?
+ (let ((arg1-bin (bin-from-path arg1)))
+ (unless arg1-bin (throw 'binary-not-found
arg1))
+ (format (current-error-port)
+ "patch-shebang: ~a: changing `~a'
to `~a'~%"
+ file (string-append arg0 " " arg1)
arg1-bin)
+ (patch p arg1-bin arg2 rest)))
+ (else
+ (let ((arg0-bin (bin-from-path arg0)))
+ (unless arg0-bin (throw 'binary-not-found
arg0))
+ (if (string=? arg0-bin arg0)
+ #f ; nothing to do
(begin
(format (current-error-port)
"patch-shebang: ~a: changing
`~a' to `~a'~%"
- file (string-append interp "
" arg1) bin)
- (patch p bin rest))
- (begin
- (format (current-error-port)
- "patch-shebang: ~a: changing
`~a' to `~a'~%"
- file interp bin)
- (patch p bin
- (if (string-null? arg1)
- ""
- (string-append " " arg1
rest))))))
- (begin
- (format (current-error-port)
- "patch-shebang: ~a: warning: no
binary for interpreter `~a' found in $PATH~%"
- file (basename cmd))
- #f))))))))))))
+ file arg0 arg0-bin)
+ (patch p arg0-bin arg1 arg2
rest)))))))
+ (lambda (kind cmd)
+ (format (current-error-port)
+ "patch-shebang: ~a: warning: no binary
for interpreter `~a' found in $PATH~%"
+ file (basename cmd))
+ #f))))))))))))
(define* (patch-makefile-SHELL file #:key (keep-mtime? #t))
"Patch the `SHELL' variable in FILE, which is supposedly a makefile.
--
2.49.0
