From: Christopher Allan Webber <cwebber@dustycloud.org>
Date: Wed, 1 Nov 2017 17:52:20 +0000 (-0500)
Subject: websocket: Fix use of with-actor-nonblocking-ports
X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=7410337fd528f81a29e9c1c5645cbb9fa47bfd16;p=8sync.git

websocket: Fix use of with-actor-nonblocking-ports

* 8sync/systems/websocket/server.scm (websocket-client-loop):
Accidentally did not wrap body in a lambda.
---

diff --git a/8sync/systems/websocket/server.scm b/8sync/systems/websocket/server.scm
index 7abd6c4..d9105e8 100644
--- a/8sync/systems/websocket/server.scm
+++ b/8sync/systems/websocket/server.scm
@@ -171,41 +171,42 @@ called for each complete message that is received."
                 (lp))))))
 
     (with-actor-nonblocking-ports
-     (let loop ((fragments '())
-                (type #f))
-       (let ((frame (read-frame-maybe)))
-         (cond
-          ;; EOF - port is closed.
-          ;; @@: Sometimes the eof object appears here as opposed to
-          ;;   at lookahead, but I'm not sure why
-          ((or (not frame) (eof-object? frame))
-           (close-down))
-          ;; Per section 5.4, control frames may appear interspersed
-          ;; along with a fragmented message.
-          ((close-frame? frame)
-           ;; Per section 5.5.1, echo the close frame back to the
-           ;; client before closing the socket.  The client may no
-           ;; longer be listening.
-           (false-if-exception
-            (write-frame (make-close-frame (frame-data frame)) client))
-           (close-down))
-          ((ping-frame? frame)
-           ;; Per section 5.5.3, a pong frame must include the exact
-           ;; same data as the ping frame.
-           (write-frame (make-pong-frame (frame-data frame)) client)
-           (loop fragments type))
-          ((pong-frame? frame) ; silently ignore pongs
-           (loop fragments type))
-          ((first-fragment-frame? frame) ; begin accumulating fragments
-           (loop (list frame) (frame-type frame)))
-          ((final-fragment-frame? frame) ; concatenate all fragments
-           (handle-data-frame type (frame-concatenate (reverse fragments)))
-           (loop '() #f))
-          ((fragment-frame? frame) ; add a fragment
-           (loop (cons frame fragments) type))
-          ((data-frame? frame) ; unfragmented data frame
-           (handle-data-frame (frame-type frame) (frame-data frame))
-           (loop '() #f))))))))
+     (lambda ()
+       (let loop ((fragments '())
+                  (type #f))
+         (let ((frame (read-frame-maybe)))
+           (cond
+            ;; EOF - port is closed.
+            ;; @@: Sometimes the eof object appears here as opposed to
+            ;;   at lookahead, but I'm not sure why
+            ((or (not frame) (eof-object? frame))
+             (close-down))
+            ;; Per section 5.4, control frames may appear interspersed
+            ;; along with a fragmented message.
+            ((close-frame? frame)
+             ;; Per section 5.5.1, echo the close frame back to the
+             ;; client before closing the socket.  The client may no
+             ;; longer be listening.
+             (false-if-exception
+              (write-frame (make-close-frame (frame-data frame)) client))
+             (close-down))
+            ((ping-frame? frame)
+             ;; Per section 5.5.3, a pong frame must include the exact
+             ;; same data as the ping frame.
+             (write-frame (make-pong-frame (frame-data frame)) client)
+             (loop fragments type))
+            ((pong-frame? frame) ; silently ignore pongs
+             (loop fragments type))
+            ((first-fragment-frame? frame) ; begin accumulating fragments
+             (loop (list frame) (frame-type frame)))
+            ((final-fragment-frame? frame) ; concatenate all fragments
+             (handle-data-frame type (frame-concatenate (reverse fragments)))
+             (loop '() #f))
+            ((fragment-frame? frame) ; add a fragment
+             (loop (cons frame fragments) type))
+            ((data-frame? frame) ; unfragmented data frame
+             (handle-data-frame (frame-type frame) (frame-data frame))
+             (loop '() #f)))))))))
 
 (define (websocket-server-send websocket-server message client-id data)
   (with-actor-nonblocking-ports