diff options
Diffstat (limited to 'web/socket/server.scm')
| -rw-r--r-- | web/socket/server.scm | 42 |
1 files changed, 6 insertions, 36 deletions
diff --git a/web/socket/server.scm b/web/socket/server.scm index 2d1694d..3394d3b 100644 --- a/web/socket/server.scm +++ b/web/socket/server.scm @@ -1,6 +1,7 @@ ;;; guile-websocket --- WebSocket client/server ;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2021 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> +;;; Copyright © 2023 Andrew Whatson <whatson@tailcall.au> ;;; ;;; This file is part of guile-websocket. ;;; @@ -87,48 +88,17 @@ called for each complete message that is received." (when response (write-frame response client-socket)))) - (define (read-frame-maybe) - (and (not (port-eof? client-socket)) - (read-frame client-socket))) - ;; Perform the HTTP handshake and upgrade to WebSocket protocol. (let* ((request (read-handshake-request client-socket)) (client-key (assoc-ref (request-headers request) 'sec-websocket-key)) (response (make-handshake-response client-key))) (write-response response client-socket) - (let loop ((fragments '()) - (type #f)) - (let ((frame (read-frame-maybe))) - (cond - ;; EOF - port is closed. - ((not frame) - (close-port client-socket)) - ;; 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-socket)) - (close-port client-socket)) - ((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-socket) - (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 + (force-output client-socket) + (let loop () + (let ((frame (read-data-frame client-socket #:echo-close? #t))) + (when frame (handle-data-frame (frame-type frame) (frame-data frame)) - (loop '() #f))))))) + (loop)))))) (define* (run-server handler #:optional (server-socket (make-server-socket))) "Run WebSocket server on SERVER-SOCKET. HANDLER, a procedure that |