summaryrefslogtreecommitdiff
path: root/web/socket
diff options
context:
space:
mode:
Diffstat (limited to 'web/socket')
-rw-r--r--web/socket/client.scm34
-rw-r--r--web/socket/frame.scm79
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