From: "Ludovic Courtès" <ludo@gnu.org>
To: 44899@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#44899] [PATCH v2 2/4] gremlin: Add 'file-needed/recursive'.
Date: Sat, 28 Nov 2020 11:24:06 +0100 [thread overview]
Message-ID: <20201128102409.3157-3-ludo@gnu.org> (raw)
In-Reply-To: <20201128102409.3157-1-ludo@gnu.org>
* guix/build/gremlin.scm (file-needed/recursive): New procedure.
* tests/gremlin.scm ("file-needed/recursive"): New test.
---
guix/build/gremlin.scm | 41 +++++++++++++++++++++++++++++++++++++++++
tests/gremlin.scm | 36 ++++++++++++++++++++++++++++++++++++
2 files changed, 77 insertions(+)
diff --git a/guix/build/gremlin.scm b/guix/build/gremlin.scm
index 44604827a9..d56984b85e 100644
--- a/guix/build/gremlin.scm
+++ b/guix/build/gremlin.scm
@@ -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 (pk 'file 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.)
diff --git a/tests/gremlin.scm b/tests/gremlin.scm
index f191adb8b3..9ddac14265 100644
--- a/tests/gremlin.scm
+++ b/tests/gremlin.scm
@@ -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"
--
2.29.2
next prev parent reply other threads:[~2020-11-28 10:25 UTC|newest]
Thread overview: 11+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-11-27 8:33 [bug#44899] [PATCH 0/3] Using 'ld.so.cache' to speed up application startup Ludovic Courtès
2020-11-27 9:05 ` [bug#44899] [PATCH 1/3] gnu: glibc: Load ${ORIGIN}/../etc/ld.so.cache when available Ludovic Courtès
2020-11-27 9:05 ` [bug#44899] [PATCH 2/3] gremlin: Fix typo in docstring Ludovic Courtès
2020-11-27 9:05 ` [bug#44899] [PATCH 3/3] build-system/gnu: Add 'make-dynamic-linker-cache' phase Ludovic Courtès
2020-11-28 10:24 ` [bug#44899] [PATCH v2 0/4] Using 'ld.so.cache' to speed up application startup Ludovic Courtès
2020-11-28 10:24 ` [bug#44899] [PATCH v2 1/4] gremlin: Fix typo in docstring Ludovic Courtès
2020-11-28 10:24 ` Ludovic Courtès [this message]
2020-11-28 10:24 ` [bug#44899] [PATCH v2 3/4] gnu: glibc: Load 'etc/ld.so.cache' in $ORIGIN's store item when available Ludovic Courtès
2020-11-28 10:24 ` [bug#44899] [PATCH v2 3/4] gnu: glibc: Load ${ORIGIN}/../etc/ld.so.cache " Ludovic Courtès
2020-11-28 10:24 ` [bug#44899] [PATCH v2 4/4] build-system/gnu: Add 'make-dynamic-linker-cache' phase Ludovic Courtès
2020-12-01 20:45 ` bug#44899: [PATCH v2 0/4] Using 'ld.so.cache' to speed up application startup Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20201128102409.3157-3-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=44899@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).