diff options
| -rw-r--r-- | guix/build/gremlin.scm | 36 | ||||
| -rw-r--r-- | tests/gremlin.scm | 12 |
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") |