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
(lambda ()
(with-postgresql-connection
"fix"
(lambda (conn)
(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)))
(with-exception-handler
;; Fibers get's stuck if it handles an exception, so handle
;; exceptions here so this procedure actually finishes
(const #f)
(lambda ()
(with-exception-handler
(lambda (exn)
(print-backtrace-and-exception/knots exn)
(raise-exception exn))
(lambda ()
(with-postgresql-connection
"fix"
(lambda (conn)
(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))
((drv-id rest ...)
(when (and (derivation-missing-sources? conn drv-id)
(not (null? (derivation-sources drv))))
(with-postgresql-transaction
conn
(lambda (conn)
(derivations-insert-sources postgresql-connection-pool
call-with-utility-thread
(vector drv)
(vector drv-id)))))
(match (select-derivation-by-file-name conn (derivation-file-name drv))
((drv-id rest ...)
(when (and (derivation-missing-sources? conn drv-id)
(not (null? (derivation-sources drv))))
(with-postgresql-transaction
conn
(lambda (conn)
(derivations-insert-sources postgresql-connection-pool
call-with-utility-thread
(vector drv)
(vector drv-id)))))
(when (and (derivation-missing-inputs? conn drv-id)
(not (null? (derivation-inputs drv))))
(with-postgresql-transaction
conn
(lambda (conn)
(let ((input-derivations
(map derivation-input-derivation
(derivation-inputs drv))))
(unless (null? input-derivations)
;; Ensure all the input derivations exist
(chunk-for-each!
(lambda (chunk)
(insert-missing-derivations
postgresql-connection-pool
call-with-utility-thread
derivation-ids-hash-table
chunk))
1000
input-derivations 1000)))))
(when (and (derivation-missing-inputs? conn drv-id)
(not (null? (derivation-inputs drv))))
(with-postgresql-transaction
conn
(lambda (conn)
(let ((input-derivations
(map derivation-input-derivation
(derivation-inputs drv))))
(unless (null? input-derivations)
;; Ensure all the input derivations exist
(chunk-for-each!
(lambda (chunk)
(insert-missing-derivations
postgresql-connection-pool
call-with-utility-thread
derivation-ids-hash-table
chunk))
1000
input-derivations 1000)))))
(fix-derivation-inputs conn drv))))))))
(fix-derivation-inputs conn drv))))))))))
#:unwind? #t))
#:hz 0
#:parallelism 1))