summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-04-23 11:23:14 +0200
committerLudovic Courtès <ludo@gnu.org>2015-04-23 18:52:40 +0200
commitcd91504df27aa0f311735c61f3b7b7ee3fee861a (patch)
tree19136da033dd673077989ad0c6e02f89d3d2a043
parenta635ed5ccb78c8010e0368d1e82ad1f7ca1af5be (diff)
gremlin: Add support for the expansion of $ORIGIN in RUNPATH.
* guix/build/gremlin.scm (expand-variable, expand-origin): New procedures. (validate-needed-in-runpath): Map 'expand-origin' to the RUNPATH field of DYNINFO. * tests/gremlin.scm ("expand-origin"): New test.
-rw-r--r--guix/build/gremlin.scm36
-rw-r--r--tests/gremlin.scm12
2 files changed, 43 insertions, 5 deletions
diff --git a/guix/build/gremlin.scm b/guix/build/gremlin.scm
index 30b06034dd..fed529b193 100644
--- a/guix/build/gremlin.scm
+++ b/guix/build/gremlin.scm
@@ -39,6 +39,7 @@
elf-dynamic-info-needed
elf-dynamic-info-rpath
elf-dynamic-info-runpath
+ expand-origin
validate-needed-in-runpath))
@@ -236,6 +237,30 @@ value of DT_NEEDED entries is a string.)"
(string-prefix? libc-lib lib))
%libc-libraries))
+(define (expand-variable str variable value)
+ "Replace occurrences of '$VARIABLE' or '${VARIABLE}' in STR with VALUE."
+ (define variables
+ (list (string-append "$" variable)
+ (string-append "${" variable "}")))
+
+ (let loop ((thing variables)
+ (str str))
+ (match thing
+ (()
+ str)
+ ((head tail ...)
+ (let ((index (string-contains str head))
+ (len (string-length head)))
+ (loop (if index variables tail)
+ (if index
+ (string-replace str value
+ index (+ index len))
+ str)))))))
+
+(define (expand-origin str directory)
+ "Replace occurrences of '$ORIGIN' in STR with DIRECTORY."
+ (expand-variable str "ORIGIN" directory))
+
(define* (validate-needed-in-runpath file
#:key (always-found? libc-library?))
"Return #t if all the libraries listed as FILE's 'DT_NEEDED' entries are
@@ -254,17 +279,18 @@ exceeds total size~%"
(let* ((elf (call-with-input-file file
(compose parse-elf get-bytevector-all)))
+ (expand (cute expand-origin <> (dirname file)))
(dyninfo (elf-dynamic-info elf)))
(when dyninfo
- (let* ((runpath (filter store-file-name?
- (elf-dynamic-info-runpath dyninfo)))
- (bogus (remove store-file-name?
- (elf-dynamic-info-runpath dyninfo)))
+ ;; XXX: In theory we should also expand $PLATFORM and $LIB, but these
+ ;; appear to be really unused.
+ (let* ((expanded (map expand (elf-dynamic-info-runpath dyninfo)))
+ (runpath (filter store-file-name? expanded))
+ (bogus (remove store-file-name? expanded))
(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~%"
diff --git a/tests/gremlin.scm b/tests/gremlin.scm
index 225a72ff9f..dc9f78c21a 100644
--- a/tests/gremlin.scm
+++ b/tests/gremlin.scm
@@ -21,6 +21,7 @@
#:use-module (guix build utils)
#:use-module (guix build gremlin)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-64)
#:use-module (rnrs io ports)
#:use-module (ice-9 match))
@@ -51,6 +52,17 @@
(string-take lib (string-contains lib ".so")))
(elf-dynamic-info-needed dyninfo))))))
+(test-equal "expand-origin"
+ '("OOO/../lib"
+ "OOO"
+ "../OOO/bar/OOO/baz"
+ "ORIGIN/foo")
+ (map (cut expand-origin <> "OOO")
+ '("$ORIGIN/../lib"
+ "${ORIGIN}"
+ "../${ORIGIN}/bar/$ORIGIN/baz"
+ "ORIGIN/foo")))
+
(test-end "gremlin")