From f4461bef9e7b1795c85e55d423f7e20e5b6552dc Mon Sep 17 00:00:00 2001
From: Andrew Whatson <whatson@tailcall.au>
Date: Fri, 21 Apr 2023 12:08:08 +1000
Subject: client: Handle control frames in websocket-receive.

* web/socket/frame.scm (read-data-frame): New procedure, extracted from
serve-client.
* web/socket/client.scm (websocket-receive): Call read-data-frame.
Clean up the websocket if the connection was closed.
* web/socket/server.scm (serve-client): Call read-data-frame.  Flush the
port after writing the handshake response.
---
 web/socket/frame.scm | 45 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 45 insertions(+)

(limited to 'web/socket/frame.scm')

diff --git a/web/socket/frame.scm b/web/socket/frame.scm
index f3709f6..b5c05e5 100644
--- a/web/socket/frame.scm
+++ b/web/socket/frame.scm
@@ -1,5 +1,6 @@
 ;;; guile-websocket --- WebSocket client/server
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2023 Andrew Whatson <whatson@tailcall.au>
 ;;;
 ;;; This file is part of guile-websocket.
 ;;;
@@ -64,6 +65,7 @@
             text-frames->string
 
             read-frame
+            read-data-frame
             write-frame))
 
 ;;;
@@ -322,6 +324,49 @@ MASKING-KEY."
          (data (read-data type masking-key length)))
     (make-frame final? type masking-key data)))
 
+(define* (read-data-frame port #:key echo-close?)
+  "Read frames from PORT until a complete data frame is received,
+handling any control frames transparently.  ECHO-CLOSE? should be #t
+if PORT represents the server end of a WebSocket connection."
+  (let loop ((fragments '())
+             (type #f))
+    (let ((frame (and (not (port-closed? port))
+                      (not (port-eof? port))
+                      (read-frame port))))
+      (cond
+       ;; EOF - port is closed.
+       ((not frame)
+        (close-port port)
+        #f)
+       ;; Per section 5.4, control frames may appear interspersed
+       ;; along with a fragmented message.
+       ((close-frame? frame)
+        (when echo-close?
+          ;; 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)) port)))
+        (close-port port)
+        #f)
+       ((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)) port)
+        (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
+        (make-frame #t type #f (frame-concatenate (reverse fragments))))
+       ((fragment-frame? frame) ; add a fragment
+        (loop (cons frame fragments) type))
+       ((data-frame? frame) ; unfragmented data frame
+        frame)
+       (else
+        (websocket-error "unexpected frame: " frame))))))
+
 
 ;;;
 ;;; Frame writer
-- 
cgit v1.2.3