From b5e1e011b8177faa3fcafe732990cb7f83744c29 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Sat, 7 Nov 2026 01:44:39 +0000 Subject: Protect against system errors when searching files. --- kaagum/tools/base.scm | 30 ++++++++++++++++++------------ 1 file changed, 18 insertions(+), 12 deletions(-) diff --git a/kaagum/tools/base.scm b/kaagum/tools/base.scm index 84ce9d6..f05ed6b 100644 --- a/kaagum/tools/base.scm +++ b/kaagum/tools/base.scm @@ -205,20 +205,26 @@ For example, to match all scheme (.scm) files, use \"\\.scm$\""))) "~a:~a:~a~%" file line-number line)))))) (for-each (lambda (file) - (call-with-input-file file - (cut port-transduce - (compose (tenumerate 1) - (tfilter line-matcher) - (tlog (make-line-logger file))) - (const #t) - get-line - <>))) + ;; Abort file if any system error occurred. + (false-if-exception + (call-with-input-file file + (cut port-transduce + (compose (tenumerate 1) + (tfilter line-matcher) + (tlog (make-line-logger file))) + (const #t) + get-line + <>)))) (filter (lambda (file) ;; Ensure file is a regular file and is - ;; not binary. - (and (eq? (stat:type (stat file)) - 'regular) - (not (binary-file? file)))) + ;; not binary. But, reject file if any + ;; system error (such as permission, + ;; non-existence, etc.) was encountered + ;; during test. + (false-if-exception + (and (eq? (stat:type (stat file)) + 'regular) + (not (binary-file? file))))) (files-recursively files-root files-pattern))))) #:title (lambda* (#:key pattern files-root files-pattern) (if files-pattern -- cgit 1.4.1