TakeV/guix
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

gnu: ld-wrapper2: Make 'readlink*' tail-recursive.

Browse source 
* gnu/packages/ld-wrapper2.in (readlink*): Make tail-recursive.
This commit is contained in:
Ludovic Courtès 2015-04-19 17:24:37 +02:00
parent 5763ad9266
commit 07c0b6e082
1 changed files with 16 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
gnu/packages/ld-wrapper2.in
View file

@ -97,16 +97,22 @@ exec @GUILE@ -c "(load-compiled \"@SELF@.go\") (apply $main (cdr (command-line))
target
(string-append (dirname file) "/" target)))
(catch 'system-error
(lambda ()
(if (>= depth %max-symlink-depth)
file
(loop (absolute (readlink file)) (+ depth 1))))
(lambda args
(let ((errno (system-error-errno args)))
(if (or (= errno EINVAL) (= errno ENOENT))
file
(apply throw args)))))))
(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