diff options
Diffstat (limited to 'web/socket/frame.scm')
| -rw-r--r-- | web/socket/frame.scm | 79 |
1 files changed, 10 insertions, 69 deletions
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 |