diff options
| -rw-r--r-- | guix-build-coordinator/coordinator.scm | 205 | ||||
| -rw-r--r-- | scripts/guix-build-coordinator-agent.in | 25 |
2 files changed, 116 insertions, 114 deletions
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 3bc52a9..5b0a2aa 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -455,108 +455,109 @@ #:pid-file pid-file #:parallel-hooks parallel-hooks) - ;; Create some worker thread channels, which need to be created prior - ;; to run-fibers being called. - (let ((chunked-request-channel - ;; There are fibers issues when trying to read the chunked - ;; requests, so do this in dedicated threads. - (make-worker-thread-channel - (const '()) - #:name "chunked request" - #:parallelism 16 - #:log-exception? - (lambda (exn) - (not - (chunked-input-ended-prematurely-error? - exn))) - #:delay-logger - (lambda (seconds-delayed) - (log-delay "chunked request channel" - seconds-delayed) - (when (> seconds-delayed 0.1) - (format - (current-error-port) - "warning: chunked request channel delayed by ~1,2f seconds~%" - seconds-delayed))))) - - (output-hash-channel - (make-output-hash-channel - build-coordinator))) - - (let ((finished? (make-condition))) - (call-with-sigint - (lambda () - (run-fibers - (lambda () - (let* ((current (current-scheduler)) - (schedulers - (cons current (scheduler-remote-peers current)))) - (for-each - (lambda (i sched) - (spawn-fiber - (lambda () - (catch 'system-error - (lambda () - (set-thread-name - (string-append "fibers " (number->string i)))) - (const #t))) - sched)) - (iota (length schedulers)) - schedulers)) - - (log-msg (build-coordinator-logger build-coordinator) - 'INFO - "initialising metrics") - (with-time-logging - "datastore initialise metrics" - (datastore-initialise-metrics! (build-coordinator-datastore - build-coordinator))) - - (datastore-spawn-fibers - (build-coordinator-datastore build-coordinator)) - - (spawn-fiber-to-watch-for-deferred-builds build-coordinator) - - (set-build-coordinator-scheduler! build-coordinator - (current-scheduler)) - - (let ((events-channel - get-state-id - (make-events-channel - (build-coordinator-datastore build-coordinator)))) - - (set-build-coordinator-events-channel! - build-coordinator - events-channel) - (set-build-coordinator-get-state-id-proc! - build-coordinator - get-state-id)) - - ;; Start the agent messaging server - (match (uri-scheme agent-communication-uri) - ('http - (let ((host (uri-host agent-communication-uri)) - (port (uri-port agent-communication-uri))) - (http-agent-messaging-start-server - port - host - secret-key-base - build-coordinator - chunked-request-channel - output-hash-channel) - (log-msg 'INFO "listening on " host ":" port)))) - - ;; Start the client messaging server - (start-client-request-server - secret-key-base - (uri-host client-communication-uri) - (uri-port client-communication-uri) - build-coordinator) - - (wait finished?)) - #:hz 10 - #:parallelism 2)) - finished?)))) + (with-fluids ((%file-port-name-canonicalization 'none)) + ;; Create some worker thread channels, which need to be created prior + ;; to run-fibers being called. + (let ((chunked-request-channel + ;; There are fibers issues when trying to read the chunked + ;; requests, so do this in dedicated threads. + (make-worker-thread-channel + (const '()) + #:name "chunked request" + #:parallelism 16 + #:log-exception? + (lambda (exn) + (not + (chunked-input-ended-prematurely-error? + exn))) + #:delay-logger + (lambda (seconds-delayed) + (log-delay "chunked request channel" + seconds-delayed) + (when (> seconds-delayed 0.1) + (format + (current-error-port) + "warning: chunked request channel delayed by ~1,2f seconds~%" + seconds-delayed))))) + + (output-hash-channel + (make-output-hash-channel + build-coordinator))) + + (let ((finished? (make-condition))) + (call-with-sigint + (lambda () + (run-fibers + (lambda () + (let* ((current (current-scheduler)) + (schedulers + (cons current (scheduler-remote-peers current)))) + (for-each + (lambda (i sched) + (spawn-fiber + (lambda () + (catch 'system-error + (lambda () + (set-thread-name + (string-append "fibers " (number->string i)))) + (const #t))) + sched)) + (iota (length schedulers)) + schedulers)) + + (log-msg (build-coordinator-logger build-coordinator) + 'INFO + "initialising metrics") + (with-time-logging + "datastore initialise metrics" + (datastore-initialise-metrics! (build-coordinator-datastore + build-coordinator))) + + (datastore-spawn-fibers + (build-coordinator-datastore build-coordinator)) + + (spawn-fiber-to-watch-for-deferred-builds build-coordinator) + + (set-build-coordinator-scheduler! build-coordinator + (current-scheduler)) + + (let ((events-channel + get-state-id + (make-events-channel + (build-coordinator-datastore build-coordinator)))) + + (set-build-coordinator-events-channel! + build-coordinator + events-channel) + (set-build-coordinator-get-state-id-proc! + build-coordinator + get-state-id)) + + ;; Start the agent messaging server + (match (uri-scheme agent-communication-uri) + ('http + (let ((host (uri-host agent-communication-uri)) + (port (uri-port agent-communication-uri))) + (http-agent-messaging-start-server + port + host + secret-key-base + build-coordinator + chunked-request-channel + output-hash-channel) + (log-msg 'INFO "listening on " host ":" port)))) + + ;; Start the client messaging server + (start-client-request-server + secret-key-base + (uri-host client-communication-uri) + (uri-port client-communication-uri) + build-coordinator) + + (wait finished?)) + #:hz 10 + #:parallelism 2)) + finished?))))) (define* (submit-build build-coordinator derivation-file #:key diff --git a/scripts/guix-build-coordinator-agent.in b/scripts/guix-build-coordinator-agent.in index 006e1f8..6d94302 100644 --- a/scripts/guix-build-coordinator-agent.in +++ b/scripts/guix-build-coordinator-agent.in @@ -193,15 +193,16 @@ (else (error "unknown coordinator interface"))))) - (run-agent uuid - coordinator-interface - (delete-duplicates (assq-ref opts 'systems)) - (assq-ref opts 'max-parallel-builds) - (assq-ref opts 'max-allocated-builds) - (assq-ref opts 'max-parallel-uploads) - (or (assq-ref opts 'derivation-substitute-urls) - (assq-ref opts 'substitute-urls)) - (or (assq-ref opts 'non-derivation-substitute-urls) - (assq-ref opts 'substitute-urls)) - (assq-ref opts 'metrics-file) - (assq-ref opts 'max-1min-load-average)))) + (with-fluids ((%file-port-name-canonicalization 'none)) + (run-agent uuid + coordinator-interface + (delete-duplicates (assq-ref opts 'systems)) + (assq-ref opts 'max-parallel-builds) + (assq-ref opts 'max-allocated-builds) + (assq-ref opts 'max-parallel-uploads) + (or (assq-ref opts 'derivation-substitute-urls) + (assq-ref opts 'substitute-urls)) + (or (assq-ref opts 'non-derivation-substitute-urls) + (assq-ref opts 'substitute-urls)) + (assq-ref opts 'metrics-file) + (assq-ref opts 'max-1min-load-average))))) |