[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
|
From: |
Ludovic Courtès |
|
Date: |
Fri, 30 Jun 2023 18:12:49 -0400 (EDT) |
branch: master
commit 1e5b87b0a6fd2fbbc141401caa04562472d02e44
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Jun 29 22:26:21 2023 +0200
remote: Remove 'zmq-' prefix from our own message bindings.
* src/cuirass/remote.scm (zmq-build-request-message)
(zmq-no-build-message, zmq-build-started-message)
(zmq-build-failed-message, zmq-build-succeeded-message)
(zmq-worker-ping, zmq-worker-ready-message)
(zmq-worker-request-work-message, zmq-worker-request-info-message):
Strip 'zmq-' prefix from the name.
(zmq-server-info): Rename to...
(server-info-message): ... this.
* src/cuirass/scripts/remote-server.scm: Adjust accordingly.
* src/cuirass/scripts/remote-worker.scm: Likewise.
(worker-ping): Rename to...
(spawn-worker-ping): ... this.
---
src/cuirass/remote.scm | 52 +++++++++++++++++------------------
src/cuirass/scripts/remote-server.scm | 6 ++--
src/cuirass/scripts/remote-worker.scm | 22 +++++++--------
3 files changed, 40 insertions(+), 40 deletions(-)
diff --git a/src/cuirass/remote.scm b/src/cuirass/remote.scm
index 862f3c1..2193235 100644
--- a/src/cuirass/remote.scm
+++ b/src/cuirass/remote.scm
@@ -73,16 +73,16 @@
zmq-message-receive*
zmq-empty-delimiter
- zmq-build-request-message
- zmq-no-build-message
- zmq-build-started-message
- zmq-build-failed-message
- zmq-build-succeeded-message
- zmq-worker-ping
- zmq-worker-ready-message
- zmq-worker-request-work-message
- zmq-worker-request-info-message
- zmq-server-info
+ build-request-message
+ no-build-message
+ build-started-message
+ build-failed-message
+ build-succeeded-message
+ worker-ping
+ worker-ready-message
+ worker-request-work-message
+ worker-request-info-message
+ server-info-message
zmq-remote-address
zmq-message-string
zmq-read-message
@@ -400,13 +400,13 @@ retries a call to PROC."
(make-bytevector 0))
;; ZMQ Messages.
-(define* (zmq-build-request-message drv
- #:key
- priority
- timeout
- max-silent
- timestamp
- system)
+(define* (build-request-message drv
+ #:key
+ priority
+ timeout
+ max-silent
+ timestamp
+ system)
"Return a message requesting the build of DRV for SYSTEM."
(format #f "~s" `(build (drv ,drv)
(priority ,priority)
@@ -415,39 +415,39 @@ retries a call to PROC."
(timestamp ,timestamp)
(system ,system))))
-(define (zmq-no-build-message)
+(define (no-build-message)
"Return a message that indicates that no builds are available."
(format #f "~s" `(no-build)))
-(define (zmq-build-started-message drv worker)
+(define (build-started-message drv worker)
"Return a message that indicates that the build of DRV has started."
(format #f "~s" `(build-started (drv ,drv) (worker ,worker))))
-(define* (zmq-build-failed-message drv url #:optional log)
+(define* (build-failed-message drv url #:optional log)
"Return a message that indicates that the build of DRV has failed."
(format #f "~s" `(build-failed (drv ,drv) (url ,url) (log ,log))))
-(define* (zmq-build-succeeded-message drv url #:optional log)
+(define* (build-succeeded-message drv url #:optional log)
"Return a message that indicates that the build of DRV is done."
(format #f "~s" `(build-succeeded (drv ,drv) (url ,url) (log ,log))))
-(define (zmq-worker-ping worker)
+(define (worker-ping worker)
"Return a message that indicates that WORKER is alive."
(format #f "~s" `(worker-ping ,worker)))
-(define (zmq-worker-ready-message worker)
+(define (worker-ready-message worker)
"Return a message that indicates that WORKER is ready."
(format #f "~s" `(worker-ready ,worker)))
-(define (zmq-worker-request-work-message name)
+(define (worker-request-work-message name)
"Return a message that indicates that WORKER is requesting work."
(format #f "~s" `(worker-request-work ,name)))
-(define (zmq-worker-request-info-message)
+(define (worker-request-info-message)
"Return a message requesting server information."
(format #f "~s" '(worker-request-info)))
-(define (zmq-server-info worker-address log-port publish-port)
+(define (server-info-message worker-address log-port publish-port)
"Return a message containing server information."
(format #f "~s" `(server-info (worker-address ,worker-address)
(log-port ,log-port)
diff --git a/src/cuirass/scripts/remote-server.scm
b/src/cuirass/scripts/remote-server.scm
index accbc4c..385d5f6 100644
--- a/src/cuirass/scripts/remote-server.scm
+++ b/src/cuirass/scripts/remote-server.scm
@@ -244,7 +244,7 @@ be used to reply to the worker."
(update-worker! worker))
(('worker-request-info)
(reply-worker
- (zmq-server-info (zmq-remote-address msg) (%log-port) (%publish-port))))
+ (server-info-message (zmq-remote-address msg) (%log-port)
(%publish-port))))
(('worker-request-work name)
(let ((worker (db-get-worker name)))
(when (and (%debug) worker)
@@ -265,7 +265,7 @@ be used to reply to the worker."
(db-update-build-worker! derivation name)
(db-update-build-status! derivation (build-status submitted))
(reply-worker
- (zmq-build-request-message derivation
+ (build-request-message derivation
#:priority priority
#:timeout timeout
#:max-silent max-silent)))
@@ -275,7 +275,7 @@ be used to reply to the worker."
(worker-address worker)
(worker-name worker)))
(reply-worker
- (zmq-no-build-message)))))))
+ (no-build-message)))))))
(('worker-ping worker)
(update-worker! worker))
(('build-started ('drv drv) ('worker name))
diff --git a/src/cuirass/scripts/remote-worker.scm
b/src/cuirass/scripts/remote-worker.scm
index 2a70398..01eb943 100644
--- a/src/cuirass/scripts/remote-worker.scm
+++ b/src/cuirass/scripts/remote-worker.scm
@@ -219,11 +219,11 @@ still be substituted."
(%substitute-urls))
#:timeout timeout
#:max-silent max-silent)
- (reply (zmq-build-started-message drv name))
+ (reply (build-started-message drv name))
(guard (c ((store-protocol-error? c)
(log-info (G_ "~a: derivation `~a' build failed: ~a")
name drv (store-protocol-error-message c))
- (reply (zmq-build-failed-message drv local-publish-url))))
+ (reply (build-failed-message drv local-publish-url))))
(let ((result
(let-values (((port finish)
(build-derivations& store (list drv))))
@@ -241,12 +241,12 @@ still be substituted."
(log-info (G_ "~a: derivation ~a build succeeded.")
name drv)
(register-gc-roots drv)
- (reply (zmq-build-succeeded-message drv local-publish-url)))
+ (reply (build-succeeded-message drv local-publish-url)))
(begin
(log-info (G_ "~a: derivation ~a build failed.")
name drv)
(reply
- (zmq-build-failed-message drv local-publish-url)))))))))
+ (build-failed-message drv local-publish-url)))))))))
(define* (run-command command server
#:key
@@ -272,13 +272,13 @@ command. REPLY is a procedure that can be used to reply
to this server."
(worker-name worker))
#t)))
-(define (worker-ping worker server)
+(define (spawn-worker-ping worker server)
+ "Spawn a thread that periodically pings SERVER."
(define (ping socket)
(zmq-send-msg-parts-bytevector
socket
(list (make-bytevector 0)
- (string->bv
- (zmq-worker-ping (worker->sexp worker))))))
+ (string->bv (worker-ping (worker->sexp worker))))))
(call-with-new-thread
(lambda ()
@@ -313,20 +313,20 @@ and executing them. The worker can reply on the same
socket."
socket
(list (make-bytevector 0)
(string->bv
- (zmq-worker-ready-message (worker->sexp worker))))))
+ (worker-ready-message (worker->sexp worker))))))
(define (request-work socket worker)
(let ((name (worker-name worker)))
(zmq-send-msg-parts-bytevector
socket
(list (make-bytevector 0)
- (string->bv (zmq-worker-request-work-message name))))))
+ (string->bv (worker-request-work-message name))))))
(define (request-info socket)
(zmq-send-msg-parts-bytevector
socket
(list (make-bytevector 0)
- (string->bv (zmq-worker-request-info-message)))))
+ (string->bv (worker-request-info-message)))))
(define (read-server-info socket)
;; Ignore the boostrap message sent due to ZMQ_PROBE_ROUTER option.
@@ -383,7 +383,7 @@ and executing them. The worker can reply on the same
socket."
(server-publish-url server)
(server-log-port server))
(ready socket worker)
- (worker-ping worker server)
+ (spawn-worker-ping worker server)
(let loop ()
(if (low-disk-space?)
(log-info (G_ "warning: low disk space, doing nothing"))