[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
branch master updated: remote: Discover server log-port and publish-port
From: |
Mathieu Othacehe |
Subject: |
branch master updated: remote: Discover server log-port and publish-port without Avahi. |
Date: |
Wed, 10 Feb 2021 11:41:05 -0500 |
This is an automated email from the git hooks/post-receive script.
mothacehe pushed a commit to branch master
in repository guix-cuirass.
The following commit(s) were added to refs/heads/master by this push:
new 3870197 remote: Discover server log-port and publish-port without
Avahi.
3870197 is described below
commit 38701970eba98319b147fb5e962ecd5391a1d51d
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Wed Feb 10 17:37:37 2021 +0100
remote: Discover server log-port and publish-port without Avahi.
* src/cuirass/remote.scm (zmq-server-info, zmq-worker-request-info-message):
New procedures.
* src/cuirass/remote-server.scm (%log-port, %publish-port): New parameters.
(read-worker-exp): Handle 'worker-request-info message.
(remote-server): Set the new parameters.
* src/cuirass/remote-worker.scm (start-worker): Rename "server" argument.
Send
a 'worker-request-info message to discover the server log port and publish
port.
(remote-worker): Adapt it.
---
src/cuirass/remote-server.scm | 11 +++++
src/cuirass/remote-worker.scm | 93 +++++++++++++++++++++++++++----------------
src/cuirass/remote.scm | 17 +++++++-
3 files changed, 84 insertions(+), 37 deletions(-)
diff --git a/src/cuirass/remote-server.scm b/src/cuirass/remote-server.scm
index 4bf22fa..f01e64f 100644
--- a/src/cuirass/remote-server.scm
+++ b/src/cuirass/remote-server.scm
@@ -77,6 +77,12 @@
(define %public-key
(make-parameter #f))
+(define %log-port
+ (make-parameter #f))
+
+(define %publish-port
+ (make-parameter #f))
+
(define service-name
"Cuirass remote server")
@@ -185,6 +191,9 @@ be used to reply to the worker."
(match (zmq-read-message exp)
(('worker-ready worker)
(update-worker! worker))
+ (('worker-request-info)
+ (reply-worker
+ (zmq-server-info (%log-port) (%publish-port))))
(('worker-request-work name)
(let ((build (pop-build name)))
(if build
@@ -437,6 +446,8 @@ exiting."
(assoc-ref opts 'private-key-file))))
(parameterize ((%cache-directory cache)
+ (%log-port log-port)
+ (%publish-port publish-port)
(%trigger-substitute-url trigger-substitute-url)
(%package-database database)
(%public-key public-key)
diff --git a/src/cuirass/remote-worker.scm b/src/cuirass/remote-worker.scm
index 339e0ec..36e9d46 100644
--- a/src/cuirass/remote-worker.scm
+++ b/src/cuirass/remote-worker.scm
@@ -64,9 +64,9 @@ Start a remote build worker.\n"))
(display (G_ "
-p, --publish-port=PORT publish substitutes on PORT"))
(display (G_ "
- -S, --server=SERVER connect to SERVER"))
+ -s, --server=SERVER connect to SERVER"))
(display (G_ "
- -s, --systems=SYSTEMS list of supported SYSTEMS"))
+ -S, --systems=SYSTEMS list of supported SYSTEMS"))
(display (G_ "
--public-key=FILE use FILE as the public key for signatures"))
(display (G_ "
@@ -230,7 +230,7 @@ command. REPLY is a procedure that can be used to reply to
this server."
(sleep 60)
(loop))))))
-(define (start-worker worker server)
+(define (start-worker worker serv)
"Start a worker thread named NAME, reading commands from the DEALER socket
and executing them. The worker can reply on the same socket."
(define (reply socket)
@@ -253,25 +253,47 @@ and executing them. The worker can reply on the same
socket."
(list (make-bytevector 0)
(string->bv (zmq-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)))))
+
+ (define (read-server-info socket serv)
+ (request-info socket)
+ (match (zmq-get-msg-parts-bytevector socket '())
+ ((empty info)
+ (match (zmq-read-message (bv->string info))
+ (('server-info
+ ('log-port log-port)
+ ('publish-port publish-port))
+ (let ((url (publish-url (server-address serv)
+ publish-port)))
+ (server
+ (inherit serv)
+ (log-port log-port)
+ (publish-url url))))))))
+
(match (primitive-fork)
(0
(set-thread-name (worker-name worker))
(let* ((socket (zmq-dealer-socket))
- (address (server-address server))
- (port (server-port server))
+ (address (server-address serv))
+ (port (server-port serv))
(endpoint (zmq-backend-endpoint address port)))
(zmq-connect socket endpoint)
(ready socket)
- (worker-ping worker server)
- (let loop ()
- (request-work socket)
- (match (zmq-get-msg-parts-bytevector socket '())
- ((empty command)
- (run-command (bv->string command) server
- #:reply (reply socket)
- #:worker worker)))
- (sleep 10)
- (loop))))
+ (worker-ping worker serv)
+ (let ((server* (read-server-info socket serv)))
+ (let loop ()
+ (request-work socket)
+ (match (zmq-get-msg-parts-bytevector socket '())
+ ((empty command)
+ (run-command (bv->string command) server*
+ #:reply (reply socket)
+ #:worker worker)))
+ (sleep 10)
+ (loop)))))
(pid pid)))
@@ -286,10 +308,6 @@ and executing them. The worker can reply on the same
socket."
(define %worker-pids
(make-atomic-box '()))
-(define (load-server file)
- (let ((user-module (make-user-module '((cuirass remote)))))
- (load* file user-module)))
-
(define (add-to-worker-pids! pid)
(let ((pids (atomic-box-ref %worker-pids)))
(atomic-box-set! %worker-pids (cons pid pids))))
@@ -328,7 +346,7 @@ exiting."
(address (assoc-ref opts 'address))
(workers (assoc-ref opts 'workers))
(publish-port (assoc-ref opts 'publish-port))
- (server (assoc-ref opts 'server))
+ (server-address (assoc-ref opts 'server))
(systems (assoc-ref opts 'systems))
(public-key
(read-file-sexp
@@ -345,23 +363,28 @@ exiting."
#:public-key public-key
#:private-key private-key))
- (when (and server (not address))
+ (when (and server-address (not address))
(leave (G_ "Address must be set when server is provided.~%")))
- (if server
- (let ((server (load-server server)))
- (for-each
- (lambda (n)
- (let ((publish-url (local-publish-url address)))
- (add-to-worker-pids!
- (start-worker (worker
- (name (generate-worker-name))
- (address address)
- (machine (gethostname))
- (publish-url publish-url)
- (systems systems))
- server))))
- (iota workers)))
+ (if server-address
+ (for-each
+ (lambda (n)
+ (let* ((publish-url (local-publish-url address))
+ (worker (worker
+ (name (generate-worker-name))
+ (address address)
+ (machine (gethostname))
+ (publish-url publish-url)
+ (systems systems)))
+ (addr (string-split server-address #\:))
+ (server (match addr
+ ((address port)
+ (server
+ (address address)
+ (port (string->number port)))))))
+ (add-to-worker-pids!
+ (start-worker worker server))))
+ (iota workers))
(avahi-browse-service-thread
(lambda (action service)
(case action
diff --git a/src/cuirass/remote.scm b/src/cuirass/remote.scm
index 895c99c..c5a27ea 100644
--- a/src/cuirass/remote.scm
+++ b/src/cuirass/remote.scm
@@ -80,6 +80,8 @@
zmq-worker-ping
zmq-worker-ready-message
zmq-worker-request-work-message
+ zmq-worker-request-info-message
+ zmq-server-info
zmq-read-message
remote-server-service-type))
@@ -172,8 +174,10 @@
server?
(address server-address)
(port server-port)
- (log-port server-log-port)
- (publish-url server-publish-url))
+ (log-port server-log-port
+ (default #f))
+ (publish-url server-publish-url
+ (default #f)))
(define (publish-url address port)
"Return the publish url at ADDRESS and PORT."
@@ -447,5 +451,14 @@ retries a call to PROC."
"Return a message that indicates that WORKER is requesting work."
(format #f "~s" `(worker-request-work ,name)))
+(define (zmq-worker-request-info-message)
+ "Return a message requesting server information."
+ (format #f "~s" '(worker-request-info)))
+
+(define (zmq-server-info log-port publish-port)
+ "Return a message containing server information."
+ (format #f "~s" `(server-info (log-port ,log-port)
+ (publish-port ,publish-port))))
+
(define remote-server-service-type
"_remote-server._tcp")
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- branch master updated: remote: Discover server log-port and publish-port without Avahi.,
Mathieu Othacehe <=