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

[Maxim Cournoyer <maxim.cournoyer@gmail.com>]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain; charset=yes, Size: 2196 bytes --]

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 <plattfot@gmail.com>
---
 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 <arunisaac@systemreboot.net>
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; 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