From 5b022b5fd7a6252eba194f259370f8356bbffc75 Mon Sep 17 00:00:00 2001 From: Ryan Sundberg Date: Fri, 13 Jan 2023 21:44:57 -0800 Subject: [PATCH 1/4] remote-server: Add `--listen` option to specify server address - Sets the host address to bind for backend worker (0mq) connections. - Sets the host address to bind for receiving logs. - Sets the host address to bind for the publish server. Binding to IPv4 and IPv6 addresses is supported for all ports. Default behavior remains to bind to 0.0.0.0 (INADDR_ANY). * src/cuirass/scripts/remote-server.scm (cuirass-remote-server): Add --listen * src/cuirass/remote.scm (receive-logs): Add host parameter (publish-server): Add host paramter * src/cuirass/scripts/remote-worker: (cuirass-remote-worker): Set publish host #f --- src/cuirass/remote.scm | 82 +++++++++++++++------------ src/cuirass/scripts/remote-server.scm | 28 ++++++--- src/cuirass/scripts/remote-worker.scm | 2 +- 3 files changed, 67 insertions(+), 45 deletions(-) diff --git a/src/cuirass/remote.scm b/src/cuirass/remote.scm index 3513a81..6a3c788 100644 --- a/src/cuirass/remote.scm +++ b/src/cuirass/remote.scm @@ -1,5 +1,6 @@ ;;; remote.scm -- Build on remote machines. ;;; Copyright © 2020 Mathieu Othacehe +;;; Copyright © 2023 Ryan Sundberg ;;; ;;; This file is part of Cuirass. ;;; @@ -222,11 +223,20 @@ properties." #:verbosity 1 #:substitute-urls urls)) -(define* (publish-server port +(define (parse-host-address host) + (cond + ((not host) + (values AF_INET PF_INET INADDR_ANY)) + ((string-index host #\:) + (values AF_INET6 PF_INET6 (inet-pton AF_INET6 host))) + (else + (values AF_INET PF_INET (inet-pton AF_INET host))))) + +(define* (publish-server host port #:key public-key private-key) - "This procedure starts a publishing server listening on PORT in a new + "This procedure starts a publishing server listening on HOST and PORT in a new process and returns the pid of the forked process. Use PUBLIC-KEY and PRIVATE-KEY to sign narinfos." (match (primitive-fork) @@ -244,15 +254,16 @@ PRIVATE-KEY to sign narinfos." ;; Use a default locale. (setlocale LC_ALL "en_US.utf8") - (let* ((address (make-socket-address AF_INET INADDR_ANY 0)) - (socket-address - (make-socket-address (sockaddr:fam address) - (sockaddr:addr address) - port)) - (socket (open-server-socket socket-address))) - ;; Do not cache missing store items on workers. - (run-publish-server socket store - #:narinfo-negative-ttl 0)))))) + (let-values (((af _pf addr) (parse-host-address host))) + (let* ((address (make-socket-address af addr 0)) + (socket-address + (make-socket-address (sockaddr:fam address) + (sockaddr:addr address) + port)) + (socket (open-server-socket socket-address))) + ;; Do not cache missing store items on workers. + (run-publish-server socket store + #:narinfo-negative-ttl 0))))))) (pid pid))) @@ -275,7 +286,7 @@ PRIVATE-KEY to sign narinfos." (cut string-take store-hash <>)))) (string-append cache "/" hash ".log.gz"))) -(define (receive-logs port cache) +(define (receive-logs host port cache) (define (read-log port) (match (false-if-exception (read port)) (('log ('version 0) @@ -288,28 +299,29 @@ PRIVATE-KEY to sign narinfos." (log-error "invalid log received.") #f))) - (define (wait-for-client port proc) - (let ((sock (socket AF_INET SOCK_STREAM 0))) - (setsockopt sock SOL_SOCKET SO_REUSEADDR 1) - (bind sock AF_INET INADDR_ANY port) - (listen sock 1024) - (while #t - (match (select (list sock) '() '() 60) - (((_) () ()) - (match (accept sock) - ((client . address) - (catch 'system-error - (lambda () - (write '(log-server (version 0)) client) - (force-output client) - (proc client)) - (lambda args - (let ((errno (system-error-errno args))) - (when (memv errno (list EPIPE ECONNRESET ECONNABORTED)) - (log-error "~a when replying to ~a." - (strerror errno) (fileno client))))))))) - ((() () ()) - #f))))) + (define (wait-for-client host port proc) + (let-values (((af pf addr) (parse-host-address host))) + (let ((sock (socket pf SOCK_STREAM 0))) + (setsockopt sock SOL_SOCKET SO_REUSEADDR 1) + (bind sock af addr port) + (listen sock 1024) + (while #t + (match (select (list sock) '() '() 60) + (((_) () ()) + (match (accept sock) + ((client . address) + (catch 'system-error + (lambda () + (write '(log-server (version 0)) client) + (force-output client) + (proc client)) + (lambda args + (let ((errno (system-error-errno args))) + (when (memv errno (list EPIPE ECONNRESET ECONNABORTED)) + (log-error "~a when replying to ~a." + (strerror errno) (fileno client))))))))) + ((() () ()) + #f)))))) (define (client-handler client) (call-with-new-thread @@ -324,7 +336,7 @@ PRIVATE-KEY to sign narinfos." (call-with-new-thread (lambda () (set-thread-name "log-server") - (wait-for-client port client-handler)))) + (wait-for-client host port client-handler)))) (define-syntax-rule (swallow-zlib-error exp ...) "Swallow 'zlib-error' exceptions raised by EXP..." diff --git a/src/cuirass/scripts/remote-server.scm b/src/cuirass/scripts/remote-server.scm index c168318..613512d 100644 --- a/src/cuirass/scripts/remote-server.scm +++ b/src/cuirass/scripts/remote-server.scm @@ -1,5 +1,6 @@ ;;; remote-server.scm -- Remote build server. ;;; Copyright © 2020, 2021 Mathieu Othacehe +;;; Copyright © 2023 Ryan Sundberg ;;; ;;; This file is part of Cuirass. ;;; @@ -102,6 +103,8 @@ (define (show-help) (format #t (G_ "Usage: ~a remote-server [OPTION]... Start a remote build server.\n") (%program-name)) + (display (G_ " + -a --listen=ADDRESS listen worker connections on ADDRESS")) (display (G_ " -b, --backend-port=PORT listen worker connections on PORT")) (display (G_ " @@ -143,6 +146,9 @@ Start a remote build server.\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 '(#\b "backend-port") #t #f (lambda (opt name arg result) (alist-cons 'backend-port (string->number* arg) result))) @@ -445,12 +451,11 @@ socket." (define %zmq-context (zmq-create-context)) -(define (zmq-backend-endpoint backend-port) - "Return a ZMQ endpoint string allowing TCP connections on BACKEND-PORT from -all network interfaces." - (string-append "tcp://*:" (number->string backend-port))) +(define (zmq-backend-endpoint backend-host backend-port) + "Return a ZMQ endpoint string allowing TCP connections on BACKEND-PORT. When BACKEND-HOST is false, listen from all network interfaces." + (string-append "tcp://" (or backend-host "*") ":" (number->string backend-port))) -(define (zmq-start-proxy backend-port) +(define (zmq-start-proxy backend-host backend-port) "This procedure starts a proxy between client connections from the IPC frontend to the workers connected through the TCP backend." (define (socket-ready? items socket) @@ -473,7 +478,11 @@ frontend to the workers connected through the TCP backend." ;; that were hanging waiting for request-work responses. (zmq-set-socket-option build-socket ZMQ_PROBE_ROUTER 1) - (zmq-bind-socket build-socket (zmq-backend-endpoint backend-port)) + ;; Enable ZMQ_IPV6 when backend-host is an ipv6 address + (when (and backend-host (string-index backend-host #\:)) + (zmq-set-socket-option build-socket ZMQ_IPV6 1)) + + (zmq-bind-socket build-socket (zmq-backend-endpoint backend-host backend-port)) (zmq-bind-socket fetch-socket (zmq-fetch-workers-endpoint)) ;; Do not use the built-in zmq-proxy as we want to edit the envelope of @@ -569,6 +578,7 @@ exiting." (lambda (arg result) (leave (G_ "~A: extraneous argument~%") arg)) %default-options)) + (listen (assoc-ref opts 'listen)) (backend-port (assoc-ref opts 'backend-port)) (log-port (assoc-ref opts 'log-port)) (no-publish (assoc-ref opts 'no-publish)) @@ -633,7 +643,7 @@ exiting." (unless no-publish (atomic-box-set! %publish-pid - (publish-server publish-port + (publish-server listen publish-port #:public-key public-key #:private-key private-key))) @@ -652,7 +662,7 @@ exiting." (number->string publish-port))) '())))) - (receive-logs log-port (%cache-directory)) + (receive-logs listen log-port (%cache-directory)) (with-database (start-notification-thread) @@ -663,4 +673,4 @@ exiting." (number->string number)))) (iota (%fetch-workers))) - (zmq-start-proxy backend-port)))))) + (zmq-start-proxy listen backend-port)))))) diff --git a/src/cuirass/scripts/remote-worker.scm b/src/cuirass/scripts/remote-worker.scm index 1c47950..47418c4 100644 --- a/src/cuirass/scripts/remote-worker.scm +++ b/src/cuirass/scripts/remote-worker.scm @@ -465,7 +465,7 @@ exiting." (atomic-box-set! %publish-pid - (publish-server publish-port + (publish-server #f publish-port #:public-key public-key #:private-key private-key)) -- 2.37.2