From 025a207ada92d016e9ca67149cf8643fadfd6b88 Mon Sep 17 00:00:00 2001 From: Andrew Whatson Date: Mon, 24 Apr 2023 23:16:14 +1000 Subject: client: Support read timeouts on receive & close. * web/socket/client.scm (close-websocket): Add timeout parameter. Call read-close-frame with timeout. (websocket-receive): Add timeout parameter. Call read-data-frame with timeout. Don't close the websocket on timeout. * web/socket/frame.scm (port-readable?, port-writable?, frame-reader): New helper procedures. (read-close-frame): New procedure. (read-data-frame): Add timeout parameter. Use frame-reader to support a composed read timeout. --- web/socket/client.scm | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) (limited to 'web/socket/client.scm') diff --git a/web/socket/client.scm b/web/socket/client.scm index c867427..4510493 100644 --- a/web/socket/client.scm +++ b/web/socket/client.scm @@ -183,19 +183,15 @@ true, verify HTTPS server certificates." ws) (error "not a websocket uri" uri)))) -(define (close-websocket ws) - "Close the WebSocket connection for the client WS." +(define* (close-websocket ws #:key (timeout 1)) + "Close the WebSocket connection for the client WS, waiting up to +TIMEOUT seconds (default 1 second) for a graceful shutdown." (let ((socket (websocket-socket ws))) (set-websocket-state! ws 'closing) (write-frame (make-close-frame (make-bytevector 0)) socket) ;; Per section 5.5.1 , wait for the server to close the connection ;; for a reasonable amount of time. - (let loop () - (match (select #() (vector socket) #() 1) ; 1 second timeout - ((#() #(socket) #()) ; there is output to read - (unless (port-eof? socket) - (read-frame socket) ; throw it away - (loop))))) + (read-close-frame socket #:timeout timeout) (close-port socket) (close-port (websocket-entropy-port ws)) (set-websocket-state! ws 'closed) @@ -213,15 +209,18 @@ connected to." (write-frame (make-text-frame data (generate-masking-key ws)) (websocket-socket ws))) -(define (websocket-receive ws) +(define* (websocket-receive ws #:key timeout) "Read data from the server that WS is connected to. Returns a string if text data was received, a bytevector if binary data was received, -or #f if the WebSocket connection was closed." - (let ((frame (read-data-frame (websocket-socket ws)))) +or #f if the WebSocket connection was closed or TIMEOUT seconds +elapsed without receiving a data frame." + (let* ((socket (websocket-socket ws)) + (frame (read-data-frame socket #:timeout timeout))) (cond ((not frame) - (close-port (websocket-socket ws)) - (close-port (websocket-entropy-port ws)) - (set-websocket-state! ws 'closed) + (when (port-closed? socket) + ;; EOF - clean up the websocket. + (close-port (websocket-entropy-port ws)) + (set-websocket-state! ws 'closed)) #f) ((binary-frame? frame) (frame-data frame)) -- cgit v1.2.3