diff options
Diffstat (limited to 'guix-data-service/substitutes.scm')
| -rw-r--r-- | guix-data-service/substitutes.scm | 47 |
1 files changed, 28 insertions, 19 deletions
diff --git a/guix-data-service/substitutes.scm b/guix-data-service/substitutes.scm index c7a45dc..3ac09eb 100644 --- a/guix-data-service/substitutes.scm +++ b/guix-data-service/substitutes.scm @@ -19,13 +19,14 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:use-module (ice-9 match) + #:use-module (ice-9 atomic) #:use-module (ice-9 threads) #:use-module (fibers) #:use-module (fibers channels) #:use-module (guix substitutes) #:use-module (guix narinfo) - #:use-module ((guix build syscalls) - #:select (set-thread-name)) + #:use-module (knots) + #:use-module (knots thread-pool) #:use-module (guix-data-service utils) #:use-module (guix-data-service database) #:use-module (guix-data-service model build) @@ -55,17 +56,18 @@ (member id build-server-ids)) (when lookup-all-derivations? (simple-format #t "\nQuerying ~A\n" url) - (with-throw-handler #t + (with-exception-handler + (lambda (exn) + (simple-format + (current-error-port) + "exception in query-build-server ~A ~A\n" + id url) + (print-backtrace-and-exception/knots exn) + (raise-exception exn)) (lambda () (fetch-narinfo-files conn id url revision-commits #:specific-outputs - outputs)) - (lambda (key . args) - (simple-format - (current-error-port) - "exception in query-build-server: ~A ~A\n" - key args) - (backtrace))))))) + outputs))))))) build-servers)))) (define %narinfo-max-size @@ -149,7 +151,7 @@ (lambda (channel) (put-message channel (cons build-server-id build-ids))))))) -(define (start-substitute-query-threads) +(define (start-substitute-query-threads startup-completed?) (define channel (make-channel)) @@ -162,15 +164,21 @@ (set-thread-name "request substitute query")) (const #t)) + (while (not (atomic-box-ref startup-completed?)) + (sleep 1)) + (while #t (with-exception-handler (lambda (exn) - (simple-format - (current-error-port) - "exception in request substitute query thread: ~A\n" - exn)) + #f) (lambda () - (with-throw-handler #t + (with-exception-handler + (lambda (exn) + (simple-format + (current-error-port) + "exception in request substitute query thread:\n") + (print-backtrace-and-exception/knots exn) + (raise-exception exn)) (lambda () (with-postgresql-connection "request-substitute-query-thread" @@ -196,9 +204,7 @@ conn (list build-server-id) #f - outputs)))))))) - (lambda _ - (backtrace)))) + outputs)))))))))) #:unwind? #t)))) (call-with-new-thread @@ -208,6 +214,9 @@ (set-thread-name "bulk substitute query")) (const #t)) + (while (not (atomic-box-ref startup-completed?)) + (sleep 1)) + (while #t (with-exception-handler (lambda (exn) |