diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2014-05-20 14:45:58 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2014-05-20 14:45:58 +0200 |
| commit | d84a7be6675bd647931d8eff9134d00dd5a6bd58 (patch) | |
| tree | a4d51c7f53e530fd5ed6da55d916706a3857e4f2 /guix | |
| parent | 953c9fcf8c1a2e0cbebadd9c07591caed7d26f8a (diff) | |
| download | gnu-guix-d84a7be6675bd647931d8eff9134d00dd5a6bd58.tar gnu-guix-d84a7be6675bd647931d8eff9134d00dd5a6bd58.tar.gz | |
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.
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/build/utils.scm | 43 |
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 |