gremlin: Preserve offset info for dynamic entries.

* 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.
This commit is contained in:
Ludovic Courtès 2018-04-17 12:32:56 +02:00
parent 3cc9a8a132
commit ad4835fe01
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 49 additions and 35 deletions

View File

@ -99,10 +99,16 @@ dynamic linking information."
;; } d_un; ;; } d_un;
;; } Elf64_Dyn; ;; } 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) (define (raw-dynamic-entries elf segment)
"Return as a list of type/value pairs all the dynamic entries found in "Return as a list of <dynamic-entry> for the dynamic entries found in
SEGMENT, the 'PT_DYNAMIC' segment of ELF. In the result, each car is a DT_ SEGMENT, the 'PT_DYNAMIC' segment of ELF."
value, and the interpretation of the cdr depends on the type."
(define start (define start
(elf-segment-offset segment)) (elf-segment-offset segment))
(define bytes (define bytes
@ -123,7 +129,9 @@ value, and the interpretation of the cdr depends on the type."
(if (= type DT_NULL) ;finished? (if (= type DT_NULL) ;finished?
(reverse result) (reverse result)
(loop (+ offset (* 2 word-size)) (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) (define (vma->offset elf vma)
"Convert VMA, a virtual memory address, to an offset within ELF. "Convert VMA, a virtual memory address, to an offset within ELF.
@ -148,35 +156,33 @@ offset."
(define (dynamic-entries elf segment) (define (dynamic-entries elf segment)
"Return all the dynamic entries found in SEGMENT, the 'PT_DYNAMIC' 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 of ELF, as a list of <dynamic-entry>. The value of each entry may be a string
may be a string or an integer depending on the entry type (for instance, the or an integer depending on the entry type (for instance, the value of
value of DT_NEEDED entries is a string.)" DT_NEEDED entries is a string.) Likewise the offset is the offset within the
string table if the type is a string."
(define entries (define entries
(raw-dynamic-entries elf segment)) (raw-dynamic-entries elf segment))
(define string-table-offset (define string-table-offset
(any (match-lambda (any (lambda (entry)
((type . value) (and (= (dynamic-entry-type entry) DT_STRTAB)
(and (= type DT_STRTAB) value)) (dynamic-entry-value entry)))
(_ #f))
entries)) entries))
(define (interpret-dynamic-entry type value) (define (interpret-dynamic-entry entry)
(cond ((memv type (list DT_NEEDED DT_SONAME DT_RPATH DT_RUNPATH)) (let ((type (dynamic-entry-type entry))
(if string-table-offset (value (dynamic-entry-value entry)))
(pointer->string (cond ((memv type (list DT_NEEDED DT_SONAME DT_RPATH DT_RUNPATH))
(bytevector->pointer (elf-bytes elf) (if string-table-offset
(vma->offset (let* ((offset (vma->offset elf (+ string-table-offset value)))
elf (value (pointer->string
(+ string-table-offset value)))) (bytevector->pointer (elf-bytes elf) offset))))
value)) (dynamic-entry type value offset))
(else (dynamic-entry type value (dynamic-entry-offset entry))))
value))) (else
(dynamic-entry type value (dynamic-entry-offset entry))))))
(map (match-lambda (map interpret-dynamic-entry entries))
((type . value)
(cons type (interpret-dynamic-entry type value))))
entries))
;;; ;;;
@ -200,21 +206,29 @@ value of DT_NEEDED entries is a string.)"
(define (elf-dynamic-info elf) (define (elf-dynamic-info elf)
"Return dynamic-link information for ELF as an <elf-dynamic-info> object, or "Return dynamic-link information for ELF as an <elf-dynamic-info> object, or
#f if ELF lacks dynamic-link information." #f if ELF lacks dynamic-link information."
(define (matching-entry type)
(lambda (entry)
(= type (dynamic-entry-type entry))))
(match (dynamic-link-segment elf) (match (dynamic-link-segment elf)
(#f #f) (#f #f)
((? elf-segment? dynamic) ((? elf-segment? dynamic)
(let ((entries (dynamic-entries elf dynamic))) (let ((entries (dynamic-entries elf dynamic)))
(%elf-dynamic-info (assv-ref entries DT_SONAME) (%elf-dynamic-info (find (matching-entry DT_SONAME) entries)
(filter-map (match-lambda (filter-map (lambda (entry)
((type . value) (and (= (dynamic-entry-type entry)
(and (= type DT_NEEDED) value)) DT_NEEDED)
(_ #f)) (dynamic-entry-value entry)))
entries) entries)
(or (and=> (assv-ref entries DT_RPATH) (or (and=> (find (matching-entry DT_RPATH)
search-path->list) entries)
(compose search-path->list
dynamic-entry-value))
'()) '())
(or (and=> (assv-ref entries DT_RUNPATH) (or (and=> (find (matching-entry DT_RUNPATH)
search-path->list) entries)
(compose search-path->list
dynamic-entry-value))
'())))))) '()))))))
(define %libc-libraries (define %libc-libraries