futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ld-wrapper: Compute the library search path globally.

Browse Source 
Fixes <http://bugs.gnu.org/21941>.

* gnu/packages/ld-wrapper.in (library-search-path): New procedure.
(library-files-linked): Add 'library-path' parameter.  Use it.  Do not
thread it in 'fold'.
(ld-wrapper): Add call to 'library-search-path' and pass the result to
'library-files-linked'.  When debugging, print the value of PATH.
This commit is contained in:
Ludovic Courtès 2015-11-28 22:06:31 +01:00
parent 90c59e970e
commit e946b609b2
1 changed files with 39 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
gnu/packages/ld-wrapper.in
View File

@ -137,52 +137,61 @@ exec @GUILE@ -c "(load-compiled \"@SELF@.go\") (apply $main (cdr (command-line))
(string-every (char-set-union (char-set #\.) char-set:digit) (string-every (char-set-union (char-set #\.) char-set:digit)
(string-drop file (+ index 3))))))) (string-drop file (+ index 3)))))))
(define (library-files-linked args) (define (library-search-path args)
;; Return the file names of shared libraries explicitly linked against via ;; Return the library search path as a list of directory names. The GNU ld
;; `-l' or with an absolute file name in ARGS. ;; manual notes that "[a]ll `-L' options apply to all `-l' options,
(define path+files+args ;; regardless of the order in which the options appear", so we must compute
;; the search path independently of the -l options.
(let loop ((args args)
(path '()))
(match args
(()
(reverse path))
(("-L" directory . rest)
(loop rest (cons directory path)))
((argument . rest)
(if (string-prefix? "-L" argument) ;augment the search path
(loop rest
(cons (string-drop argument 2) path))
(loop rest path))))))
(define (library-files-linked args library-path)
;; Return the absolute file names of shared libraries explicitly linked
;; against via `-l' or with an absolute file name in ARGS, looking them up
;; in LIBRARY-PATH.
(define files+args
(fold (lambda (argument result) (fold (lambda (argument result)
(match result (match result
((library-path library-files ((library-files ((and flag
((and flag
(or "-dynamic-linker" "-plugin")) (or "-dynamic-linker" "-plugin"))
. rest)) . rest))
;; When passed '-dynamic-linker ld.so', ignore 'ld.so'; when ;; When passed '-dynamic-linker ld.so', ignore 'ld.so'; when
;; passed '-plugin liblto_plugin.so', ignore ;; passed '-plugin liblto_plugin.so', ignore
;; 'liblto_plugin.so'. See <http://bugs.gnu.org/20102>. ;; 'liblto_plugin.so'. See <http://bugs.gnu.org/20102>.
(list library-path (list library-files
library-files
(cons* argument flag rest))) (cons* argument flag rest)))
((library-path library-files previous-args) ((library-files previous-args)
(cond ((string-prefix? "-L" argument) ;augment the search path (cond ((string-prefix? "-l" argument) ;add library
(list (append library-path
(list (string-drop argument 2)))
library-files
(cons argument previous-args)))
((string-prefix? "-l" argument) ;add library
(let* ((lib (string-append "lib" (let* ((lib (string-append "lib"
(string-drop argument 2) (string-drop argument 2)
".so")) ".so"))
(full (search-path library-path lib))) (full (search-path library-path lib)))
(list library-path (list (if full
(if full
(cons full library-files) (cons full library-files)
library-files) library-files)
(cons argument previous-args)))) (cons argument previous-args))))
((and (string-prefix? %store-directory argument) ((and (string-prefix? %store-directory argument)
(shared-library? argument)) ;add library (shared-library? argument)) ;add library
(list library-path (list (cons argument library-files)
(cons argument library-files)
(cons argument previous-args))) (cons argument previous-args)))
(else (else
(list library-path (list library-files
library-files
(cons argument previous-args))))))) (cons argument previous-args)))))))
(list '() '() '()) (list '() '())
args)) args))
(match path+files+args (match files+args
((path files arguments) ((files arguments)
(reverse files)))) (reverse files))))
(define (rpath-arguments library-files) (define (rpath-arguments library-files)
@ -211,9 +220,12 @@ impure library ~s~%"
(define (ld-wrapper . args) (define (ld-wrapper . args)
;; Invoke the real `ld' with ARGS, augmented with `-rpath' switches. ;; Invoke the real `ld' with ARGS, augmented with `-rpath' switches.
(let* ((libs (library-files-linked args)) (let* ((path (library-search-path args))
(libs (library-files-linked args path))
(args (append args (rpath-arguments libs)))) (args (append args (rpath-arguments libs))))
(when %debug? (when %debug?
(format (current-error-port)
"ld-wrapper: library search path: ~s~%" path)
(format (current-error-port) (format (current-error-port)
"ld-wrapper: libraries linked: ~s~%" libs) "ld-wrapper: libraries linked: ~s~%" libs)
(format (current-error-port) (format (current-error-port)