aboutsummaryrefslogtreecommitdiff
path: root/gnu/packages/ld-wrapper.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-06-12 09:39:31 +0200
committerLudovic Courtès <ludo@gnu.org>2013-06-12 09:39:31 +0200
commitcfbf7877a673400881db20521a9d6a44261ed62b (patch)
tree213362af186a577c88bff5110740b0ead8052deb /gnu/packages/ld-wrapper.scm
parentd4c748607995bec8a13f058bdeba89e41ff6539c (diff)
downloadguix-cfbf7877a673400881db20521a9d6a44261ed62b.tar
guix-cfbf7877a673400881db20521a9d6a44261ed62b.tar.gz
ld-wrapper: Unless in a build env., allow files that symlink to the store.
* gnu/packages/ld-wrapper.scm (pure-file-name?): As a last resort, when %BUILD-DIRECTORY is false, check whether FILE is a symlink, and loop over it to check whether its target is in the store.
Diffstat (limited to 'gnu/packages/ld-wrapper.scm')
-rw-r--r--gnu/packages/ld-wrapper.scm29
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.,