cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Workaround fibers getting stuck handling exceptions

Browse source
This commit is contained in:
Christopher Baines 2025-04-18 13:20:20 +01:00
parent fd2a3ad6c1
commit d4cd94f185
1 changed files with 56 additions and 45 deletions
Download patch file Download diff file Expand all files Collapse all files

101
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -1289,54 +1289,65 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(run-fibers (run-fibers
(lambda () (lambda ()
(with-postgresql-connection (with-exception-handler
"fix" ;; Fibers get's stuck if it handles an exception, so handle
(lambda (conn) ;; exceptions here so this procedure actually finishes
(let ((drv (read-derivation-from-file file-name)) (const #f)
(postgresql-connection-pool (lambda ()
(make-resource-pool (with-exception-handler
(const conn) (lambda (exn)
1 (print-backtrace-and-exception/knots exn)
#:name "postgres")) (raise-exception exn))
(call-with-utility-thread (lambda ()
(lambda (thunk) (with-postgresql-connection
(thunk))) "fix"
(derivation-ids-hash-table (lambda (conn)
(make-hash-table))) (let ((drv (read-derivation-from-file file-name))
(postgresql-connection-pool
(make-resource-pool
(const conn)
1
#:name "postgres"))
(call-with-utility-thread
(lambda (thunk)
(thunk)))
(derivation-ids-hash-table
(make-hash-table)))
(match (select-derivation-by-file-name conn (derivation-file-name drv)) (match (select-derivation-by-file-name conn (derivation-file-name drv))
((drv-id rest ...) ((drv-id rest ...)
(when (and (derivation-missing-sources? conn drv-id) (when (and (derivation-missing-sources? conn drv-id)
(not (null? (derivation-sources drv)))) (not (null? (derivation-sources drv))))
(with-postgresql-transaction (with-postgresql-transaction
conn conn
(lambda (conn) (lambda (conn)
(derivations-insert-sources postgresql-connection-pool (derivations-insert-sources postgresql-connection-pool
call-with-utility-thread call-with-utility-thread
(vector drv) (vector drv)
(vector drv-id))))) (vector drv-id)))))
(when (and (derivation-missing-inputs? conn drv-id) (when (and (derivation-missing-inputs? conn drv-id)
(not (null? (derivation-inputs drv)))) (not (null? (derivation-inputs drv))))
(with-postgresql-transaction (with-postgresql-transaction
conn conn
(lambda (conn) (lambda (conn)
(let ((input-derivations (let ((input-derivations
(map derivation-input-derivation (map derivation-input-derivation
(derivation-inputs drv)))) (derivation-inputs drv))))
(unless (null? input-derivations) (unless (null? input-derivations)
;; Ensure all the input derivations exist ;; Ensure all the input derivations exist
(chunk-for-each! (chunk-for-each!
(lambda (chunk) (lambda (chunk)
(insert-missing-derivations (insert-missing-derivations
postgresql-connection-pool postgresql-connection-pool
call-with-utility-thread call-with-utility-thread
derivation-ids-hash-table derivation-ids-hash-table
chunk)) chunk))
1000 1000
input-derivations 1000))))) input-derivations 1000)))))
(fix-derivation-inputs conn drv)))))))) (fix-derivation-inputs conn drv))))))))))
#:unwind? #t))
#:hz 0 #:hz 0
#:parallelism 1)) #:parallelism 1))