From e65df6a63a49666edb4e57a68369b8e2ef02f1a0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 5 Mar 2013 18:53:53 +0100 Subject: [PATCH] utils: Add `delete-file-recursively'. * guix/build/utils.scm (delete-file-recursively): New procedure. --- guix/build/utils.scm | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/guix/build/utils.scm b/guix/build/utils.scm index d17346607f..7b49e9f4c7 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -32,6 +32,7 @@ (define-module (guix build utils) with-directory-excursion mkdir-p copy-recursively + delete-file-recursively find-files set-path-environment-variable @@ -147,6 +148,26 @@ (define strip-source #t source)) +(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 (find-files dir regexp) "Return the list of files under DIR whose basename matches REGEXP." (define file-rx