diff options
| -rw-r--r-- | web/socket/client.scm | 36 | ||||
| -rw-r--r-- | web/socket/frame.scm | 66 | ||||
| -rw-r--r-- | web/socket/server.scm | 10 |
3 files changed, 61 insertions, 51 deletions
diff --git a/web/socket/client.scm b/web/socket/client.scm index 4510493..966e3f7 100644 --- a/web/socket/client.scm +++ b/web/socket/client.scm @@ -211,18 +211,24 @@ connected to." (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 or TIMEOUT seconds -elapsed without receiving a data frame." - (let* ((socket (websocket-socket ws)) - (frame (read-data-frame socket #:timeout timeout))) - (cond ((not frame) - (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)) - (else - (text-frame->string frame))))) +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." + (let ((socket (websocket-socket ws))) + ;; For server initiated disconnects and timeouts. + (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 + (maybe-close) + #f) + ((? close-frame? frame) + (maybe-close) + (close-frame->status frame)) + ((? binary-frame? frame) + (frame-data frame)) + ((? text-frame? frame) + (text-frame->string frame))))) diff --git a/web/socket/frame.scm b/web/socket/frame.scm index 9319c18..7f52e96 100644 --- a/web/socket/frame.scm +++ b/web/socket/frame.scm @@ -68,7 +68,8 @@ read-frame read-data-frame read-close-frame - write-frame)) + write-frame + close-frame->status)) ;;; ;;; WebSocket frames @@ -342,41 +343,43 @@ Returns #t if the port is writable, or #f on timeout." ((#() #(port) #()) #t) (else #f))) -(define* (frame-reader port #:key timeout) - "Return a generator which will read a frame from PORT on each call, -until TIMEOUT seconds have elapsed. This is used to implement timeouts -over composed read operations." - (define timeout-at-real-time - (and timeout - (exact->inexact - (floor (+ (get-internal-real-time) - (* internal-time-units-per-second - timeout)))))) - (define (timeout-remaining) - (and timeout - (/ (- timeout-at-real-time - (get-internal-real-time)) - internal-time-units-per-second))) - (lambda () - (cond ((port-closed? port) - #f) - ((not (port-readable? port (timeout-remaining))) - #f) - ((port-eof? port) - (eof-object)) - (else - (read-frame port))))) +(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 next-frame - (frame-reader port #:timeout timeout)) + (define deadline (make-deadline timeout)) (let loop ((fragments '()) (type #f)) - (let ((frame (next-frame))) + (let ((frame (read-frame/deadline port deadline))) (cond ;; EOF - port is closed. ((eof-object? frame) @@ -395,7 +398,7 @@ WebSocket connection." (false-if-exception (write-frame (make-close-frame (frame-data frame)) port))) (close-port port) - #f) + frame) ((ping-frame? frame) ;; Per section 5.5.3, a pong frame must include the exact ;; same data as the ping frame. @@ -417,10 +420,9 @@ WebSocket connection." (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 next-frame - (frame-reader port #:timeout timeout)) + (define deadline (make-deadline timeout)) (let loop () - (let ((frame (next-frame))) + (let ((frame (read-frame/deadline port deadline))) (cond ((not (frame? frame)) #f) ((close-frame? frame) diff --git a/web/socket/server.scm b/web/socket/server.scm index 3394d3b..353a2eb 100644 --- a/web/socket/server.scm +++ b/web/socket/server.scm @@ -95,10 +95,12 @@ called for each complete message that is received." (write-response response client-socket) (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)))))) + (match (read-data-frame client-socket #:echo-close? #t) + ((or #f (? close-frame?)) + (values)) + (frame + (handle-data-frame (frame-type frame) (frame-data frame)) + (loop)))))) (define* (run-server handler #:optional (server-socket (make-server-socket))) "Run WebSocket server on SERVER-SOCKET. HANDLER, a procedure that |