Remove timeout handling that is incompatible with suspendable ports.HEADmaster

Timeouts should be handled by a concurrency layer such as fibers.

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