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:
parent
3cc9a8a132
commit
ad4835fe01
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue