[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
06/13: utils: Add 'readlink*'.
From: |
Ludovic Courtès |
Subject: |
06/13: utils: Add 'readlink*'. |
Date: |
Mon, 26 Oct 2015 23:02:27 +0000 |
civodul pushed a commit to branch master
in repository guix.
commit d50cb56d9b58f3e1605f59b35ce99942c3b70d24
Author: Ludovic Courtès <address@hidden>
Date: Mon Oct 26 20:01:45 2015 +0100
utils: Add 'readlink*'.
* guix/scripts/package.scm (readlink*): Move to...
* guix/utils.scm (readlink*): ... here. New procedure.
---
guix/scripts/package.scm | 28 ----------------------------
guix/utils.scm | 28 ++++++++++++++++++++++++++++
2 files changed, 28 insertions(+), 28 deletions(-)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 804ca95..ee45cdd 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 190b787..f1317ac 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.
- branch master updated (64a7192 -> 7e9b07b), Ludovic Courtès, 2015/10/26
- 02/13: gnu: Add python-file., Ludovic Courtès, 2015/10/26
- 01/13: gnu: Add RPM., Ludovic Courtès, 2015/10/26
- 03/13: doc: Add a REPL example., Ludovic Courtès, 2015/10/26
- 06/13: utils: Add 'readlink*'.,
Ludovic Courtès <=
- 05/13: guix system: Extract action processing., Ludovic Courtès, 2015/10/26
- 04/13: ui: Add 'matching-generations'., Ludovic Courtès, 2015/10/26
- 07/13: ui: Add procedures to display a profile generation., Ludovic Courtès, 2015/10/26
- 08/13: guix system: Factorize boot parameter parsing., Ludovic Courtès, 2015/10/26
- 10/13: utils: Add 'switch-symlinks', moved from (guix ui)., Ludovic Courtès, 2015/10/26
- 09/13: guix system: Add the 'list-generations' command., Ludovic Courtès, 2015/10/26
- 11/13: profiles: Add generation manipulation procedures., Ludovic Courtès, 2015/10/26
- 12/13: gnu: Add xcompmgr., Ludovic Courtès, 2015/10/26
- 13/13: gnu: Add yapet., Ludovic Courtès, 2015/10/26