Add exception handling for processing background jobs

This commit is contained in:
Christopher Baines 2025-06-28 18:25:53 +02:00
parent 47ac73e5a7
commit 42711310fd

View file

@ -248,37 +248,50 @@ port. Also, the port used can be changed by passing the --port option.\n"
(while (not (check-startup-completed startup-completed)) (while (not (check-startup-completed startup-completed))
(sleep 1)) (sleep 1))
(call-with-resource-from-pool (background-connection-pool) (with-exception-handler
(lambda (conn) (lambda _ #f)
(let ((build-ids (lambda ()
(select-background-processing-build-ids conn))) (with-exception-handler
(unless (null? build-ids) (lambda (exn)
(simple-format #t "processing ~A builds from the background queue\n" (simple-format
(length build-ids))) #t
(for-each "exception when processing the background jobs queue")
(lambda (build-id) (print-backtrace-and-exception/knots
(let ((status (select-latest-build-status-by-build-id exn)
conn (raise-exception exn))
build-id))) (lambda ()
(cond (call-with-resource-from-pool (background-connection-pool)
((string=? status "succeeded") (lambda (conn)
(handle-removing-blocking-build-entries-for-successful-builds (let ((build-ids
conn (select-background-processing-build-ids conn)))
(list build-id))) (unless (null? build-ids)
((string=? status "scheduled") (simple-format #t "processing ~A builds from the background queue\n"
(handle-blocked-builds-entries-for-scheduled-builds (length build-ids)))
conn (for-each
(list build-id))) (lambda (build-id)
((member status '("failed" (let ((status (select-latest-build-status-by-build-id
"failed-dependency" conn
"canceled")) build-id)))
(handle-populating-blocked-builds-for-build-failures (cond
conn ((string=? status "succeeded")
(list build-id))))) (handle-removing-blocking-build-entries-for-successful-builds
(delete-background-processing-entries-for-build-ids conn
conn (list build-id)))
build-id)) ((string=? status "scheduled")
build-ids))))) (handle-blocked-builds-entries-for-scheduled-builds
conn
(list build-id)))
((member status '("failed"
"failed-dependency"
"canceled"))
(handle-populating-blocked-builds-for-build-failures
conn
(list build-id)))))
(delete-background-processing-entries-for-build-ids
conn
build-id))
build-ids)))))))
#:unwind? #t))
#:parallel? #t) #:parallel? #t)
(spawn-fiber (spawn-fiber