From f5304d6935ccb02a1cd0ef66ee86e146ee49e958 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Wed, 15 Jan 2025 10:50:20 +0000 Subject: Fix transaction rollback handling And print backtraces. --- guix-build-coordinator/datastore/sqlite.scm | 51 ++++++++++++++++------------- 1 file changed, 29 insertions(+), 22 deletions(-) (limited to 'guix-build-coordinator') diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm index d89ac90..74dde88 100644 --- a/guix-build-coordinator/datastore/sqlite.scm +++ b/guix-build-coordinator/datastore/sqlite.scm @@ -579,29 +579,36 @@ PRAGMA optimize;") #:unwind? #t)) (if (attempt-begin) - (call-with-values - (lambda () - (with-exception-handler - (lambda (exn) - (if (transaction-rollback-exception? exn) - (begin - (sqlite-exec db "ROLLBACK TRANSACTION;") - (transaction-rollback-exception-return-value exn)) - (begin - (simple-format (current-error-port) - "error: sqlite rolling back transaction (~A)\n" - exn) - (sqlite-exec db "ROLLBACK TRANSACTION;") - (raise-exception exn)))) + (with-exception-handler + (lambda (exn) + (if (transaction-rollback-exception? exn) + (begin + (sqlite-exec db "ROLLBACK TRANSACTION;") + (transaction-rollback-exception-return-value exn)) + (begin + (simple-format (current-error-port) + "error: sqlite rolling back transaction (~A)\n" + exn) + (sqlite-exec db "ROLLBACK TRANSACTION;") + (raise-exception exn)))) + (lambda () + (call-with-values (lambda () - (parameterize ((%current-transaction-proc proc)) - (call-with-delay-logging proc #:args (list db)))) - #:unwind? #t)) - (lambda vals - (let loop ((success? (attempt-commit))) - (if success? - (apply values vals) - (loop (attempt-commit)))))) + (with-throw-handler #t + (lambda () + (parameterize ((%current-transaction-proc proc)) + (call-with-delay-logging proc #:args (list db)))) + (lambda (key . args) + (unless (and (eq? key '%exception) + (transaction-rollback-exception? + (car args))) + (backtrace))))) + (lambda vals + (let loop ((success? (attempt-commit))) + (if success? + (apply values vals) + (loop (attempt-commit))))))) + #:unwind? #t) ;; Database is busy, so retry (run-proc-within-transaction db))) -- cgit v1.2.3