From: Jan (janneke) Nieuwenhuizen Date: Sun, 8 Nov 2020 07:30:39 +0000 (+0100) Subject: websocket: Gracefully handle read errors and socket close. X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=3fdb26d51c8e181dedc8489a1ba7859bd7741fad;p=8sync.git websocket: Gracefully handle read errors and socket close. * 8sync/systems/websocket/client.scm (websocket-socket-open?): New method. (websocket-loop): Use it to gracefully handle errors socket close. --- diff --git a/8sync/systems/websocket/client.scm b/8sync/systems/websocket/client.scm index 4ae342d..36ee4a9 100644 --- a/8sync/systems/websocket/client.scm +++ b/8sync/systems/websocket/client.scm @@ -145,6 +145,10 @@ (define-method (websocket-init (websocket ) message) (and=> (.url websocket) (cut websocket-open websocket message <>))) +(define-method (websocket-socket-open? (websocket )) + "Return #t if .SOCKET of WEBSOCKET is open." + (not (port-closed? (.socket websocket)))) + (define-method (websocket-loop (websocket ) message) (define (handle-data-frame type data) @@ -165,42 +169,49 @@ (let loop ((fragments '()) (type #f)) - (let* ((socket (.socket websocket)) - (frame (and (websocket-open? websocket) - (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 - ;; socket before closing the socket. The socket may no - ;; longer be listening. - (false-if-exception - (write-frame (make-close-frame (frame-data frame)) socket)) - (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)) 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 (cons frame 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)))))) + (catch #t + (lambda _ + (let* ((socket (.socket websocket)) + (frame (and (websocket-open? websocket) + (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 + ;; socket before closing the socket. The socket may no + ;; longer be listening. + (false-if-exception + (write-frame (make-close-frame (frame-data frame)) socket)) + (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)) 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 (cons frame 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 (key . args) + (let ((message (format #f "~a: ~s" key args))) + ((.on-error websocket) websocket (format #f "read failed: ~s\n" websocket)) + (if (websocket-socket-open? websocket) (loop '() #f) + (websocket-close websocket message))))))) ;; See Section 3 - WebSocket URIs (define (encrypted-websocket-scheme? uri)