From e65df6a63a49666edb4e57a68369b8e2ef02f1a0 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 5 Mar 2013 18:53:53 +0100
Subject: utils: Add `delete-file-recursively'.

* guix/build/utils.scm (delete-file-recursively): New procedure.
---
 guix/build/utils.scm | 21 +++++++++++++++++++++
 1 file changed, 21 insertions(+)

(limited to 'guix')

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 @@
             with-directory-excursion
             mkdir-p
             copy-recursively
+            delete-file-recursively
             find-files
 
             set-path-environment-variable
@@ -147,6 +148,26 @@ return values of applying PROC to the port."
                     #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
-- 
cgit v1.2.3