ld-wrapper: Compute the library search path globally.
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:
parent
90c59e970e
commit
e946b609b2
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue