~ruther/guix-local

d84a7be6675bd647931d8eff9134d00dd5a6bd58 — Ludovic Courtès 12 years ago 953c9fc
utils: 'delete-file-recursively' doesn't follow mount points by default.

* guix/build/utils.scm (delete-file-recursively): Add #:follow-mounts?
  parameter and honor it.
1 files changed, 24 insertions(+), 19 deletions(-)

M guix/build/utils.scm
M guix/build/utils.scm => guix/build/utils.scm +24 -19
@@ 178,25 178,30 @@ verbose output to the LOG port."
                        stat
                        lstat)))

(define (delete-file-recursively dir)
  "Delete DIR recursively, like `rm -rf', without following symlinks.  Report
but ignore errors."
  (file-system-fold (const #t)                    ; enter?
                    (lambda (file stat result)    ; leaf
                      (delete-file file))
                    (const #t)                    ; down
                    (lambda (dir stat result)     ; up
                      (rmdir dir))
                    (const #t)                    ; skip
                    (lambda (file stat errno result)
                      (format (current-error-port)
                              "warning: failed to delete ~a: ~a~%"
                              file (strerror errno)))
                    #t
                    dir

                    ;; Don't follow symlinks.
                    lstat))
(define* (delete-file-recursively dir
                                  #:key follow-mounts?)
  "Delete DIR recursively, like `rm -rf', without following symlinks.  Don't
follow mount points either, unless FOLLOW-MOUNTS? is true.  Report but ignore
errors."
  (let ((dev (stat:dev (lstat dir))))
    (file-system-fold (lambda (dir stat result)    ; enter?
                        (or follow-mounts?
                            (= dev (stat:dev stat))))
                      (lambda (file stat result)   ; leaf
                        (delete-file file))
                      (const #t)                   ; down
                      (lambda (dir stat result)    ; up
                        (rmdir dir))
                      (const #t)                   ; skip
                      (lambda (file stat errno result)
                        (format (current-error-port)
                                "warning: failed to delete ~a: ~a~%"
                                file (strerror errno)))
                      #t
                      dir

                      ;; Don't follow symlinks.
                      lstat)))

(define (find-files dir regexp)
  "Return the lexicographically sorted list of files under DIR whose basename