diff options
| -rw-r--r-- | web/socket/client.scm | 34 | ||||
| -rw-r--r-- | web/socket/frame.scm | 79 |
2 files changed, 32 insertions, 81 deletions
diff --git a/web/socket/client.scm b/web/socket/client.scm index 966e3f7..d3a9cb8 100644 --- a/web/socket/client.scm +++ b/web/socket/client.scm @@ -183,15 +183,16 @@ true, verify HTTPS server certificates." ws) (error "not a websocket uri" uri)))) -(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." +(define (close-websocket ws) + "Close the WebSocket connection for the client WS." (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. - (read-close-frame socket #:timeout timeout) + ;; Per section 5.5.1, wait for the server to close the connection. + (let loop () + (match (read-frame socket) + ((or #f (? close-frame?)) (values)) + (_ (loop)))) (close-port socket) (close-port (websocket-entropy-port ws)) (set-websocket-state! ws 'closed) @@ -209,20 +210,29 @@ connected to." (write-frame (make-text-frame data (generate-masking-key ws)) (websocket-socket ws))) -(define* (websocket-receive ws #:key timeout) +;; TODO: Close frames should be echoed back if the server initiated +;; the disconnect. +;; +;; Per section 5.5.1: +;; +;; If an endpoint receives a Close frame and did not previously send a +;; Close frame, the endpoint MUST send a Close frame in response. +;; (When sending a Close frame in response, the endpoint typically +;; echos the status code it received.) It SHOULD do so as soon as +;; practical. +(define (websocket-receive ws) "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, a -pair of (code . reason) if the WebSocket was closed, or #f if TIMEOUT -seconds elapsed without receiving a data frame." +pair of (code . reason) if the WebSocket was closed." (let ((socket (websocket-socket ws))) - ;; For server initiated disconnects and timeouts. + ;; For server initiated disconnects. (define (maybe-close) (when (port-closed? socket) ;; EOF - clean up the websocket. (close-port (websocket-entropy-port ws)) (set-websocket-state! ws 'closed))) - (match (read-data-frame socket #:timeout timeout) - (#f ; timeout + (match (read-data-frame socket) + (#f ; EOF or socket closed. (maybe-close) #f) ((? close-frame? frame) diff --git a/web/socket/frame.scm b/web/socket/frame.scm index 7f52e96..987fca0 100644 --- a/web/socket/frame.scm +++ b/web/socket/frame.scm @@ -67,7 +67,6 @@ read-frame read-data-frame - read-close-frame write-frame close-frame->status)) @@ -327,66 +326,19 @@ MASKING-KEY." (data (read-data type masking-key length))) (make-frame final? type masking-key data))) -(define* (port-readable? port #:optional timeout) - "Wait for PORT to become readable or TIMEOUT seconds to elapse. -Returns #t if the port is readable, or #f on timeout." - ;; TODO: Integrate with suspendable-ports & fibers. - (match (select (vector (port-read-wait-fd port)) #() #() timeout) - ((#(port) #() #()) #t) - (else #f))) - -(define* (port-writable? port #:optional timeout) - "Wait for PORT to become writable, or TIMEOUT seconds to elapse. -Returns #t if the port is writable, or #f on timeout." - ;; TODO: Integrate with suspendable-ports & fibers. - (match (select #() (vector (port-write-wait-fd port)) #() timeout) - ((#() #(port) #()) #t) - (else #f))) - -(define (make-deadline timeout) - "Calculate a deadline in internal time units which will expire -TIMEOUT seconds in the future. Returns #f if TIMEOUT is false." - (and timeout (exact->inexact - (floor (+ (get-internal-real-time) - (* internal-time-units-per-second - timeout)))))) - -(define (deadline-seconds-remaining deadline) - "Calculate the number of seconds remaining until DEADLINE is reached. -Returns #f if DEADLINE is false." - (and deadline (/ (- deadline - (get-internal-real-time)) - internal-time-units-per-second))) - -(define* (read-frame/deadline port deadline) - "Attempt to read a frame from PORT until either a complete frame is -received or DEADLINE is reached. Returns #f if PORT is closed or the -operation times out." - (cond ((port-closed? port) - #f) - ((not (port-readable? port (deadline-seconds-remaining deadline))) - #f) - ((port-eof? port) - (eof-object)) - (else - (read-frame port)))) - -(define* (read-data-frame port #:key echo-close? timeout) - "Read frames from PORT until a complete data frame is received or -TIMEOUT seconds have elapsed, handling any control frames transparently. -ECHO-CLOSE? should be #t if PORT represents the server end of a -WebSocket connection." - (define deadline (make-deadline timeout)) +;; TODO: Remove echo-close? arg. Just return the close frame and let +;; the client/server implementation DTRT from there. +(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 (read-frame/deadline port deadline))) + (let ((frame (read-frame port))) (cond ;; EOF - port is closed. - ((eof-object? frame) - (close-port port) - #f) - ;; Read timeout or already closed. ((not frame) + (close-port port) #f) ;; Per section 5.4, control frames may appear interspersed ;; along with a fragmented message. @@ -395,6 +347,8 @@ WebSocket connection." ;; Per section 5.5.1, echo the close frame back to the ;; client before closing the socket. The client may no ;; longer be listening. + ;; + ;; TODO: Use with-exception-handler. (false-if-exception (write-frame (make-close-frame (frame-data frame)) port))) (close-port port) @@ -417,19 +371,6 @@ WebSocket connection." (else (websocket-error "unexpected frame: " frame)))))) -(define* (read-close-frame port #:key timeout) - "Read frames from PORT until a close frame is received or TIMEOUT -seconds have elapsed, ignoring control and data frames." - (define deadline (make-deadline timeout)) - (let loop () - (let ((frame (read-frame/deadline port deadline))) - (cond ((not (frame? frame)) - #f) - ((close-frame? frame) - #t) - (else - (loop)))))) - ;;; ;;; Frame writer |