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