diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-07-09 22:17:18 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-07-09 22:17:18 +0200 |
commit | c769406010156190c76c435c90d5f08ae56c2ca4 (patch) | |
tree | 1088a364c987cc6e7dc0bea4918cb498b34649b5 /gnu/packages/ld-wrapper.scm | |
parent | ee48b283fadca825ca08500eeb3870fd4141221e (diff) | |
parent | 91ef73d4642658829facee25ffdc91a48d6ccf73 (diff) | |
download | guix-patches-c769406010156190c76c435c90d5f08ae56c2ca4.tar guix-patches-c769406010156190c76c435c90d5f08ae56c2ca4.tar.gz |
Merge branch 'core-updates'
Diffstat (limited to 'gnu/packages/ld-wrapper.scm')
-rw-r--r-- | gnu/packages/ld-wrapper.scm | 29 |
1 files changed, 21 insertions, 8 deletions
diff --git a/gnu/packages/ld-wrapper.scm b/gnu/packages/ld-wrapper.scm index fd5a4cbd0c..41ff3df986 100644 --- a/gnu/packages/ld-wrapper.scm +++ b/gnu/packages/ld-wrapper.scm @@ -11,7 +11,7 @@ main="(@ (gnu build-support ld-wrapper) ld-wrapper)" exec @GUILE@ -c "(load-compiled \"$0.go\") (apply $main (cdr (command-line)))" "$@" !# ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -82,13 +82,26 @@ exec @GUILE@ -c "(load-compiled \"$0.go\") (apply $main (cdr (command-line)))" " (getenv "GUIX_LD_WRAPPER_DEBUG")) (define (pure-file-name? file) - ;; Return #t when FILE is the name of a file either within the store or - ;; within the build directory. - (or (not (string-prefix? "/" file)) - (string-prefix? %store-directory file) - (string-prefix? %temporary-directory file) - (and %build-directory - (string-prefix? %build-directory file)))) + ;; Return #t when FILE is the name of a file either within the store + ;; (possibly via a symlink) or within the build directory. + (define %max-symlink-depth 50) + + (let loop ((file file) + (depth 0)) + (or (not (string-prefix? "/" file)) + (string-prefix? %store-directory file) + (string-prefix? %temporary-directory file) + (if %build-directory + (string-prefix? %build-directory file) + + ;; 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. + (let ((s (false-if-exception (lstat file)))) + (and s + (eq? 'symlink (stat:type s)) + (< depth %max-symlink-depth) + (loop (readlink file) (+ 1 depth)))))))) (define (switch-arguments switch args) ;; Return the arguments passed for the occurrences of SWITCH--e.g., |