nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2015-04-23 11:23:14 +02:00
parent a635ed5ccb
commit cd91504df2
2 changed files with 43 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
guix/build/gremlin.scm
View File

@ -39,6 +39,7 @@
elf-dynamic-info-needed elf-dynamic-info-needed
elf-dynamic-info-rpath elf-dynamic-info-rpath
elf-dynamic-info-runpath elf-dynamic-info-runpath
expand-origin
validate-needed-in-runpath)) validate-needed-in-runpath))
@ -236,6 +237,30 @@ value of DT_NEEDED entries is a string.)"
(string-prefix? libc-lib lib)) (string-prefix? libc-lib lib))
%libc-libraries)) %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 (define* (validate-needed-in-runpath file
#:key (always-found? libc-library?)) #:key (always-found? libc-library?))
"Return #t if all the libraries listed as FILE's 'DT_NEEDED' entries are "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 (let* ((elf (call-with-input-file file
(compose parse-elf get-bytevector-all))) (compose parse-elf get-bytevector-all)))
(expand (cute expand-origin <> (dirname file)))
(dyninfo (elf-dynamic-info elf))) (dyninfo (elf-dynamic-info elf)))
(when dyninfo (when dyninfo
(let* ((runpath (filter store-file-name? ;; XXX: In theory we should also expand $PLATFORM and $LIB, but these
(elf-dynamic-info-runpath dyninfo))) ;; appear to be really unused.
(bogus (remove store-file-name? (let* ((expanded (map expand (elf-dynamic-info-runpath dyninfo)))
(elf-dynamic-info-runpath dyninfo))) (runpath (filter store-file-name? expanded))
(bogus (remove store-file-name? expanded))
(needed (remove always-found? (needed (remove always-found?
(elf-dynamic-info-needed dyninfo))) (elf-dynamic-info-needed dyninfo)))
(not-found (remove (cut search-path runpath <>) (not-found (remove (cut search-path runpath <>)
needed))) needed)))
;; XXX: $ORIGIN is not supported.
(unless (null? bogus) (unless (null? bogus)
(format (current-error-port) (format (current-error-port)
"~a: warning: RUNPATH contains bogus entries: ~s~%" "~a: warning: RUNPATH contains bogus entries: ~s~%"

12
tests/gremlin.scm
View File

@ -21,6 +21,7 @@
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (guix build gremlin) #:use-module (guix build gremlin)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-64) #:use-module (srfi srfi-64)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (ice-9 match)) #:use-module (ice-9 match))
@ -51,6 +52,17 @@
(string-take lib (string-contains lib ".so"))) (string-take lib (string-contains lib ".so")))
(elf-dynamic-info-needed dyninfo)))))) (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") (test-end "gremlin")