diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-10-26 20:01:45 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-10-27 00:01:20 +0100 |
| commit | d50cb56d9b58f3e1605f59b35ce99942c3b70d24 (patch) | |
| tree | 145a56ec4626e3a979d297f1e82a469951e0a59b /guix | |
| parent | deaab8e314982d1ddb65e41d043ceb5de3c3b723 (diff) | |
| download | gnu-guix-d50cb56d9b58f3e1605f59b35ce99942c3b70d24.tar gnu-guix-d50cb56d9b58f3e1605f59b35ce99942c3b70d24.tar.gz | |
utils: Add 'readlink*'.
* guix/scripts/package.scm (readlink*): Move to...
* guix/utils.scm (readlink*): ... here. New procedure.
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/scripts/package.scm | 28 | ||||
| -rw-r--r-- | guix/utils.scm | 28 |
2 files changed, 28 insertions, 28 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 804ca954f2..ee45cddedd 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -612,34 +612,6 @@ doesn't need it." (add-indirect-root store absolute)) -(define (readlink* file) - "Call 'readlink' until the result is not a symlink." - (define %max-symlink-depth 50) - - (let loop ((file file) - (depth 0)) - (define (absolute target) - (if (absolute-file-name? target) - target - (string-append (dirname file) "/" target))) - - (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)) - (values #f file) - (apply throw args)))))) - (lambda (success? target) - (if success? - (loop (absolute target) (+ depth 1)) - file)))))) - ;;; ;;; Entry point. diff --git a/guix/utils.scm b/guix/utils.scm index 190b787185..f1317ac756 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -82,6 +82,7 @@ fold-tree-leaves split cache-directory + readlink* filtered-port compressed-port @@ -710,6 +711,33 @@ elements after E." (and=> (getenv "HOME") (cut string-append <> "/.cache/guix")))) +(define (readlink* file) + "Call 'readlink' until the result is not a symlink." + (define %max-symlink-depth 50) + + (let loop ((file file) + (depth 0)) + (define (absolute target) + (if (absolute-file-name? target) + target + (string-append (dirname file) "/" target))) + + (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)) + (values #f file) + (apply throw args)))))) + (lambda (success? target) + (if success? + (loop (absolute target) (+ depth 1)) + file)))))) ;;; ;;; Source location. |