diff options
Diffstat (limited to 'guix-data-service/jobs/load-new-guix-revision.scm')
| -rw-r--r-- | guix-data-service/jobs/load-new-guix-revision.scm | 101 |
1 files changed, 56 insertions, 45 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 5abe945..565d56e 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -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)) |