futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

gremlin: Add 'file-needed/recursive'.

Browse Source 
* guix/build/gremlin.scm (file-needed/recursive): New procedure.
* tests/gremlin.scm ("file-needed/recursive"): New test.
This commit is contained in:
Ludovic Courtès 2020-11-27 16:35:45 +01:00
parent fad97a01df
commit 53fd256e5b
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 77 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
guix/build/gremlin.scm
View File

@ -44,6 +44,7 @@
file-dynamic-info
file-runpath
file-needed
file-needed/recursive
missing-runpath-error?
missing-runpath-error-file
@ -259,6 +260,46 @@ FILE lacks dynamic info."
dynamic info."
(and=> (file-dynamic-info file) elf-dynamic-info-needed))
(define (file-needed/recursive file)
"Return two values: the list of absolute .so file names FILE depends on,
recursively, and the list of .so file names that could not be found. File
names are resolved by searching the RUNPATH of the file that NEEDs them.
This is similar to the info returned by the 'ldd' command."
(let loop ((files (list file))
(result '())
(not-found '()))
(match files
(()
(values (reverse result)
(reverse (delete-duplicates not-found))))
((file . rest)
(match (file-dynamic-info file)
(#f
(loop rest result not-found))
(info
(let ((runpath (elf-dynamic-info-runpath info))
(needed (elf-dynamic-info-needed info)))
(if (and runpath needed)
(let* ((runpath (map (cute expand-origin <> (dirname file))
runpath))
(resolved (map (cut search-path runpath <>)
needed))
(failed (filter-map (lambda (needed resolved)
(and (not resolved)
(not (libc-library? needed))
needed))
needed resolved))
(needed (remove (lambda (value)
(or (not value)
;; XXX: quadratic
(member value result)))
resolved)))
(loop (append rest needed)
(append needed result)
(append failed not-found)))
(loop rest result not-found)))))))))
(define %libc-libraries
;; List of libraries as of glibc 2.21 (there are more but those are
;; typically mean to be LD_PRELOADed and thus do not appear as NEEDED.)

36
tests/gremlin.scm
View File

@ -27,6 +27,8 @@
#:use-module (srfi srfi-64)
#:use-module (rnrs io ports)
#:use-module (ice-9 popen)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:use-module (ice-9 match))
(define %guile-executable
@ -58,6 +60,40 @@
(string-take lib (string-contains lib ".so")))
(elf-dynamic-info-needed dyninfo))))))
(unless (and %guile-executable (not (getenv "LD_LIBRARY_PATH"))
(file-needed %guile-executable)) ;statically linked?
(test-skip 1))
(test-assert "file-needed/recursive"
(let* ((needed (file-needed/recursive %guile-executable))
(pipe (dynamic-wind
(lambda ()
;; Tell ld.so to list loaded objects, like 'ldd' does.
(setenv "LD_TRACE_LOADED_OBJECTS" "yup"))
(lambda ()
(open-pipe* OPEN_READ %guile-executable))
(lambda ()
(unsetenv "LD_TRACE_LOADED_OBJECTS")))))
(define ldd-rx
(make-regexp "^[[:blank:]]+([[:graph:]]+ => )?([[:graph:]]+) .*$"))
(define (read-ldd-output port)
;; Read from PORT output in GNU ldd format.
(let loop ((result '()))
(match (read-line port)
((? eof-object?)
(reverse result))
((= (cut regexp-exec ldd-rx <>) m)
(if m
(loop (cons (match:substring m 2) result))
(loop result))))))
(define ground-truth
(remove (cut string-prefix? "linux-vdso.so" <>)
(read-ldd-output pipe)))
(and (zero? (close-pipe pipe))
(lset= string=? (pk 'truth ground-truth) (pk 'needed needed)))))
(test-equal "expand-origin"
'("OOO/../lib"
"OOO"