[bug#47869] [PATCH core-updates] ‘which’ looks in PATH, incorrect when cross-compiling

[Maxime Devos <maximedevos@telenet.be>]

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

The procedure ‘which’ from (guix build utils)
is used for two different purposes:

 1. for finding the absolute file name of a binary
    that we need to run during the build process

 2. for finding the absolute file name of a binary,
    for the target system (as in --target=TARGET),
    e.g. for substituting sh->/gnu/store/.../bin/sh,
    python->/gnu/store/.../bin/python

When compiling natively (SYSTEM=TARGET modulo nix/autotools differences),
this is perfectly fine.

However, when cross-compiling, we have a problem.
"which" looks in $PATH for binaries.  That's good for purpose (1),
but incorrect for (2), as the $PATH contains binaries from native-inputs
instead of inputs.

Admittedly, ‘which’ is simply very convenient (although incorrect
when cross-compiling), and we don't have the right tool ...
until now, that is (see patch)!

This patch adds an optional 'inputs' argument.  When it is present,
'which' will look in the bin and sbin subdirectories of the directories
in the 'inputs' alist.

Use it like this:

  (package [...]
    (arguments
     `(#:modules (guix build utils)
       #:phases
       (modify-phases %standard-phases
         (delete 'configure)
         (delete 'check)
         (add-after 'install 'wrap
           (lambda* (#:key outputs inputs #:allow-other-keys)
             (let ((growpart (string-append (assoc-ref outputs "out")
                                            "/bin/growpart")))
               (wrap-program growpart
                 `("PATH" ":" prefix (,(dirname (which "sfdisk" inputs))
                                      ,(dirname (which "readlink" inputs)))))))))))

(Examples comes from the "cloud-utils" package)
The only change is adding adding the 'inputs' argument.  Isn't that easy?

Alternative methods I've seen:
* (string-append (assoc-ref inputs "coreutils") "/bin/readlink")
* (let ((coreutils (assoc-ref inputs "coreutils")))
    (setenv "PATH" (string-append coreutils "/bin"))
    [code using (which "readlink")])
* (which "readlink") ; possibly incorrect when cross-compiling

I've tested this with "cloud-utils", though admittedly I didn't try to cross-compile
yet, and I've placed my adjusted "which" in a separate module to avoid having to rebuild
everything.  (The attached patch just modifies (guix build utils).)  I've written
a few tests, which pass.  I also documented the new functionality in the manual.

Currently incorrect uses of "which" can be fixed in a follow-up patch.

Thoughts?
Maxime.

[-- Attachment #1.2: 0001-build-Add-argument-to-which-for-specifying-where-to-.patch --]
[-- Type: text/x-patch, Size: 5530 bytes --]

From dc01abf110b1c8db05442ce3986683c10e784f26 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sun, 18 Apr 2021 12:45:13 +0200
Subject: [PATCH 1/2] build: Add argument to which for specifying where to
 search.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

The procedure ‘which’ from (guix build utils)
is used for two different purposes:

 1. for finding the absolute file name of a binary
    that needs to run during the build process

 2. for finding the absolute file name of a binary,
    for the target system (as in --target=TARGET),
    e.g. for substituting sh->/gnu/store/.../bin/sh,
    python->/gnu/store/.../bin/python.

When compiling natively (SYSTEM=TARGET modulo nix/autotools differences),
this is perfectly fine.

However, when cross-compiling, there is a problem.
"which" looks in $PATH for binaries.  That's good for purpose (1),
but incorrect for (2), as the $PATH contains binaries from native-inputs
instead of inputs.

This commit adds an optional 'inputs' argument.  When it is present,
'which' will look in the bin and sbin subdirectories of the directories
in the 'inputs' alist.

* guix/build/utils.scm (which): Add optional 'inputs' argument
* tests/build/utils.scm
  ("which, inputs in /bin", "which, inputs in /sbin")
  ("which, empty inputs", "which, using $PATH"): Test both old and new
  functionality of this procedure.
  (touch): Define procedure.
  (with-artificial-inputs): Define macro.
---
 guix/build/utils.scm  | 16 +++++++++----
 tests/build-utils.scm | 53 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 65 insertions(+), 4 deletions(-)

diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 6c37021673..5eb9f9580b 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -607,10 +608,17 @@ denoting file names to look for under the directories designated by FILES:
           (format #t "environment variable `~a' set to `~a'~%"
                   env-var value)))))
 
-(define (which program)
-  "Return the complete file name for PROGRAM as found in $PATH, or #f if
-PROGRAM could not be found."
-  (search-path (search-path-as-string->list (getenv "PATH"))
+(define* (which program #:optional inputs)
+  "Return the complete file name for PROGRAM as found in $PATH, or #false if
+PROGRAM could not be found.  If INPUTS is not #false, instead look in the
+/bin and /sbin subdirectories of INPUTS.  INPUTS is an alist; its keys
+are ignored."
+  (define (input->path input)
+    `(,(string-append (cdr input) "/bin")
+      ,(string-append (cdr input) "/sbin")))
+  (search-path (if inputs
+                   (append-map input->path inputs)
+                   (search-path-as-string->list (getenv "PATH")))
                program))
 
 \f
diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index 31be7ff80f..05e455a807 100644
--- a/tests/build-utils.scm
+++ b/tests/build-utils.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2012, 2015, 2016, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -263,4 +264,56 @@ print('hello world')"))
          (lambda _
            (get-string-all (current-input-port))))))))
 
+(define (touch file)
+  (call-with-output-file file (const #t)))
+
+(define-syntax-rule (with-artificial-inputs inputs
+                      ((x key relative-name) ...)
+                      exp exp* ...)
+  "For the duration of EXP EXP* ..., create a temporary directory.
+In this directory, the files RELATIVE-NAME ... are created, and
+X ... are bound to their absolute name.  INPUTS is bound to
+an alist with as keys KEY ... and as values the absolute file names
+of the grandparents of RELATIVE-NAME ... ."
+  (call-with-temporary-directory
+   (lambda (tempdir)
+     (let* ((x (in-vicinity tempdir relative-name))
+            ...
+            (inputs `((key . ,(dirname (dirname x))) ...)))
+       (for-each (compose mkdir-p dirname) (list x ...))
+       (for-each touch (list x ...))
+       exp exp* ...))))
+
+(test-equal "which, inputs in /bin"
+  '(#t #t)
+  (with-artificial-inputs inputs
+    ((x "package-x" "x-1.0/bin/x")
+     (y "package-y" "y-1.0/bin/y"))
+    (list (string=? x (which "x" (pk 'i inputs)))
+          (string=? y (which "y" inputs)))))
+
+(test-equal "which, inputs in /sbin"
+  '(#t #t)
+  (with-artificial-inputs inputs
+    ((x "package-x" "x-1.0/sbin/x")
+     (y "package-y" "y-1.0/sbin/y"))
+    (list (string=? x (which "x" inputs))
+          (string=? y (which "y" inputs)))))
+
+(test-equal "which, empty inputs"
+  #f
+  (which "ls" '()))
+
+(test-assert "which, using $PATH"
+  (call-with-temporary-directory
+   (lambda (dirname)
+     (touch (in-vicinity dirname "ls"))
+     (with-environment-variable "PATH" dirname
+                                (lambda ()
+         (string=? (in-vicinity dirname "ls") (which "ls")))))))
+
 (test-end)
+
+;;; Local Variables:
+;;; eval: (put 'with-artificial-inputs 'scheme-indent-function 1)
+;;; End:
-- 
2.31.1


[-- Attachment #1.3: 0002-doc-Document-new-functionality-of-which.patch --]
[-- Type: text/x-patch, Size: 2229 bytes --]

From 6561c943fa134ca1e2a17e43f8f5498fca9b1560 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sun, 18 Apr 2021 13:15:08 +0200
Subject: [PATCH 2/2] =?UTF-8?q?doc:=20Document=20new=20functionality=20of?=
 =?UTF-8?q?=20=E2=80=98which=E2=80=99.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* doc/guix.texi (File Search)[which]: Document the optional
  'inputs' argument, and give an example on how to use the
  procedure.
---
 doc/guix.texi | 19 +++++++++++++++++--
 1 file changed, 17 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 6464fa32cb..365cb13604 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -87,6 +87,7 @@ Copyright @copyright{} 2020 Daniel Brooks@*
 Copyright @copyright{} 2020 John Soo@*
 Copyright @copyright{} 2020 Jonathan Brielmaier@*
 Copyright @copyright{} 2020 Edgar Vincent@*
+Copyright @copyright{} 2021 Maxime Devos@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -8598,11 +8599,25 @@ the root of the Guix source tree:
 @result{} ("./libformat.a" "./libstore.a" @dots{})
 @end lisp
 
-@deffn {Scheme Procedure} which @var{program}
+@deffn {Scheme Procedure} which @var{program} [@var{inputs}=#false]
 Return the complete file name for @var{program} as found in
-@code{$PATH}, or @code{#f} if @var{program} could not be found.
+@code{$PATH}, or @code{#false} if @var{program} could not be found.
+If @var{INPUTS} is not @code{#false}, instead look in the
+@file{/bin} and @file{/sbin} subdirectories of @var{INPUTS}.
+@var{inputs} is an alist; its keys are ignored."
 @end deffn
 
+Here is an example using the @code{which} procedure in a build phase:
+
+@lisp
+(lambda* (#:key outputs inputs #:allow-other-keys)
+  (let ((growpart (string-append (assoc-ref outputs "out")
+                                          "/bin/growpart")))
+     (wrap-program growpart
+                   `("PATH" ":" prefix (,(dirname (which "sfdisk" inputs))
+                                        ,(dirname (which "readlink" inputs)))))))
+@end lisp
+
 @subsection Build Phases
 
 @cindex build phases
-- 
2.31.1


[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]