branch core-updates updated: utils: Do not raise exceptions in delete-file-recursively.

[guix-commits]

This is an automated email from the git hooks/post-receive script.

apteryx pushed a commit to branch core-updates
in repository guix.

The following commit(s) were added to refs/heads/core-updates by this push:
     new 7102c18  utils: Do not raise exceptions in delete-file-recursively.
7102c18 is described below

commit 7102c18678dc02d5ee6c77a9a70ae344482af841
Author: Maxim Cournoyer <maxim.cournoyer@gmail.com>
AuthorDate: Mon Sep 14 23:46:48 2020 -0400

    utils: Do not raise exceptions in delete-file-recursively.
    
    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 afcb71f..533b740 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.
 ;;;
@@ -383,6 +384,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
@@ -393,10 +404,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)