diff options
| -rw-r--r-- | guix/build/graft.scm | 21 |
1 files changed, 19 insertions, 2 deletions
diff --git a/guix/build/graft.scm b/guix/build/graft.scm index b61982dd64..fb21fc3af3 100644 --- a/guix/build/graft.scm +++ b/guix/build/graft.scm @@ -105,6 +105,19 @@ a list of store file name pairs." (string-append (dirname file) "/" target)))) matches))) +(define (exit-on-exception proc) + "Return a procedure that wraps PROC so that 'primitive-exit' is called when +an exception is caught." + (lambda (arg) + (catch #t + (lambda () + (proc arg)) + (lambda (key . args) + ;; Since ports are not thread-safe as of Guile 2.0, reopen stderr. + (let ((port (fdopen 2 "w0"))) + (print-exception port #f key args) + (primitive-exit 1)))))) + (define* (rewrite-directory directory output mapping #:optional (store (%store-directory))) "Copy DIRECTORY to OUTPUT, replacing strings according to MAPPING, a list of @@ -147,9 +160,13 @@ file name pairs." ;; #o777. (umask #o022) + ;; Use 'exit-on-exception' to force an exit upon I/O errors, given that + ;; 'n-par-for-each' silently swallows exceptions. + ;; See <http://bugs.gnu.org/23581>. (n-par-for-each (parallel-job-count) - rewrite-leaf (find-files directory (const #t) - #:directories? #t)) + (exit-on-exception rewrite-leaf) + (find-files directory (const #t) + #:directories? #t)) (rename-matching-files output mapping)) ;;; graft.scm ends here |