nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2014-05-20 14:45:58 +02:00
parent 953c9fcf8c
commit d84a7be667
1 changed files with 23 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
guix/build/utils.scm
View File

@ -178,10 +178,15 @@ verbose output to the LOG port."
stat stat
lstat))) lstat)))
(define (delete-file-recursively dir) (define* (delete-file-recursively dir
"Delete DIR recursively, like `rm -rf', without following symlinks. Report #:key follow-mounts?)
but ignore errors." "Delete DIR recursively, like `rm -rf', without following symlinks. Don't
(file-system-fold (const #t) ; enter? 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 (lambda (file stat result) ; leaf
(delete-file file)) (delete-file file))
(const #t) ; down (const #t) ; down
@ -196,7 +201,7 @@ but ignore errors."
dir dir
;; Don't follow symlinks. ;; Don't follow symlinks.
lstat)) lstat)))
(define (find-files dir regexp) (define (find-files dir regexp)
"Return the lexicographically sorted list of files under DIR whose basename "Return the lexicographically sorted list of files under DIR whose basename