Use with-postgresql-transaction always in load-new-guix-revision

This commit is contained in:
Christopher Baines 2025-06-25 12:46:37 +02:00
parent 5d1233ccd0
commit f7f4e70d28

View file

@ -3044,10 +3044,12 @@ SKIP LOCKED")
(define finished-channel
(make-channel))
(define job-not-found-exception
(make-exception-with-message
(simple-format #f "job ~A not found to be processed\n"
id)))
(define result
(parameterize
;; Mimic the behaviour of with-postgresql-transaction
((%postgresql-in-transaction? #t))
(with-postgresql-connection
(simple-format #f "load-new-guix-revision ~A" id)
(lambda (conn)
@ -3061,8 +3063,27 @@ SKIP LOCKED")
(simple-format (current-error-port)
"after gc\n")))
(exec-query conn "BEGIN")
(with-exception-handler
(lambda (exn)
(unless (eq? job-not-found-exception)
;; Use a new connection in case the outer conn is unusable
(with-postgresql-connection
(simple-format #f "load-new-guix-revision ~A record failure" id)
(lambda (conn)
(record-job-event conn id "failure"))))
#f)
(lambda ()
(with-exception-handler
(lambda (exn)
(simple-format (current-error-port)
"error: load-new-guix-revision: ~A\n"
exn)
(print-backtrace-and-exception/knots exn)
(raise-exception exn))
(lambda ()
(with-postgresql-transaction
conn
(lambda (conn)
(spawn-fiber
(lambda ()
(while (perform-operation
@ -3094,22 +3115,12 @@ SKIP LOCKED")
(lambda (start-event-conn)
(record-job-event start-event-conn id "start")))
(simple-format #t "Processing job ~A (commit: ~A, source: ~A)\n\n"
(simple-format
#t "Processing job ~A (commit: ~A, source: ~A)\n\n"
id commit source)
(if (eq?
(with-time-logging (string-append "processing revision " commit)
(with-exception-handler
(const #f)
(lambda ()
(with-exception-handler
(lambda (exn)
(simple-format (current-error-port)
"error: load-new-guix-revision: ~A\n"
exn)
(print-backtrace-and-exception/knots exn)
(raise-exception exn))
(lambda ()
(with-time-logging
(string-append "processing revision " commit)
(load-new-guix-revision
conn
git-repository-id
@ -3119,24 +3130,14 @@ SKIP LOCKED")
extra-inferior-environment-variables
#:ignore-systems ignore-systems
#:ignore-targets ignore-targets
#:parallelism parallelism))))
#:unwind? #t))
#t)
(begin
#:parallelism parallelism))
(record-job-succeeded conn id)
(record-job-event conn id "success")
(exec-query conn "COMMIT")
#t)
(begin
(exec-query conn "ROLLBACK")
(record-job-event conn id "failure")
#f)))
(record-job-event conn id "success"))
(()
(exec-query conn "ROLLBACK")
(simple-format #t "job ~A not found to be processed\n"
id)))))))
(raise-exception
job-not-found-exception))))))))
#:unwind? #t))))
(when result
(fibers-parallel