Subject: Re: bug#47221: Guile not in native-inputs when it should

From: Maxime Devos <[email-masked]>
Date: Thu, 18 Mar 2021 15:01:59 +0100

This fixes some uses of wrap-script.
From c451edc7ba759cf31f5d0ca113f7df9e28ccfe3b Mon Sep 17 00:00:00 2001
From: Maxime Devos <[email-masked]>
Date: Thu, 18 Mar 2021 14:40:20 +0100
Subject: [PATCH] gnu: Explicitely pass the guile binary to wrap-script.

If the #:guile argument of wrap-script is not set,
then a guile binary will be searched for in the PATH.

When cross-compiling, this would result in a guile package
compiled for a wrong architecture being used (if guile is in
native-inputs) or a broken wrapper script that tries to use
"#f" as interpreter.

Note that there are more cross-compilation issues
lurking in the affected packages, e.g. gess uses a
python of the incorrect architecture.

Partially fixes: <https://issues.guix.gnu.org/47221>.

* gnu/packages/xdisorg.scm (clipmenu)[arguments]: Use the
  guile of the target platform in wrap-script.
* gnu/packages/vpn.scm (vpnc-scripts)[arguments]: Likewise.
* gnu/packages/mail.scm (sieve-connect)[arguments]: Likewise.
* gnu/packages/bioinformatics.scm
  (proteinortho)[arguments]: Likewise.
  (prinseq)[arguments]: Likewise.
  (gess)[arguments]: Likewise.
  (nanopolish)[arguments]: Likewise.
---
 gnu/packages/bioinformatics.scm | 27 +++++++++++++++++++--------
 gnu/packages/mail.scm           |  4 +++-
 gnu/packages/vpn.scm            |  2 ++
 gnu/packages/xdisorg.scm        |  4 +++-
 4 files changed, 27 insertions(+), 10 deletions(-)

diff --git a/gnu/packages/bioinformatics.scm b/gnu/packages/bioinformatics.scm
index 8b38c7ce0d..eb9355a37e 100644
--- a/gnu/packages/bioinformatics.scm
+++ b/gnu/packages/bioinformatics.scm
@@ -5426,10 +5426,13 @@ predicts the locations of structural units in the sequences.")
              #t))
          (add-after 'install 'wrap-programs
            (lambda* (#:key inputs outputs #:allow-other-keys)
-             (let ((path (getenv "PATH"))
-                   (out (assoc-ref outputs "out")))
+             (let* ((path (getenv "PATH"))
+                    (out (assoc-ref outputs "out"))
+                    (guile (assoc-ref inputs "guile")))
                (for-each (lambda (script)
-                           (wrap-script script `("PATH" ":" prefix (,path))))
+                           (wrap-script script
+                             #:guile (string-append guile "/bin/guile")
+                             `("PATH" ":" prefix (,path))))
                          (cons (string-append out "/bin/proteinortho")
                                (find-files out "\\.(pl|py)$"))))
              #t)))))
@@ -7900,11 +7903,14 @@ experience substantial biological insertions and deletions.")
          (replace 'install
            (lambda* (#:key outputs #:allow-other-keys)
              (let* ((out (assoc-ref outputs "out"))
-                    (bin (string-append out "/bin")))
+                    (bin (string-append out "/bin"))
+                    (guile (assoc-ref inputs "guile"))
+                    (guile-binary (string-append guile "/bin/guile")))
                (for-each (lambda (file)
                            (chmod file #o555)
                            (install-file file bin)
                            (wrap-script (string-append bin "/" (basename file))
+                                        #:guile guile-binary
                                         `("PERL5LIB" ":" prefix
                                           (,(getenv "PERL5LIB")))))
                          (find-files "." "prinseq.*.pl"))))))))
@@ -11123,7 +11129,8 @@ remove biased methylation positions for RRBS sequence files.")
                              out "/lib/python"
                              ,(version-major+minor
                                 (package-version python))
-                             "/site-packages/gess/")))
+                             "/site-packages/gess/"))
+                    (guile (assoc-ref inputs "guile")))
                (mkdir-p target)
                (copy-recursively "." target)
                ;; Make GESS.py executable
@@ -11138,6 +11145,7 @@ matplotlib.use('Agg')
 " line)))
                ;; Make sure GESS has all modules in its path
                (wrap-script (string-append target "GESS.py")
+                 #:guile (string-append guile "/bin/guile")
                  `("PYTHONPATH" ":" = (,target ,(getenv "PYTHONPATH"))))
                (mkdir-p bin)
                (symlink (string-append target "GESS.py")
@@ -14345,16 +14353,19 @@ choosing which reads pass the filter.")
                            (find-files "scripts" ".*"))
                  #t)))
            (add-after 'install 'wrap-programs
-             (lambda* (#:key outputs #:allow-other-keys)
+             (lambda* (#:key inputs outputs #:allow-other-keys)
                (let ((pythonpath (getenv "PYTHONPATH"))
                      (perl5lib (getenv "PERL5LIB"))
                      (scripts (string-append (assoc-ref outputs "out")
-                                             "/share/nanopolish/scripts")))
+                                             "/share/nanopolish/scripts"))
+                     (guile (assoc-ref inputs "guile")))
                  (for-each (lambda (file)
                              (wrap-program file `("PYTHONPATH" ":" prefix (,pythonpath))))
                            (find-files scripts "\\.py"))
                  (for-each (lambda (file)
-                             (wrap-script file `("PERL5LIB" ":" prefix (,perl5lib))))
+                             (wrap-script file
+                               #:guile (string-append guile "/bin/guile")
+                               `("PERL5LIB" ":" prefix (,perl5lib))))
                            (find-files scripts "\\.pl"))))))))
       (inputs
        `(("guile" ,guile-3.0) ; for wrappers
diff --git a/gnu/packages/mail.scm b/gnu/packages/mail.scm
index d21c0e204d..5493d51203 100644
--- a/gnu/packages/mail.scm
+++ b/gnu/packages/mail.scm
@@ -2841,8 +2841,10 @@ transfer protocols.")
          (add-after 'install 'wrap-program
            (lambda* (#:key inputs outputs #:allow-other-keys)
              (let ((out (assoc-ref outputs "out"))
-                   (path (getenv "PERL5LIB")))
+                   (path (getenv "PERL5LIB"))
+                   (guile (assoc-ref inputs "guile")))
                (wrap-script (string-append out "/bin/sieve-connect")
+                 #:guile (string-append guile "/bin/guile")
                  `("PERL5LIB" ":" = (,path)))
                #t))))))
     (inputs
diff --git a/gnu/packages/vpn.scm b/gnu/packages/vpn.scm
index 76af7582fc..8aa1ac672c 100644
--- a/gnu/packages/vpn.scm
+++ b/gnu/packages/vpn.scm
@@ -196,6 +196,8 @@ Only \"Universal TUN/TAP device driver support\" is needed in the kernel.")
                  (for-each
                   (lambda (script)
                     (wrap-script (string-append out "/etc/vpnc/" script)
+                      #:guile (string-append (assoc-ref inputs "guile")
+                                             "/bin/guile")
                       `("PATH" ":" prefix
                         ,(map (lambda (name)
                                 (let ((input (assoc-ref inputs name)))
diff --git a/gnu/packages/xdisorg.scm b/gnu/packages/xdisorg.scm
index 56ac53edec..5aad1c8cce 100644
--- a/gnu/packages/xdisorg.scm
+++ b/gnu/packages/xdisorg.scm
@@ -2545,10 +2545,12 @@ tools to complement clipnotify.")
                       (gawk              (assoc-ref inputs "gawk"))
                       (util-linux        (assoc-ref inputs "util-linux"))
                       (xdotool           (assoc-ref inputs "xdotool"))
-                      (xsel              (assoc-ref inputs "xsel")))
+                      (xsel              (assoc-ref inputs "xsel"))
+                      (guile             (assoc-ref inputs "guile")))
                  (for-each
                   (lambda (prog)
                     (wrap-script (string-append out "/bin/" prog)
+                      #:guile (string-append guile "/bin/guile")
                       `("PATH" ":" prefix
                         ,(map (lambda (dir)
                                 (string-append dir "/bin"))
-- 
2.30.2