From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:58991) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1f8q9j-0004M5-T3 for guix-patches@gnu.org; Wed, 18 Apr 2018 12:42:05 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1f8q9i-0003j7-Jw for guix-patches@gnu.org; Wed, 18 Apr 2018 12:42:03 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:51617) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1f8q9i-0003iy-FG for guix-patches@gnu.org; Wed, 18 Apr 2018 12:42:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1f8q9i-00027p-1J for guix-patches@gnu.org; Wed, 18 Apr 2018 12:42:02 -0400 Subject: [bug#31208] [PATCH 1/3] gremlin: Preserve offset info for dynamic entries. References: <20180418163842.29823-1-ludo@gnu.org> In-Reply-To: <20180418163842.29823-1-ludo@gnu.org> Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Wed, 18 Apr 2018 18:40:52 +0200 Message-Id: <20180418164054.29979-1-ludo@gnu.org> List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 31208@debbugs.gnu.org * guix/build/gremlin.scm (): New record type. (raw-dynamic-entries): Return a list of . (dynamic-entries): Adjust accordingly and return a list of . (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 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 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 . 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)) ;;; @@ -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 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