01/01: gremlin: Ignore non-store file names in RUNPATH and warn about them.

[Ludovic Courtès]

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

commit dacd5d2ca7411251570cf486febcb2cde3ed021f
Author: Ludovic Courtès <address@hidden>
Date:   Sun Apr 5 15:31:55 2015 +0200

    gremlin: Ignore non-store file names in RUNPATH and warn about them.
    
    * guix/build/gremlin.scm (validate-needed-in-runpath)[runpath]:
      Add (filter absolute-file-name? ...).
      Emit a warning when RUNPATH file names that do not match
      'store-file-name?'.  Change format of error message to begin with file
      name.
    * guix/build/utils.scm (store-file-name?): New procedure.
---
 guix/build/gremlin.scm |   14 ++++++++++++--
 guix/build/utils.scm   |    5 +++++
 2 files changed, 17 insertions(+), 2 deletions(-)

diff --git a/guix/build/gremlin.scm b/guix/build/gremlin.scm
index 24a7b55..30b0603 100644
--- a/guix/build/gremlin.scm
+++ b/guix/build/gremlin.scm
@@ -18,6 +18,7 @@
 
 (define-module (guix build gremlin)
   #:use-module (guix elf)
+  #:use-module ((guix build utils) #:select (store-file-name?))
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
@@ -255,14 +256,23 @@ exceeds total size~%"
                       (compose parse-elf get-bytevector-all)))
            (dyninfo (elf-dynamic-info elf)))
       (when dyninfo
-        (let* ((runpath   (elf-dynamic-info-runpath dyninfo))
+        (let* ((runpath   (filter store-file-name?
+                                  (elf-dynamic-info-runpath dyninfo)))
+               (bogus     (remove store-file-name?
+                                  (elf-dynamic-info-runpath dyninfo)))
                (needed    (remove always-found?
                                   (elf-dynamic-info-needed dyninfo)))
                (not-found (remove (cut search-path runpath <>)
                                   needed)))
+          ;; XXX: $ORIGIN is not supported.
+          (unless (null? bogus)
+            (format (current-error-port)
+                    "~a: warning: RUNPATH contains bogus entries: ~s~%"
+                    file bogus))
+
           (for-each (lambda (lib)
                       (format (current-error-port)
-                              "error: '~a' depends on '~a', which cannot \
+                              "~a: error: depends on '~a', which cannot \
 be found in RUNPATH ~s~%"
                               file lib runpath))
                     not-found)
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 5d229b5..fbd5d54 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -32,6 +32,7 @@
   #:re-export (alist-cons
                alist-delete)
   #:export (%store-directory
+            store-file-name?
             parallel-job-count
 
             directory-exists?
@@ -81,6 +82,10 @@
   (or (getenv "NIX_STORE")
       "/gnu/store"))
 
+(define (store-file-name? file)
+  "Return true if FILE is in the store."
+  (string-prefix? (%store-directory) file))
+
 (define parallel-job-count
   ;; Number of processes to be passed next to GNU Make's `-j' argument.
   (make-parameter