Subject: [PATCH core-updates] utils: Do not raise exceptions in delete-file-recursively.

From: Maxim Cournoyer <[email-masked]>
Date: Tue, 15 Sep 2020 00:08:37 -0400

This makes it so that delete-file-recursively honors its docstring, which says
it should "report but ignore errors".

Fixes <https://issues.guix.gnu.org/43366>.

* guix/build/utils.scm (warn-on-error): New syntax.
(delete-file-recursively): Use it to catch exceptions and print warning
messages.

Reported-by: Fredrik Salomonsson <[email-masked]>
---
 guix/build/utils.scm | 15 +++++++++++++--
 1 file changed, 13 insertions(+), 2 deletions(-)

diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 0a04032834..fbf4f2d61a 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2018 Arun Isaac <[email-masked]>
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <[email-masked]>
 ;;; Copyright © 2020 Efraim Flashner <[email-masked]>
+;;; Copyright © 2020 Maxim Cournoyer <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -366,6 +367,16 @@ verbose output to the LOG port."
                         stat
                         lstat)))
 
+(define-syntax-rule (warn-on-error expr file)
+  (catch 'system-error
+    (lambda ()
+      expr)
+    (lambda args
+      (format (current-error-port)
+              "warning: failed to delete ~a: ~a~%"
+              file (strerror
+                    (system-error-errno args))))))
+
 (define* (delete-file-recursively dir
                                   #:key follow-mounts?)
   "Delete DIR recursively, like `rm -rf', without following symlinks.  Don't
@@ -376,10 +387,10 @@ errors."
                         (or follow-mounts?
                             (= dev (stat:dev stat))))
                       (lambda (file stat result)   ; leaf
-                        (delete-file file))
+                        (warn-on-error (delete-file file) file))
                       (const #t)                   ; down
                       (lambda (dir stat result)    ; up
-                        (rmdir dir))
+                        (warn-on-error (rmdir dir) dir))
                       (const #t)                   ; skip
                       (lambda (file stat errno result)
                         (format (current-error-port)
-- 
2.28.0