aboutsummaryrefslogtreecommitdiff
path: root/guix-build-coordinator
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2023-11-28 12:29:31 +0000
committerChristopher Baines <mail@cbaines.net>2023-11-28 12:32:56 +0000
commita9a3dcc9563d8388a9c7ebeeb990069b0371154d (patch)
tree9773cc37465f40978ba728d56044a8345b7a0eb9 /guix-build-coordinator
parent956c87fc02587aa6323ec6d0df1ec0bcf9977121 (diff)
downloadbuild-coordinator-a9a3dcc9563d8388a9c7ebeeb990069b0371154d.tar
build-coordinator-a9a3dcc9563d8388a9c7ebeeb990069b0371154d.tar.gz
Set %file-port-name-canonicalization to avoid readlink syscalls
As Guix does.
Diffstat (limited to 'guix-build-coordinator')
-rw-r--r--guix-build-coordinator/coordinator.scm205
1 files changed, 103 insertions, 102 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