GNU bug report logs - #31208
[PATCH 0/3] Add 'strip-runpath' in (guix build gremlin)

Previous Next

Package: guix-patches;

Reported by: Ludovic Courtès <ludo <at> gnu.org>

Date: Wed, 18 Apr 2018 16:40:02 UTC

Severity: normal

Tags: patch

Done: ludo <at> gnu.org (Ludovic Courtès)

Bug is archived. No further changes may be made.

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 31208 in the body.
You can then email your comments to 31208 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

View this report as an mbox folder, status mbox, maintainer mbox


Report forwarded to guix-patches <at> gnu.org:
bug#31208; Package guix-patches. (Wed, 18 Apr 2018 16:40:02 GMT) Full text and rfc822 format available.

Acknowledgement sent to Ludovic Courtès <ludo <at> gnu.org>:
New bug report received and forwarded. Copy sent to guix-patches <at> gnu.org. (Wed, 18 Apr 2018 16:40:02 GMT) Full text and rfc822 format available.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: guix-patches <at> gnu.org
Cc: Marius Bakke <mbakke <at> fastmail.com>,
 Ludovic Courtès <ludo <at> gnu.org>,
 Peter Mikkelsen <petermikkelsen10 <at> gmail.com>
Subject: [PATCH 0/3] Add 'strip-runpath' in (guix build gremlin)
Date: Wed, 18 Apr 2018 18:38:42 +0200
Hello!

As discussed before, this patch set is a first stab at getting rid of
PatchELF (which has portability issues) in particular in the Meson build
system.  (The patches are for the next ‘core-updates’.)

The second patch adds ‘strip-runpath’.  It doesn’t add ‘augment-rpath’
though, because that’s a bit more involved (it needs to grow the string
table and the section it’s in), and so I wanted to make sure we really
need it first.  :-)

In the discussion of ‘meson-build-system’ in
<https://debbugs.gnu.org/cgi/bugreport.cgi?bug=28444>, we didn’t discuss
this specific part.  Peter & Marius: can you explain whether/why this is
needed?

Thanks,
Ludo’.

Ludovic Courtès (3):
  gremlin: Preserve offset info for dynamic entries.
  gremlin: Add 'strip-runpath'.
  build-system/meson: Use 'strip-runpath' instead of PatchELF.

 guix/build/gremlin.scm            | 130 +++++++++++++++++++++---------
 guix/build/meson-build-system.scm |   2 +-
 tests/gremlin.scm                 |  35 +++++++-
 3 files changed, 129 insertions(+), 38 deletions(-)

-- 
2.17.0





Information forwarded to guix-patches <at> gnu.org:
bug#31208; Package guix-patches. (Wed, 18 Apr 2018 16:42:02 GMT) Full text and rfc822 format available.

Message #8 received at 31208 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 31208 <at> debbugs.gnu.org
Cc: Marius Bakke <mbakke <at> fastmail.com>,
 Ludovic Courtès <ludo <at> gnu.org>,
 Peter Mikkelsen <petermikkelsen10 <at> gmail.com>
Subject: [PATCH 1/3] gremlin: Preserve offset info for dynamic entries.
Date: Wed, 18 Apr 2018 18:40:52 +0200
* 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))
 
 
 ;;;
@@ -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





Information forwarded to guix-patches <at> gnu.org:
bug#31208; Package guix-patches. (Wed, 18 Apr 2018 16:42:02 GMT) Full text and rfc822 format available.

Message #11 received at 31208 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 31208 <at> debbugs.gnu.org
Cc: Marius Bakke <mbakke <at> fastmail.com>,
 Ludovic Courtès <ludo <at> gnu.org>,
 Peter Mikkelsen <petermikkelsen10 <at> gmail.com>
Subject: [PATCH 2/3] gremlin: Add 'strip-runpath'.
Date: Wed, 18 Apr 2018 18:40:53 +0200
* guix/build/gremlin.scm (strip-runpath): New procedure.
* tests/gremlin.scm (c-compiler): New variable.
("strip-runpath"): New test.
---
 guix/build/gremlin.scm | 46 +++++++++++++++++++++++++++++++++++++++++-
 tests/gremlin.scm      | 35 +++++++++++++++++++++++++++++++-
 2 files changed, 79 insertions(+), 2 deletions(-)

diff --git a/guix/build/gremlin.scm b/guix/build/gremlin.scm
index 78d133311..e8ea66dfb 100644
--- a/guix/build/gremlin.scm
+++ b/guix/build/gremlin.scm
@@ -41,7 +41,8 @@
             elf-dynamic-info-runpath
             expand-origin
 
-            validate-needed-in-runpath))
+            validate-needed-in-runpath
+            strip-runpath))
 
 ;;; Commentary:
 ;;;
@@ -320,4 +321,47 @@ be found in RUNPATH ~s~%"
           ;;   (format (current-error-port) "~a is OK~%" file))
           (null? not-found))))))
 
+(define (strip-runpath file)
+  "Remove from the DT_RUNPATH of FILE any entries that are not necessary
+according to DT_NEEDED."
+  (define (minimal-runpath needed runpath)
+    (filter (lambda (directory)
+              (and (string-prefix? "/" directory)
+                   (any (lambda (lib)
+                          (file-exists? (string-append directory "/" lib)))
+                        needed)))
+            runpath))
+
+  (define port
+    (open-file file "r+b"))
+
+  (catch #t
+    (lambda ()
+      (let* ((elf      (parse-elf (get-bytevector-all port)))
+             (entries  (dynamic-entries elf (dynamic-link-segment elf)))
+             (needed   (filter-map (lambda (entry)
+                                     (and (= (dynamic-entry-type entry)
+                                             DT_NEEDED)
+                                          (dynamic-entry-value entry)))
+                                   entries))
+             (runpath  (find (lambda (entry)
+                               (= DT_RUNPATH (dynamic-entry-type entry)))
+                             entries))
+             (old      (search-path->list
+                        (dynamic-entry-value runpath)))
+             (new      (minimal-runpath needed old)))
+        (unless (equal? old new)
+          (format (current-error-port)
+                  "~a: stripping RUNPATH to ~s (removed ~s)~%"
+                  file new
+                  (lset-difference string=? old new))
+          (seek port (dynamic-entry-offset runpath) SEEK_SET)
+          (put-bytevector port (string->utf8 (string-join new ":")))
+          (put-u8 port 0))
+        (close-port port)
+        new))
+    (lambda (key . args)
+      (false-if-exception (close-port port))
+      (apply throw key args))))
+
 ;;; gremlin.scm ends here
diff --git a/tests/gremlin.scm b/tests/gremlin.scm
index 288555496..1b47d5c38 100644
--- a/tests/gremlin.scm
+++ b/tests/gremlin.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2015, 2018 Ludovic Courtès <ludo <at> gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,12 +18,14 @@
 
 (define-module (test-gremlin)
   #:use-module (guix elf)
+  #:use-module ((guix utils) #:select (call-with-temporary-directory))
   #:use-module (guix build utils)
   #:use-module (guix build gremlin)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-64)
   #:use-module (rnrs io ports)
+  #:use-module (ice-9 popen)
   #:use-module (ice-9 match))
 
 (define %guile-executable
@@ -37,6 +39,9 @@
 (define read-elf
   (compose parse-elf get-bytevector-all))
 
+(define c-compiler
+  (or (which "gcc") (which "cc") (which "g++")))
+
 
 (test-begin "gremlin")
 
@@ -63,4 +68,32 @@
          "../${ORIGIN}/bar/$ORIGIN/baz"
          "ORIGIN/foo")))
 
+(unless c-compiler
+  (test-skip 1))
+(test-equal "strip-runpath"
+  "hello\n"
+  (call-with-temporary-directory
+   (lambda (directory)
+     (with-directory-excursion directory
+       (call-with-output-file "t.c"
+         (lambda (port)
+           (display "int main () { puts(\"hello\"); }" port)))
+       (invoke c-compiler "t.c"
+               "-Wl,-rpath=/foo" "-Wl,-rpath=/bar")
+       (let* ((dyninfo (elf-dynamic-info
+                        (parse-elf (call-with-input-file "a.out"
+                                     get-bytevector-all))))
+              (old     (elf-dynamic-info-runpath dyninfo))
+              (new     (strip-runpath "a.out"))
+              (new*    (strip-runpath "a.out")))
+         (validate-needed-in-runpath "a.out")
+         (and (member "/foo" old) (member "/bar" old)
+              (not (member "/foo" new))
+              (not (member "/bar" new))
+              (equal? new* new)
+              (let* ((pipe (open-input-pipe "./a.out"))
+                     (str  (get-string-all pipe)))
+                (close-pipe pipe)
+                str)))))))
+
 (test-end "gremlin")
-- 
2.17.0





Information forwarded to guix-patches <at> gnu.org:
bug#31208; Package guix-patches. (Wed, 18 Apr 2018 16:42:03 GMT) Full text and rfc822 format available.

Message #14 received at 31208 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 31208 <at> debbugs.gnu.org
Cc: Marius Bakke <mbakke <at> fastmail.com>,
 Ludovic Courtès <ludo <at> gnu.org>,
 Peter Mikkelsen <petermikkelsen10 <at> gmail.com>
Subject: [PATCH 3/3] build-system/meson: Use 'strip-runpath' instead of
 PatchELF.
Date: Wed, 18 Apr 2018 18:40:54 +0200
* guix/build/meson-build-system.scm (fix-runpath): Call 'strip-runpath'
instead of invoking 'patchelf'.
---
 guix/build/meson-build-system.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/guix/build/meson-build-system.scm b/guix/build/meson-build-system.scm
index e8cb5440e..793cc32e7 100644
--- a/guix/build/meson-build-system.scm
+++ b/guix/build/meson-build-system.scm
@@ -134,7 +134,7 @@ for example libraries only needed for the tests."
                                             (find-files dir elf-pred))
                                           existing-elf-dirs))))
          (for-each (lambda (elf-file)
-                     (system* "patchelf" "--shrink-rpath" elf-file)
+                     (strip-runpath elf-file)
                      (handle-file elf-file elf-list))
                    elf-list)))))
   (for-each handle-output outputs)
-- 
2.17.0





Information forwarded to guix-patches <at> gnu.org:
bug#31208; Package guix-patches. (Fri, 04 May 2018 20:53:02 GMT) Full text and rfc822 format available.

Message #17 received at 31208 <at> debbugs.gnu.org (full text, mbox):

From: ludo <at> gnu.org (Ludovic Courtès)
To: 31208 <at> debbugs.gnu.org
Cc: Marius Bakke <mbakke <at> fastmail.com>,
 Peter Mikkelsen <petermikkelsen10 <at> gmail.com>
Subject: Re: [bug#31208] [PATCH 0/3] Add 'strip-runpath' in (guix build
 gremlin)
Date: Fri, 04 May 2018 22:52:47 +0200
Ping!  :-)

Ludovic Courtès <ludo <at> gnu.org> skribis:

> Hello!
>
> As discussed before, this patch set is a first stab at getting rid of
> PatchELF (which has portability issues) in particular in the Meson build
> system.  (The patches are for the next ‘core-updates’.)
>
> The second patch adds ‘strip-runpath’.  It doesn’t add ‘augment-rpath’
> though, because that’s a bit more involved (it needs to grow the string
> table and the section it’s in), and so I wanted to make sure we really
> need it first.  :-)
>
> In the discussion of ‘meson-build-system’ in
> <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=28444>, we didn’t discuss
> this specific part.  Peter & Marius: can you explain whether/why this is
> needed?
>
> Thanks,
> Ludo’.
>
> Ludovic Courtès (3):
>   gremlin: Preserve offset info for dynamic entries.
>   gremlin: Add 'strip-runpath'.
>   build-system/meson: Use 'strip-runpath' instead of PatchELF.
>
>  guix/build/gremlin.scm            | 130 +++++++++++++++++++++---------
>  guix/build/meson-build-system.scm |   2 +-
>  tests/gremlin.scm                 |  35 +++++++-
>  3 files changed, 129 insertions(+), 38 deletions(-)




Information forwarded to guix-patches <at> gnu.org:
bug#31208; Package guix-patches. (Sat, 05 May 2018 20:03:02 GMT) Full text and rfc822 format available.

Message #20 received at 31208 <at> debbugs.gnu.org (full text, mbox):

From: ludo <at> gnu.org (Ludovic Courtès)
To: Peter Mikkelsen <petermikkelsen10 <at> gmail.com>
Cc: Marius Bakke <mbakke <at> fastmail.com>, 31208 <at> debbugs.gnu.org
Subject: Re: [bug#31208] [PATCH 0/3] Add 'strip-runpath' in (guix build
 gremlin)
Date: Sat, 05 May 2018 22:02:28 +0200
Hello Peter,

(I’m re-adding Cc, hope you don’t mind.)

Peter Mikkelsen <petermikkelsen10 <at> gmail.com> skribis:

> Since I am not really that much into meson, I am not sure my answer
> will be enough, but I will give it a go:
> The augment-rpath is needed because in some software projects such as
> nautilus, there is both a library and an executable.
> When building the software, the library is built first, and then the
> executable which depends on it, but then the runpath of the executable
> is 'fixed' so
> that libnautilus is no longer in the runpath of the nautilus binary.
> This is a problem since libnautilus is needed at runtime, so it is
> added using augment-rpath.

Oh, I see.

Back to this patch series, it means we still need ‘augment-rpath’.  :-/
I suppose we can still apply these patches to ‘core-updates-next’
though, it’s a step in the right direction.

> I think I remember something about the meson developers saying that it
> is no problem, since libnautilus will be installed in a standard
> location or something,
> but I really don't remember, sorry..

What Libtool does is that it “relinks” executables upon “make install”
so that they have the correct RUNPATH.

> Sorry for the not so good reply, but I hope it makes a little bit sense :)

It makes a lot of sense yes, thank you!

Ludo’.




Reply sent to ludo <at> gnu.org (Ludovic Courtès):
You have taken responsibility. (Mon, 07 May 2018 09:25:02 GMT) Full text and rfc822 format available.

Notification sent to Ludovic Courtès <ludo <at> gnu.org>:
bug acknowledged by developer. (Mon, 07 May 2018 09:25:02 GMT) Full text and rfc822 format available.

Message #25 received at 31208-done <at> debbugs.gnu.org (full text, mbox):

From: ludo <at> gnu.org (Ludovic Courtès)
To: Peter Mikkelsen <petermikkelsen10 <at> gmail.com>
Cc: Marius Bakke <mbakke <at> fastmail.com>, 31208-done <at> debbugs.gnu.org
Subject: Re: [bug#31208] [PATCH 0/3] Add 'strip-runpath' in (guix build
 gremlin)
Date: Mon, 07 May 2018 11:24:33 +0200
ludo <at> gnu.org (Ludovic Courtès) skribis:

> Back to this patch series, it means we still need ‘augment-rpath’.  :-/
> I suppose we can still apply these patches to ‘core-updates-next’
> though, it’s a step in the right direction.

Done!

Ludo’.




Information forwarded to guix-patches <at> gnu.org:
bug#31208; Package guix-patches. (Mon, 07 May 2018 09:33:02 GMT) Full text and rfc822 format available.

Message #28 received at 31208 <at> debbugs.gnu.org (full text, mbox):

From: ludo <at> gnu.org (Ludovic Courtès)
To: Peter Mikkelsen <petermikkelsen10 <at> gmail.com>
Cc: Marius Bakke <mbakke <at> fastmail.com>, 31208 <at> debbugs.gnu.org
Subject: Re: [bug#31208] [PATCH 0/3] Add 'strip-runpath' in (guix build
 gremlin)
Date: Mon, 07 May 2018 11:32:31 +0200
ludo <at> gnu.org (Ludovic Courtès) skribis:

> Peter Mikkelsen <petermikkelsen10 <at> gmail.com> skribis:

[...]

>> I think I remember something about the meson developers saying that it
>> is no problem, since libnautilus will be installed in a standard
>> location or something,
>> but I really don't remember, sorry..
>
> What Libtool does is that it “relinks” executables upon “make install”
> so that they have the correct RUNPATH.

I found this issue, which mentions the problem:

  https://github.com/mesonbuild/meson/issues/2121#issuecomment-377971590

It’s a pity this isn’t properly solved.  :-/

Ludo’.




bug archived. Request was from Debbugs Internal Request <help-debbugs <at> gnu.org> to internal_control <at> debbugs.gnu.org. (Mon, 04 Jun 2018 11:24:04 GMT) Full text and rfc822 format available.

This bug report was last modified 5 years and 300 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.