~ruther/guix-local

d50cb56d9b58f3e1605f59b35ce99942c3b70d24 — Ludovic Courtès 10 years ago deaab8e
utils: Add 'readlink*'.

* guix/scripts/package.scm (readlink*): Move to...
* guix/utils.scm (readlink*): ... here.  New procedure.
2 files changed, 28 insertions(+), 28 deletions(-)

M guix/scripts/package.scm
M guix/utils.scm
M guix/scripts/package.scm => guix/scripts/package.scm +0 -28
@@ 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.

M guix/utils.scm => guix/utils.scm +28 -0
@@ 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.