diff options
Diffstat (limited to 'guix-build-coordinator/coordinator.scm')
| -rw-r--r-- | guix-build-coordinator/coordinator.scm | 52 |
1 files changed, 37 insertions, 15 deletions
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 3830d88..34b05c9 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -50,6 +50,7 @@ #:use-module (prometheus) #:use-module ((guix build syscalls) #:select (set-thread-name)) + #:use-module (guix store) #:use-module (guix derivations) #:use-module (guix build utils) #:use-module (guix-build-coordinator utils) @@ -394,11 +395,14 @@ (port-log (make <custom-port-log> #:port (current-output-port) #:formatter - (lambda (lvl time str) + ;; In guile-lib v0.2.8 onwards, the formatter is + ;; called with more arguments + (lambda args ; lvl, time, str (format #f "~a (~5a): ~a~%" - (strftime "%F %H:%M:%S" (localtime time)) - lvl - str)))) + (strftime "%F %H:%M:%S" (localtime + (second args))) + (first args) + (third args))))) (build-coordinator (make-build-coordinator-record datastore hooks @@ -420,6 +424,11 @@ ;; The logger assumes this (set-port-encoding! (current-output-port) "UTF-8") + ;; Work around my broken with-store/non-blocking in Guix + (let ((socket-file (%daemon-socket-uri))) + (%daemon-socket-uri + (string-append "file://" socket-file))) + (with-exception-handler (lambda (exn) (simple-format #t "failed enabling core dumps: ~A\n" exn)) @@ -441,14 +450,14 @@ (lambda (scheduler port) (display "#<scheduler>" port))) - (when update-datastore? - (datastore-update (build-coordinator-datastore build-coordinator))) - (when pid-file (call-with-output-file pid-file (lambda (port) (simple-format port "~A\n" (getpid))))) + (when update-datastore? + (datastore-update (build-coordinator-datastore build-coordinator))) + (set-build-coordinator-allocator-thread! build-coordinator (make-build-allocator-thread build-coordinator)) @@ -585,8 +594,8 @@ finished?) (wait finished?)) - #:hz 10 - #:parallelism 2)) + #:hz 0 + #:parallelism 1)) finished?))))) (define* (submit-build build-coordinator derivation-file @@ -619,9 +628,19 @@ (derivation (if derivation-exists-in-database? #f ; unnecessary to fetch derivation - (call-with-delay-logging read-drv - #:threshold 10 - #:args (list derivation-file)))) + ;; Bit of a hack, but offload reading the derivation to a + ;; thread so that it doesn't block the fibers thread, since + ;; local I/O doesn't cooperate with fibers + (datastore-call-with-transaction + datastore + (lambda _ + (with-fibers-port-timeouts + (lambda () + (call-with-delay-logging read-drv + #:threshold 10 + #:args (list derivation-file))) + #:timeout 240)) + #:readonly? #t))) (system (or system-from-database @@ -740,9 +759,12 @@ (unless (datastore-find-derivation datastore derivation-file) (datastore-store-derivation datastore - (call-with-delay-logging read-drv - #:threshold 10 - #:args (list derivation-file)))) + (with-fibers-port-timeouts + (lambda () + (call-with-delay-logging read-drv + #:threshold 10 + #:args (list derivation-file))) + #:timeout 30))) (let ((related-derivations-lacking-builds (if ensure-all-related-derivation-outputs-have-builds? |