summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/build/utils.scm43
1 files changed, 24 insertions, 19 deletions
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 9779278167..2f3dc9cad0 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -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