diff options
| -rw-r--r-- | web/socket/frame.scm | 61 |
1 files changed, 31 insertions, 30 deletions
diff --git a/web/socket/frame.scm b/web/socket/frame.scm index 9319c18..4c15a09 100644 --- a/web/socket/frame.scm +++ b/web/socket/frame.scm @@ -342,41 +342,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) @@ -417,10 +419,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) |