From 7102c18678dc02d5ee6c77a9a70ae344482af841 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Mon, 14 Sep 2020 23:46:48 -0400 Subject: 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 . * 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 --- 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 afcb71fae3..533b740896 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2018 Arun Isaac ;;; Copyright © 2018, 2019 Ricardo Wurmus ;;; Copyright © 2020 Efraim Flashner +;;; Copyright © 2020 Maxim Cournoyer ;;; ;;; 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) -- cgit v1.2.3