diff options
| -rw-r--r-- | guix-build-coordinator/agent.scm | 11 | ||||
| -rw-r--r-- | guix-build-coordinator/coordinator.scm | 35 | ||||
| -rw-r--r-- | guix-build-coordinator/utils.scm | 9 | ||||
| -rw-r--r-- | guix-build-coordinator/utils/fibers.scm | 4 | ||||
| -rw-r--r-- | scripts/guix-build-coordinator.in | 1 |
5 files changed, 36 insertions, 24 deletions
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm index 8144947..0520da2 100644 --- a/guix-build-coordinator/agent.scm +++ b/guix-build-coordinator/agent.scm @@ -82,11 +82,14 @@ (define port-log (make <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))))) (define metrics-enabled? (and (not (string-null? metrics-file)) diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 3830d88..b75b40f 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -394,11 +394,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 @@ -441,14 +444,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)) @@ -619,9 +622,12 @@ (derivation (if derivation-exists-in-database? #f ; unnecessary to fetch derivation - (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))) (system (or system-from-database @@ -740,9 +746,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? diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index a549f20..6840ddd 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -39,9 +39,6 @@ #:use-module ((guix http-client) #:select (http-fetch)) #:use-module (guix serialization) - #:use-module ((guix build download) - #:select ((open-connection-for-uri - . guix:open-connection-for-uri))) #:use-module ((guix build syscalls) #:select (set-thread-name)) #:use-module (guix scripts substitute) @@ -66,6 +63,7 @@ read-derivation-from-file* + non-blocking-port with-store/non-blocking substitute-derivation @@ -487,10 +485,9 @@ context." (match (assoc-ref cache key) (#f (let ((socket - (guix:open-connection-for-uri + (open-socket-for-uri* uri - #:verify-certificate? verify-certificate? - #:timeout timeout))) + #:verify-certificate? verify-certificate?))) (set! cache (alist-cons key socket cache)) socket)) (socket diff --git a/guix-build-coordinator/utils/fibers.scm b/guix-build-coordinator/utils/fibers.scm index 5362b18..e082bf6 100644 --- a/guix-build-coordinator/utils/fibers.scm +++ b/guix-build-coordinator/utils/fibers.scm @@ -306,7 +306,9 @@ If already in the worker thread, call PROC immediately." (lambda () (with-fibers-port-timeouts (lambda () - (let ((sock (socket PF_INET SOCK_STREAM 0))) + (let ((sock + (non-blocking-port + (socket PF_INET SOCK_STREAM 0)))) (connect sock AF_INET INADDR_LOOPBACK port) (close-port sock))) #:timeout 20)) diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in index 4756bea..86f604f 100644 --- a/scripts/guix-build-coordinator.in +++ b/scripts/guix-build-coordinator.in @@ -502,6 +502,7 @@ canceled?: ~A (vector->list (assoc-ref build-details "tags"))) "\n")) + (newline) (let ((derivation-inputs (vector->list |