From: "Ludovic Courtès" <ludo@gnu.org>
To: 31208@debbugs.gnu.org
Subject: [bug#31208] [PATCH 1/3] gremlin: Preserve offset info for dynamic entries.
Date: Wed, 18 Apr 2018 18:40:52 +0200 [thread overview]
Message-ID: <20180418164054.29979-1-ludo@gnu.org> (raw)
In-Reply-To: <20180418163842.29823-1-ludo@gnu.org>
* guix/build/gremlin.scm (<dynamic-entry>): New record type.
(raw-dynamic-entries): Return a list of <dynamic-entry>.
(dynamic-entries): Adjust accordingly and return a list of <dynamic-entry>.
(elf-dynamic-info)[matching-entry]: New procedure.
Use it.
---
guix/build/gremlin.scm | 84 ++++++++++++++++++++++++------------------
1 file changed, 49 insertions(+), 35 deletions(-)
diff --git a/guix/build/gremlin.scm b/guix/build/gremlin.scm
index bb019967e..78d133311 100644
--- a/guix/build/gremlin.scm
+++ b/guix/build/gremlin.scm
@@ -99,10 +99,16 @@ dynamic linking information."
;; } d_un;
;; } Elf64_Dyn;
+(define-record-type <dynamic-entry>
+ (dynamic-entry type value offset)
+ dynamic-entry?
+ (type dynamic-entry-type) ;DT_*
+ (value dynamic-entry-value) ;string | number | ...
+ (offset dynamic-entry-offset)) ;integer
+
(define (raw-dynamic-entries elf segment)
- "Return as a list of type/value pairs all the dynamic entries found in
-SEGMENT, the 'PT_DYNAMIC' segment of ELF. In the result, each car is a DT_
-value, and the interpretation of the cdr depends on the type."
+ "Return as a list of <dynamic-entry> for the dynamic entries found in
+SEGMENT, the 'PT_DYNAMIC' segment of ELF."
(define start
(elf-segment-offset segment))
(define bytes
@@ -123,7 +129,9 @@ value, and the interpretation of the cdr depends on the type."
(if (= type DT_NULL) ;finished?
(reverse result)
(loop (+ offset (* 2 word-size))
- (alist-cons type value result)))))))
+ (cons (dynamic-entry type value
+ (+ start offset word-size))
+ result)))))))
(define (vma->offset elf vma)
"Convert VMA, a virtual memory address, to an offset within ELF.
@@ -148,35 +156,33 @@ offset."
(define (dynamic-entries elf segment)
"Return all the dynamic entries found in SEGMENT, the 'PT_DYNAMIC' segment
-of ELF, as a list of type/value pairs. The type is a DT_ value, and the value
-may be a string or an integer depending on the entry type (for instance, the
-value of DT_NEEDED entries is a string.)"
+of ELF, as a list of <dynamic-entry>. The value of each entry may be a string
+or an integer depending on the entry type (for instance, the value of
+DT_NEEDED entries is a string.) Likewise the offset is the offset within the
+string table if the type is a string."
(define entries
(raw-dynamic-entries elf segment))
(define string-table-offset
- (any (match-lambda
- ((type . value)
- (and (= type DT_STRTAB) value))
- (_ #f))
+ (any (lambda (entry)
+ (and (= (dynamic-entry-type entry) DT_STRTAB)
+ (dynamic-entry-value entry)))
entries))
- (define (interpret-dynamic-entry type value)
- (cond ((memv type (list DT_NEEDED DT_SONAME DT_RPATH DT_RUNPATH))
- (if string-table-offset
- (pointer->string
- (bytevector->pointer (elf-bytes elf)
- (vma->offset
- elf
- (+ string-table-offset value))))
- value))
- (else
- value)))
+ (define (interpret-dynamic-entry entry)
+ (let ((type (dynamic-entry-type entry))
+ (value (dynamic-entry-value entry)))
+ (cond ((memv type (list DT_NEEDED DT_SONAME DT_RPATH DT_RUNPATH))
+ (if string-table-offset
+ (let* ((offset (vma->offset elf (+ string-table-offset value)))
+ (value (pointer->string
+ (bytevector->pointer (elf-bytes elf) offset))))
+ (dynamic-entry type value offset))
+ (dynamic-entry type value (dynamic-entry-offset entry))))
+ (else
+ (dynamic-entry type value (dynamic-entry-offset entry))))))
- (map (match-lambda
- ((type . value)
- (cons type (interpret-dynamic-entry type value))))
- entries))
+ (map interpret-dynamic-entry entries))
\f
;;;
@@ -200,21 +206,29 @@ value of DT_NEEDED entries is a string.)"
(define (elf-dynamic-info elf)
"Return dynamic-link information for ELF as an <elf-dynamic-info> object, or
#f if ELF lacks dynamic-link information."
+ (define (matching-entry type)
+ (lambda (entry)
+ (= type (dynamic-entry-type entry))))
+
(match (dynamic-link-segment elf)
(#f #f)
((? elf-segment? dynamic)
(let ((entries (dynamic-entries elf dynamic)))
- (%elf-dynamic-info (assv-ref entries DT_SONAME)
- (filter-map (match-lambda
- ((type . value)
- (and (= type DT_NEEDED) value))
- (_ #f))
+ (%elf-dynamic-info (find (matching-entry DT_SONAME) entries)
+ (filter-map (lambda (entry)
+ (and (= (dynamic-entry-type entry)
+ DT_NEEDED)
+ (dynamic-entry-value entry)))
entries)
- (or (and=> (assv-ref entries DT_RPATH)
- search-path->list)
+ (or (and=> (find (matching-entry DT_RPATH)
+ entries)
+ (compose search-path->list
+ dynamic-entry-value))
'())
- (or (and=> (assv-ref entries DT_RUNPATH)
- search-path->list)
+ (or (and=> (find (matching-entry DT_RUNPATH)
+ entries)
+ (compose search-path->list
+ dynamic-entry-value))
'()))))))
(define %libc-libraries
--
2.17.0
next prev parent reply other threads:[~2018-04-18 16:42 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-04-18 16:38 [bug#31208] [PATCH 0/3] Add 'strip-runpath' in (guix build gremlin) Ludovic Courtès
2018-04-18 16:40 ` Ludovic Courtès [this message]
2018-04-18 16:40 ` [bug#31208] [PATCH 2/3] gremlin: Add 'strip-runpath' Ludovic Courtès
2018-04-18 16:40 ` [bug#31208] [PATCH 3/3] build-system/meson: Use 'strip-runpath' instead of PatchELF Ludovic Courtès
2018-05-04 20:52 ` [bug#31208] [PATCH 0/3] Add 'strip-runpath' in (guix build gremlin) Ludovic Courtès
[not found] ` <CADh9keX7zyDOoNFstawVKdinxNOMKfff3jQuZUOvxFDawZP9Hw@mail.gmail.com>
2018-05-05 20:02 ` Ludovic Courtès
2018-05-07 9:24 ` bug#31208: " Ludovic Courtès
2018-05-07 9:32 ` [bug#31208] " 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=20180418164054.29979-1-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=31208@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).