From cbbb11c8a00c64cb24081025239f77208661b961 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 21 Apr 2015 21:07:11 +0200 Subject: gnu: Rename ld-wrapper2 to ld-wrapper. * gnu/packages/ld-wrapper2.in: Rename to... * gnu/packages/ld-wrapper.in: ... this. * gnu-system.am (MISC_DISTRO_FILES): Remove ld-wrapper2.in. * gnu/packages/commencement.scm (fixed-ld-wrapper): Remove. (gcc-toolchain): Restore pre-77db91ad inputs. --- gnu/packages/ld-wrapper.in | 48 ++++++++++++++++++++++------------------------ 1 file changed, 23 insertions(+), 25 deletions(-) (limited to 'gnu/packages/ld-wrapper.in') diff --git a/gnu/packages/ld-wrapper.in b/gnu/packages/ld-wrapper.in index 094018de3d..f4ab17c59f 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. -- cgit v1.2.3 From 4267c637d63ac7c48fe8206623ca976fc0dd742a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 21 Apr 2015 21:08:44 +0200 Subject: gnu: ld-wrapper: Add debugging info. * gnu/packages/ld-wrapper.in (ld-wrapper): Add "libraries linked" debugging statement. --- gnu/packages/ld-wrapper.in | 2 ++ 1 file changed, 2 insertions(+) (limited to 'gnu/packages/ld-wrapper.in') diff --git a/gnu/packages/ld-wrapper.in b/gnu/packages/ld-wrapper.in index f4ab17c59f..ed2a51ea67 100644 --- a/gnu/packages/ld-wrapper.in +++ b/gnu/packages/ld-wrapper.in @@ -199,6 +199,8 @@ impure library ~s~%" (let* ((libs (library-files-linked args)) (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)) -- cgit v1.2.3 From 4a2b74bf4ce6780bb284bbcc63d3548233b09ee6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 21 Apr 2015 21:14:28 +0200 Subject: gnu: ld-wrapper: Ignore the .so argument following '-dynamic-linker'. Reported at . * gnu/packages/ld-wrapper.in (library-files-linked): Rename 'path+files' to 'path+files+args'. Thread the reverse list of previous arguments. Add case for when the previous argument is "-dynamic-linker". --- gnu/packages/ld-wrapper.in | 39 +++++++++++++++++++++++++-------------- 1 file changed, 25 insertions(+), 14 deletions(-) (limited to 'gnu/packages/ld-wrapper.in') diff --git a/gnu/packages/ld-wrapper.in b/gnu/packages/ld-wrapper.in index ed2a51ea67..db662e7d76 100644 --- a/gnu/packages/ld-wrapper.in +++ b/gnu/packages/ld-wrapper.in @@ -140,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 . + (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) -- cgit v1.2.3