From d688a4bce88310ed4b3001c7b3a38c13e9eff891 Mon Sep 17 00:00:00 2001 From: Ryan Sundberg Date: Fri, 13 Jan 2023 23:42:21 -0800 Subject: [PATCH 2/4] remote-worker: Add `--listen` option to specify worker address - Allows binding a worker (publish port) to a specific address. IPv4 and IPv6 addresses are supported. The default remains to bind to INADDR_ANY. - Supports connecting to servers using IPv6. * src/cuirass/scripts/remote-worker.scm (cuirass-remote-worker): Add --listen option (cuirass-remote-worker): Support IPv6 addresses for 0mq (start-worker): Enable IPv6 in 0mq socket * src/cuirass/remote.scm (send-log): Support IPv6 addresses for sending logs --- src/cuirass/remote.scm | 51 ++++++++++++++------------- src/cuirass/scripts/remote-worker.scm | 33 +++++++++++++---- 2 files changed, 52 insertions(+), 32 deletions(-) diff --git a/src/cuirass/remote.scm b/src/cuirass/remote.scm index 6a3c788..44b342d 100644 --- a/src/cuirass/remote.scm +++ b/src/cuirass/remote.scm @@ -346,31 +346,32 @@ PRIVATE-KEY to sign narinfos." (const #f))) (define* (send-log address port derivation log) - (let* ((sock (socket AF_INET SOCK_STREAM 0)) - (in-addr (inet-pton AF_INET address)) - (addr (make-socket-address AF_INET in-addr port))) - (connect sock addr) - (match (select (list sock) '() '() 10) - (((_) () ()) - (match (read sock) - (('log-server ('version version ...)) - (let ((header `(log - (version 0) - (derivation ,derivation)))) - (write header sock) - (swallow-zlib-error - (call-with-gzip-output-port sock - (lambda (sock-compressed) - (dump-port log sock-compressed)))) - (close-port sock))) - (x - (log-error "invalid handshake ~s." x) - (close-port sock) - #f))) - ((() () ()) ;timeout - (log-error "timeout while sending log") - (close-port sock) - #f)))) + (let-values (((af pf addr) (parse-host-address address))) + (let* ((sock (socket pf SOCK_STREAM 0)) + (in-addr (inet-pton af address)) + (addr (make-socket-address af in-addr port))) + (connect sock addr) + (match (select (list sock) '() '() 10) + (((_) () ()) + (match (read sock) + (('log-server ('version version ...)) + (let ((header `(log + (version 0) + (derivation ,derivation)))) + (write header sock) + (swallow-zlib-error + (call-with-gzip-output-port sock + (lambda (sock-compressed) + (dump-port log sock-compressed)))) + (close-port sock))) + (x + (log-error "invalid handshake ~s." x) + (close-port sock) + #f))) + ((() () ()) ;timeout + (log-error "timeout while sending log") + (close-port sock) + #f))))) ;;; diff --git a/src/cuirass/scripts/remote-worker.scm b/src/cuirass/scripts/remote-worker.scm index 47418c4..9c4a40a 100644 --- a/src/cuirass/scripts/remote-worker.scm +++ b/src/cuirass/scripts/remote-worker.scm @@ -75,6 +75,8 @@ (define (show-help) (format #t "Usage: ~a remote-worker [OPTION]... Start a remote build worker.\n" (%program-name)) + (display (G_ " + -a --listen=ADDRESS bind publish port on ADDRESS")) (display (G_ " -w, --workers=COUNT start COUNT parallel workers")) (display (G_ " @@ -111,6 +113,9 @@ Start a remote build worker.\n" (%program-name)) (option '(#\V "version") #f #f (lambda _ (show-version-and-exit "guix publish"))) + (option '(#\a "listen") #t #f + (lambda (opt name arg result) + (alist-cons 'listen arg result))) (option '(#\w "workers") #t #f (lambda (opt name arg result) (alist-cons 'workers (string->number* arg) result))) @@ -286,6 +291,7 @@ command. REPLY is a procedure that can be used to reply to this server." (address (server-address server)) (port (server-port server)) (endpoint (zmq-backend-endpoint address port))) + (zmq-set-socket-option socket ZMQ_IPV6 1) (zmq-connect socket endpoint) (let loop () (log-info (G_ "~a: ping ~a.") (worker-name worker) endpoint) @@ -373,6 +379,7 @@ and executing them. The worker can reply on the same socket." (address (server-address serv)) (port (server-port serv)) (endpoint (zmq-backend-endpoint address port))) + (zmq-set-socket-option socket ZMQ_IPV6 1) (zmq-connect socket endpoint) (let* ((srv-info (read-server-info socket)) (server (server-info->server srv-info serv)) @@ -433,6 +440,22 @@ exiting." (exit 1))))) +(define (parse-server address) + (match + (let ((opening-bracket (string-index address #\[))) + (if opening-bracket + ;; IPv6 [address]:port + (let ((closing-bracket (string-index address #\]))) + (list + (substring address (+ opening-bracket 1) closing-bracket) + (substring address (+ closing-bracket 2)))) + ;; IPv4 address:port or hostname:port + (string-split address #\:))) + ((address port) + (server + (address address) + (port (string->number port)))))) + (define (cuirass-remote-worker args) (signal-handler) (with-error-handling @@ -442,6 +465,7 @@ exiting." (lambda (arg result) (leave (G_ "~A: extraneous argument~%") arg)) %default-options)) + (listen (assoc-ref opts 'listen)) (workers (assoc-ref opts 'workers)) (publish-port (assoc-ref opts 'publish-port)) (ttl (assoc-ref opts 'ttl)) @@ -465,7 +489,7 @@ exiting." (atomic-box-set! %publish-pid - (publish-server #f publish-port + (publish-server listen publish-port #:public-key public-key #:private-key private-key)) @@ -476,12 +500,7 @@ exiting." (name (generate-worker-name)) (machine (gethostname)) (systems systems))) - (addr (string-split server-address #\:)) - (server (match addr - ((address port) - (server - (address address) - (port (string->number port))))))) + (server (parse-server server-address))) (add-to-worker-pids! (start-worker worker server)))) (iota workers)) -- 2.37.2