[no subject]

[Ludovic Courtès]

branch: master
commit 40f70d28aed55c404cca6a0760860fb4942e6bee
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Sep 29 21:57:27 2023 +0200

    remote-server: Fix memory corruption on the sender ID bytevector.
    
    Fixes a bug whereby the sender ID bytevector returned by
    ‘receive-message’ could be modified behind our back (when the C msg
    object is reclaimed) by the time it is passed as #:recipient to
    ‘send-message’.
    
    As a result, ‘zmq-send’ would be passed an invalid peer ID and would
    thus silently drop the message; the other end, ‘cuirass remote-worker’,
    would wait for a reply to its ‘worker-request-work’ message that would
    never come, thus remaining idle forever.
    
    The bug has been there most likely forever, though it might have become
    more frequent with the refactoring in
    445198e2a0afcbfb30c2dd178fd9e093480d5718.
    
    Thanks to Nicolas Dandrimont for putting me on the right track!
    
    * src/cuirass/remote.scm (receive-message): Call ‘bytevector-copy’ on
    the result of ‘zmq-message-content’.
    * src/cuirass/scripts/remote-server.scm (zmq-start-proxy): Set
    ZMQ_ROUTER_MANDATORY on BUILD-SOCKET.
---
 src/cuirass/remote.scm                | 8 ++++++--
 src/cuirass/scripts/remote-server.scm | 4 ++++
 2 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/src/cuirass/remote.scm b/src/cuirass/remote.scm
index 7204479..2e2b67f 100644
--- a/src/cuirass/remote.scm
+++ b/src/cuirass/remote.scm
@@ -446,16 +446,20 @@ the payload, the peer's identity (a bytevector), and the 
peer address."
         (wait))))
 
   (if router?
+      ;; XXX: Below, call 'bytevector-copy' because 'zmq-message-content'
+      ;; currently returns a bytevector that aliases the data of the
+      ;; underlying message object, which may be freed and reused behind our
+      ;; back.
       (match (zmq-message-receive* socket)
         ((sender (= zmq-message-size 0) data)
          (values (call-with-input-string (bv->string
                                           (zmq-message-content data))
                    read)
-                 (zmq-message-content sender)
+                 (bytevector-copy (zmq-message-content sender))
                  (zmq-message-gets data "Peer-Address")))
         ((sender (and message (= zmq-message-size 0)))
          (values *unspecified*
-                 (zmq-message-content sender)
+                 (bytevector-copy (zmq-message-content sender))
                  (zmq-message-gets message "Peer-Address"))))
       (match (zmq-get-msg-parts-bytevector socket '())
         ((#vu8() data)
diff --git a/src/cuirass/scripts/remote-server.scm 
b/src/cuirass/scripts/remote-server.scm
index ab20b40..3368696 100644
--- a/src/cuirass/scripts/remote-server.scm
+++ b/src/cuirass/scripts/remote-server.scm
@@ -464,6 +464,10 @@ is received, pass it on to FETCH-WORKER to download the 
build's output(s)."
     ;; that were hanging waiting for request-work responses.
     (zmq-set-socket-option build-socket ZMQ_PROBE_ROUTER 1)
 
+    ;; When a message being sent has an invalid destination, throw an
+    ;; exception instead of silently dropping it.
+    (zmq-set-socket-option build-socket ZMQ_ROUTER_MANDATORY 1)
+
     (zmq-bind-socket build-socket (zmq-backend-endpoint backend-port))
 
     (spawn-fiber