[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
branch wip-offload updated: tmp4
|
From: |
Mathieu Othacehe |
|
Subject: |
branch wip-offload updated: tmp4 |
|
Date: |
Sun, 13 Dec 2020 09:37:01 -0500 |
This is an automated email from the git hooks/post-receive script.
mothacehe pushed a commit to branch wip-offload
in repository guix-cuirass.
The following commit(s) were added to refs/heads/wip-offload by this push:
new 547db79 tmp4
547db79 is described below
commit 547db795e684e1181ed4d40127304f74e7a58df4
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Sun Dec 13 15:36:43 2020 +0100
tmp4
---
src/cuirass/database.scm | 4 +-
src/cuirass/remote-worker.scm | 126 +++++++++++++++++++++++-------------------
src/cuirass/remote.scm | 60 ++++++++++++++++++++
3 files changed, 132 insertions(+), 58 deletions(-)
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 971cbd0..597ddee 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -1427,7 +1427,7 @@ INSERT OR REPLACE INTO Workers (name, address, systems,
last_seen)
VALUES ("
(worker-name worker) ", "
(worker-address worker) ", "
- (worker-systems worker) ", "
+ (string-join (worker-systems worker) ",") ", "
(worker-last-seen worker) ");")
(last-insert-rowid db)))
@@ -1445,7 +1445,7 @@ SELECT name, address, systems, last_seen from Workers"))
(cons (worker
(name name)
(address address)
- (systems (with-input-from-string systems read))
+ (systems (string-split systems #\,))
(last-seen last-seen))
workers)))))))
diff --git a/src/cuirass/remote-worker.scm b/src/cuirass/remote-worker.scm
index 3917574..3e24515 100644
--- a/src/cuirass/remote-worker.scm
+++ b/src/cuirass/remote-worker.scm
@@ -54,6 +54,10 @@ Start a remote build worker.\n"))
(display (G_ "
-p, --publish-port=PORT publish substitutes on PORT"))
(display (G_ "
+ -S, --server=SERVER connect to SERVER"))
+ (display (G_ "
+ -s, --systems=SYSTEMS list of supported SYSTEMS"))
+ (display (G_ "
--public-key=FILE use FILE as the public key for signatures"))
(display (G_ "
--private-key=FILE use FILE as the private key for signatures"))
@@ -73,12 +77,22 @@ Start a remote build worker.\n"))
(option '(#\V "version") #f #f
(lambda _
(show-version-and-exit "guix publish")))
+ (option '(#\a "address") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'address arg result)))
(option '(#\w "workers") #t #f
(lambda (opt name arg result)
(alist-cons 'workers (string->number* arg) result)))
(option '(#\p "publish-port") #t #f
(lambda (opt name arg result)
(alist-cons 'publish-port (string->number* arg) result)))
+ (option '(#\s "server") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'server arg result)))
+ (option '(#\S "systems") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'systems
+ (string-split arg #\,) result)))
(option '("public-key") #t #f
(lambda (opt name arg result)
(alist-cons 'public-key-file arg result)))
@@ -89,6 +103,7 @@ Start a remote build worker.\n"))
(define %default-options
`((workers . 1)
(publish-port . 5558)
+ (systems . ,(list (%current-system)))
(public-key-file . ,%public-key-file)
(private-key-file . ,%private-key-file)))
@@ -118,45 +133,17 @@ ADDRESS and PORT."
(define %local-publish-port
(make-atomic-box #f))
-(define (server-publish-url address port)
- "Return the server publish url at ADDRESS and PORT."
- (string-append "http://"; address ":" (number->string port)))
-
-(define (service-txt->publish-port txt)
- "Parse the service TXT record and return the server publish port."
- (define (parse-txt)
- (fold (lambda (param params)
- (match (string-split param #\=)
- ((key value)
- (cons (cons (string->symbol key) value)
- params))))
- '()
- txt))
-
- (let ((params (parse-txt)))
- (string->number (assq-ref params 'publish))))
-
-(define (service->publish-url service)
- "Return the URL of the publish server corresponding to the service with the
-given NAME."
- (let* ((address (avahi-service-address service))
- (txt (avahi-service-txt service))
- (publish-port
- (service-txt->publish-port txt)))
- (server-publish-url address publish-port)))
-
-(define (service->local-publish-url service)
+(define (local-publish-url address)
"Return the URL of the local publish server."
- (let* ((local-address (avahi-service-local-address service))
- (port (atomic-box-ref %local-publish-port)))
- (server-publish-url local-address port)))
+ (let ((port (atomic-box-ref %local-publish-port)))
+ (publish-url address port)))
(define (empty-cache!)
(let ((cache "/var/guix/substitute/cache"))
(when (file-exists? cache)
(delete-file-recursively cache))))
-(define* (run-build drv service
+(define* (run-build drv server
#:key
reply worker)
"Build DRV and send messages upon build start, failure or completion to the
@@ -166,8 +153,8 @@ The publish server of the build server is added to the list
of the store
substitutes-urls. This way derivations that are not present on the worker can
still be substituted."
(with-store store
- (let ((publish-url (service->publish-url service))
- (local-publish-url (service->local-publish-url service))
+ (let ((publish-url (server-publish-url server))
+ (local-publish-url (worker-publish-url worker))
(name (worker-name worker)))
(add-substitute-url store publish-url)
(empty-cache!)
@@ -184,7 +171,7 @@ still be substituted."
(info (G_ "Derivation ~a build failed.~%") drv)
(reply (zmq-build-failed-message drv))))))))
-(define* (run-command command service
+(define* (run-command command server
#:key
reply worker)
"Run COMMAND. SERVICE-NAME is the name of the build server that sent the
@@ -192,11 +179,11 @@ command. REPLY is a procedure that can be used to reply
to this server."
(match (zmq-read-message command)
(('build ('drv drv) ('system system))
(info (G_ "Building `~a' derivation.~%") drv)
- (run-build drv service #:reply reply #:worker worker))
+ (run-build drv server #:reply reply #:worker worker))
(('no-build)
#t)))
-(define (worker-ping worker service)
+(define (worker-ping worker server)
(define (ping socket)
(zmq-send-msg-parts-bytevector
socket
@@ -207,8 +194,8 @@ command. REPLY is a procedure that can be used to reply to
this server."
(call-with-new-thread
(lambda ()
(let* ((socket (zmq-dealer-socket))
- (address (avahi-service-address service))
- (port (avahi-service-port service))
+ (address (server-address server))
+ (port (server-port server))
(endpoint (zmq-backend-endpoint address port)))
(zmq-connect socket endpoint)
(let loop ()
@@ -216,7 +203,7 @@ command. REPLY is a procedure that can be used to reply to
this server."
(sleep 10)
(loop))))))
-(define (start-worker worker service)
+(define (start-worker worker server)
"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 client)
@@ -244,17 +231,17 @@ and executing them. The worker can reply on the same
socket."
(lambda ()
(set-thread-name (worker-name worker))
(let* ((socket (zmq-dealer-socket))
- (address (avahi-service-address service))
- (port (avahi-service-port service))
+ (address (server-address server))
+ (port (server-port server))
(endpoint (zmq-backend-endpoint address port)))
(zmq-connect socket endpoint)
(ready socket)
- (worker-ping worker service)
+ (worker-ping worker server)
(let loop ()
(request-work socket)
(match (zmq-get-msg-parts-bytevector socket '())
((empty client empty command)
- (run-command (bv->string command) service
+ (run-command (bv->string command) server
#:reply (reply socket client)
#:worker worker)))
(sleep 1)
@@ -269,6 +256,10 @@ and executing them. The worker can reply on the same
socket."
(define %publish-pid
(make-atomic-box #f))
+(define (load-server file)
+ (let ((user-module (make-user-module '((cuirass remote)))))
+ (load* file user-module)))
+
(define (signal-handler)
"Catch SIGINT to stop the Avahi event loop and the publish process before
exiting."
@@ -279,7 +270,7 @@ exiting."
(and publish-pid
(begin
- (kill publish-pid SIGHUP)
+ (kill publish-pid SIGKILL)
(waitpid publish-pid)))
(exit 1)))))
@@ -292,8 +283,11 @@ exiting."
(lambda (arg result)
(leave (G_ "~A: extraneous argument~%") arg))
%default-options))
+ (address (assoc-ref opts 'address))
(workers (assoc-ref opts 'workers))
(publish-port (assoc-ref opts 'publish-port))
+ (server (assoc-ref opts 'server))
+ (systems (assoc-ref opts 'systems))
(public-key
(read-file-sexp
(assoc-ref opts 'public-key-file)))
@@ -309,19 +303,39 @@ exiting."
#:public-key public-key
#:private-key private-key))
- (avahi-browse-service-thread
- (lambda (action service)
- (case action
- ((new-service)
+ (when (and server (not address))
+ (leave (G_ "Address must be set when server is provided.~%")))
+
+ (if server
+ (let ((server (load-server server)))
(for-each
(lambda (n)
- (let ((address (avahi-service-local-address service)))
+ (let ((publish-url (local-publish-url address)))
(start-worker (worker
(address address)
+ (publish-url publish-url)
(name (generate-worker-name))
- (systems '("x86_64-linux")))
- service)))
- (iota workers)))))
- #:types (list remote-server-service-type)
- #:stop-loop? (lambda ()
- (atomic-box-ref %stop-process?))))))
+ (systems systems))
+ server)))
+ (iota workers))
+ (while #t
+ (sleep 1)))
+ (avahi-browse-service-thread
+ (lambda (action service)
+ (case action
+ ((new-service)
+ (for-each
+ (lambda (n)
+ (let ((address (or address
+ (avahi-service-local-address service)))
+ (publish-url (local-publish-url address)))
+ (start-worker (worker
+ (address address)
+ (publish-url publish-url)
+ (name (generate-worker-name))
+ (systems systems))
+ (avahi-service->server service))))
+ (iota workers)))))
+ #:types (list remote-server-service-type)
+ #:stop-loop? (lambda ()
+ (atomic-box-ref %stop-process?)))))))
diff --git a/src/cuirass/remote.scm b/src/cuirass/remote.scm
index 6c5fb5b..d4e94f2 100644
--- a/src/cuirass/remote.scm
+++ b/src/cuirass/remote.scm
@@ -17,6 +17,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (cuirass remote)
+ #:use-module (guix avahi)
#:use-module (guix config)
#:use-module (guix derivations)
#:use-module (guix records)
@@ -36,6 +37,7 @@
worker?
worker-address
worker-name
+ worker-publish-url
worker-systems
worker-last-seen
worker->sexp
@@ -43,6 +45,14 @@
generate-worker-name
%worker-timeout
+ server
+ server?
+ server-address
+ server-port
+ server-publish-url
+ publish-url
+ avahi-service->server
+
publish-server
add-substitute-url
@@ -80,6 +90,8 @@
worker?
(address worker-address)
(name worker-name)
+ (publish-url worker-publish-url
+ (default #f))
(systems worker-systems)
(last-seen worker-last-seen
(default 0)))
@@ -143,6 +155,54 @@
;;;
+;;; Server.
+;;;
+
+(define-record-type* <server>
+ server make-server
+ server?
+ (address server-address)
+ (port server-port)
+ (publish-url server-publish-url))
+
+(define (publish-url address port)
+ "Return the publish url at ADDRESS and PORT."
+ (string-append "http://"; address ":" (number->string port)))
+
+(define (avahi-service->publish-url service)
+ "Return the URL of the publish server corresponding to the service with the
+given NAME."
+ (define (service-txt->publish-port txt)
+ "Parse the service TXT record and return the server publish port."
+ (define (parse-txt)
+ (fold (lambda (param params)
+ (match (string-split param #\=)
+ ((key value)
+ (cons (cons (string->symbol key) value)
+ params))))
+ '()
+ txt))
+
+ (let ((params (parse-txt)))
+ (string->number (assq-ref params 'publish))))
+
+ (let* ((address (avahi-service-address service))
+ (txt (avahi-service-txt service))
+ (publish-port
+ (service-txt->publish-port txt)))
+ (publish-url address publish-port)))
+
+(define (avahi-service->server service)
+ (let ((address (avahi-service-address service))
+ (port (avahi-service-port service))
+ (publish-url (avahi-service->publish-url service)))
+ (server
+ (address address)
+ (port port)
+ (publish-url publish-url))))
+
+
+;;;
;;; Store publishing.
;;;
- branch wip-offload updated: tmp4,
Mathieu Othacehe <=