summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-10-26 20:01:45 +0100
committerLudovic Courtès <ludo@gnu.org>2015-10-27 00:01:20 +0100
commitd50cb56d9b58f3e1605f59b35ce99942c3b70d24 (patch)
tree145a56ec4626e3a979d297f1e82a469951e0a59b
parentdeaab8e314982d1ddb65e41d043ceb5de3c3b723 (diff)
downloadguix-d50cb56d9b58f3e1605f59b35ce99942c3b70d24.tar.gz
utils: Add 'readlink*'.
* guix/scripts/package.scm (readlink*): Move to...
* guix/utils.scm (readlink*): ... here.  New procedure.
-rw-r--r--guix/scripts/package.scm28
-rw-r--r--guix/utils.scm28
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.