ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-17 04:07:10 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

utils: 'delete-file-recursively' doesn't follow mount points by default.

Browse source 
* 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 @@ (define strip-source
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 @@ (define (delete-file-recursively dir)
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