02/18: utils: Define ‘search-input-file’ procedure.

[guix-commits]

civodul pushed a commit to branch core-updates
in repository guix.

commit 5378edeab4e90f9dec6ae9bc5706a4ac790294b7
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Mon May 31 18:36:09 2021 +0200

    utils: Define ‘search-input-file’ procedure.
    
    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 (target=#f in Guix parlance),
    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 defines a ‘search-input-file’ procedure. It functions
    like 'which', but instead of searching in $PATH, it searches in
    the 'inputs' of the build phase, which must be passed to
    ‘search-input-file’ as an argument. Also, the file name must
    include "bin/" or "sbin/" as appropriate.
    
    * guix/build/utils.scm (search-input-file): New procedure.
    * tests/build-utils.scm
      ("search-input-file: exception if not found")
      ("search-input-file: can find if existent"): Test it.
    * doc/guix.texi (File Search): Document it.
    
    Partially-Fixes: <https://issues.guix.gnu.org/47869>
    Co-Authored-By: Ludovic Courtès <ludo@gnu.org>
    Signed-off-by: Ludovic Courtès <ludo@gnu.org>
---
 doc/guix.texi         | 20 ++++++++++++++++++++
 guix/build/utils.scm  | 21 ++++++++++++++++++++-
 tests/build-utils.scm | 25 +++++++++++++++++++++++++
 3 files changed, 65 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 535e761..3557c97 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -8661,6 +8661,26 @@ Return the complete file name for @var{program} as found 
in
 @code{$PATH}, or @code{#f} if @var{program} could not be found.
 @end deffn
 
+@deffn {Scheme Procedure} search-input-file @var{inputs} @var{name}
+Return the complete file name for @var{name} as found in @var{inputs}.
+If @var{name} could not be found, an exception is raised instead.
+Here, @var{inputs} is an association list like @var{inputs} and
+@var{native-inputs} as available to build phases.
+@end deffn
+
+Here is a (simplified) example of how @code{search-input-file} is used
+in a build phase of the @code{wireguard-tools} package:
+
+@lisp
+(add-after 'install 'wrap-wg-quick
+  (lambda* (#:key inputs outputs #:allow-other-keys)
+    (let ((coreutils (string-append (assoc-ref inputs "coreutils")
+                                    "/bin")))
+      (wrap-program (search-input-file outputs "bin/wg-quick")
+        #:sh (search-input-file inputs "bin/bash")
+        `("PATH" ":" prefix ,(list coreutils))))))
+@end lisp
+
 @subsection Build Phases
 
 @cindex build phases
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index c6731b3..2636da3 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic 
Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 
Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2015, 2018, 2021 Mark H Weaver <mhw@netris.org>
@@ -80,6 +80,10 @@
             search-path-as-string->list
             list->search-path-as-string
             which
+            search-input-file
+            search-error?
+            search-error-path
+            search-error-file
 
             every*
             alist-cons-before
@@ -614,6 +618,21 @@ PROGRAM could not be found."
   (search-path (search-path-as-string->list (getenv "PATH"))
                program))
 
+(define-condition-type &search-error &error
+  search-error?
+  (path         search-error-path)
+  (file         search-error-file))
+
+(define (search-input-file inputs file)
+  "Find a file named FILE among the INPUTS and return its absolute file name.
+
+FILE must be a string like \"bin/sh\". If FILE is not found, an exception is
+raised."
+  (match inputs
+    (((_ . directories) ...)
+     (or (search-path directories file)
+         (raise (condition (&search-error (path directories) (file file))))))))
+
 
 ;;;
 ;;; Phases.
diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index 31be7ff..6b131c0 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,28 @@ print('hello world')"))
          (lambda _
            (get-string-all (current-input-port))))))))
 
+(test-equal "search-input-file: exception if not found"
+  `((path)
+    (file . "does-not-exist"))
+  (guard (e ((search-error? e)
+             `((path . ,(search-error-path e))
+               (file . ,(search-error-file e)))))
+    (search-input-file '() "does-not-exist")))
+
+(test-equal "search-input-file: can find if existent"
+  (which "guile")
+  (search-input-file
+    `(("guile/bin" . ,(dirname (which "guile"))))
+    "guile"))
+
+(test-equal "search-input-file: can search in multiple directories"
+  (which "guile")
+  (call-with-temporary-directory
+    (lambda (directory)
+      (search-input-file
+        `(("irrelevant" . ,directory)
+          ("guile/bin" . ,(dirname (which "guile"))))
+        "guile"))))
+
+
 (test-end)