1 files changed, 50 insertions, 39 deletions

diff --git a/gnu/packages/ld-wrapper.in b/gnu/packages/ld-wrapper.in
index 094018de3d..db662e7d76 100644
--- a/gnu/packages/ld-wrapper.in
+++ b/gnu/packages/ld-wrapper.in
@@ -92,34 +92,32 @@ exec @GUILE@ -c "(load-compiled \"@SELF@.go\") (apply $main (cdr (command-line))
 
   (let loop ((file  file)
              (depth 0))
-    (catch 'system-error
-      (lambda ()
-        (if (>= depth %max-symlink-depth)
-            file
-            (loop (readlink file) (+ depth 1))))
-      (lambda args
-        (if (= EINVAL (system-error-errno args))
-            file
-            (apply throw args))))))
-
-(define (dereference-symlinks file)
-  ;; Same as 'readlink*' but return FILE if the symlink target is invalid or
-  ;; FILE does not exist.
-  (catch 'system-error
-    (lambda ()
-      ;; When used from a user environment, FILE may refer to
-      ;; ~/.guix-profile/lib/libfoo.so, which is itself a symlink to the
-      ;; store.  Check whether this is the case.
-      (readlink* file))
-    (lambda args
-      (if (= ENOENT (system-error-errno args))
-          file
-          (apply throw args)))))
+    (define (absolute target)
+      (if (absolute-file-name? target)
+          target
+          (string-append (dirname file) "/" target)))
+
+    (if (>= depth %max-symlink-depth)
+        file
+        (call-with-values
+            (lambda ()
+              (catch 'system-error
+                (lambda ()
+                  (values #t (readlink file)))
+                (lambda args
+                  (let ((errno (system-error-errno args)))
+                    (if (or (= errno EINVAL) (= errno ENOENT))
+                        (values #f file)
+                        (apply throw args))))))
+          (lambda (success? target)
+            (if success?
+                (loop (absolute target) (+ depth 1))
+                file))))))
 
 (define (pure-file-name? file)
   ;; Return #t when FILE is the name of a file either within the store
   ;; (possibly via a symlink) or within the build directory.
-  (let ((file (dereference-symlinks file)))
+  (let ((file (readlink* file)))
     (or (not (string-prefix? "/" file))
         (string-prefix? %store-directory file)
         (string-prefix? %temporary-directory file)
@@ -128,7 +126,7 @@ exec @GUILE@ -c "(load-compiled \"@SELF@.go\") (apply $main (cdr (command-line))
 
 (define (store-file-name? file)
   ;; Return #t when FILE is a store file, possibly indirectly.
-  (string-prefix? %store-directory (dereference-symlinks file)))
+  (string-prefix? %store-directory (readlink* file)))
 
 (define (shared-library? file)
   ;; Return #t when FILE denotes a shared library.
@@ -142,34 +140,45 @@ exec @GUILE@ -c "(load-compiled \"@SELF@.go\") (apply $main (cdr (command-line))
 (define (library-files-linked args)
   ;; Return the file names of shared libraries explicitly linked against via
   ;; `-l' or with an absolute file name in ARGS.
-  (define path+files
+  (define path+files+args
     (fold (lambda (argument result)
             (match result
-              ((library-path . library-files)
+              ((library-path library-files ("-dynamic-linker" . rest))
+               ;; When passed '-dynamic-linker ld.so', ignore 'ld.so'.
+               ;; See <http://bugs.gnu.org/20102>.
+               (list library-path
+                     library-files
+                     (cons* argument "-dynamic-linker" rest)))
+              ((library-path library-files previous-args)
                (cond ((string-prefix? "-L" argument) ;augment the search path
-                      (cons (append library-path
+                      (list (append library-path
                                     (list (string-drop argument 2)))
-                            library-files))
+                            library-files
+                            (cons argument previous-args)))
                      ((string-prefix? "-l" argument) ;add library
                       (let* ((lib  (string-append "lib"
                                                   (string-drop argument 2)
                                                   ".so"))
                              (full (search-path library-path lib)))
-                        (if full
-                            (cons library-path
-                                  (cons full library-files))
-                            result)))
+                        (list library-path
+                              (if full
+                                  (cons full library-files)
+                                  library-files)
+                              (cons argument previous-args))))
                      ((and (string-prefix? %store-directory argument)
                            (shared-library? argument)) ;add library
-                      (cons library-path
-                            (cons argument library-files)))
+                      (list library-path
+                            (cons argument library-files)
+                            (cons argument previous-args)))
                      (else
-                      result)))))
-          (cons '() '())
+                      (list library-path
+                            library-files
+                            (cons argument previous-args)))))))
+          (list '() '() '())
           args))
 
-  (match path+files
-    ((path . files)
+  (match path+files+args
+    ((path files arguments)
      (reverse files))))
 
 (define (rpath-arguments library-files)
@@ -202,6 +211,8 @@ impure library ~s~%"
          (args (append args (rpath-arguments libs))))
     (when %debug?
       (format (current-error-port)
+              "ld-wrapper: libraries linked: ~s~%" libs)
+      (format (current-error-port)
               "ld-wrapper: invoking `~a' with ~s~%"
               %real-ld args))
     (apply execl %real-ld (basename %real-ld) args)))