websocket: Queue fragmented frames to avoid interleaving.

* 8sync/systems/websocket/client.scm (<websocket>)[frames]: New slot.
(websocket-send): Use it to queue fragmented frames.

Acked-by: Jan (janneke) Nieuwenhuizen <janneke@gnu.org>

diff --git a/8sync/systems/websocket/client.scm b/8sync/systems/websocket/client.scm
index 49866726ae6c802e1ebbb8535b995bb0fb08e833..93fcdeb6ecd994143a557e6a3c5b83528f8f392a 100644 (file)
--- a/8sync/systems/websocket/client.scm
+++ b/8sync/systems/websocket/client.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2016 David Thompson <davet@gnu.org>
 ;;; Copyright © 2017 Christopher Allan Webber <cwebber@dustycloud.org>
 ;;; Copyright © 2019, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020 Rutger van Beusekom <rutger.van.beusekom@gmail.com>
 ;;;
 ;;; This file is part of guile-websocket.
 ;;;
@@ -71,6 +72,7 @@
   (url #:getter .url #:init-value #f #:init-keyword #:url)
   (uri #:accessor .uri #:init-value #f #:init-keyword #:uri)
   (entropy-port #:accessor .entropy-port #:init-form (open-entropy-port))
+  (frames #:accessor .frames #:init-value '())
 
   (on-close #:init-keyword #:on-close
                  #:init-value no-op
@@ -130,13 +132,18 @@
             (cons frame (loop end)))))))
 
 (define-method (websocket-send (websocket <websocket>) message data)
-  (catch #t           ; expect: wrong-type-arg (open port), system-error
+  (catch #t         ; expect: wrong-type-arg (open port), system-error
     (lambda _
-      (let* ((frames (make-fragmented-frames data)))
-        (let loop ((frames frames) (written '(nothing)))
-          (when (pair? frames)
-            (write-frame (car frames) (.socket websocket))
-            (loop (cdr frames) (cons (car frames) written))))))
+      (let* ((frames (make-fragmented-frames data))
+            (frames? (pair? (.frames websocket))))
+       (set! (.frames websocket) (append (.frames websocket) frames))
+       (unless frames?
+         (let loop ()
+           (let ((frames (.frames websocket)))
+             (when (pair? frames)
+               (write-frame (car frames) (.socket websocket))
+               (set! (.frames websocket) (cdr (.frames websocket)))
+               (loop)))))))
     (lambda (key . args)
       (unless (and (memq key '(system-error wrong-type-arg))
                    (match args