From ccecc46b64a24c6e9ec01c9e5d3a9fcb2295fcf0 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Fri, 25 Mar 2016 10:57:20 -0400
Subject: client: Keep track of socket state.

* web/socket/client.scm (<websocket>)[state]: New field.
(websocket-state, set-websocket-state!): New field accessors.
(websocket-connecting?, websocket-open?, websocket-closing?,
websocket-closed?): New procedures.
(handshake): Set socket to 'open' state after successful handshake.
(make-websocket): Set socket to 'connecting' state initially.
(close-websocket): Set socket to 'closing' before sending close frame,
and then to 'closed' underlying TCP socket is closed.
---
 web/socket/client.scm | 49 +++++++++++++++++++++++++++++++++++++------------
 1 file changed, 37 insertions(+), 12 deletions(-)

(limited to 'web/socket')

diff --git a/web/socket/client.scm b/web/socket/client.scm
index 7be9c2c..3c32894 100644
--- a/web/socket/client.scm
+++ b/web/socket/client.scm
@@ -37,6 +37,11 @@
   #:export (make-websocket
             websocket?
             websocket-uri
+            websocket-state
+            websocket-connecting?
+            websocket-open?
+            websocket-closing?
+            websocket-closed?
             close-websocket
             websocket-send
             websocket-receive))
@@ -74,12 +79,28 @@ scheme."
     (connect s (addrinfo:addr info))
     s))
 
-;; TODO: Add 'state' field (connecting, open, closing, closed)
 (define-record-type <websocket>
-  (%make-websocket uri socket)
+  (%make-websocket uri socket state)
   websocket?
   (uri websocket-uri)
-  (socket websocket-socket))
+  (socket websocket-socket)
+  (state websocket-state set-websocket-state!))
+
+(define (websocket-connecting? ws)
+  "Return #t if the WebSocket WS is in the connecting state."
+  (eq? (websocket-state ws) 'connecting))
+
+(define (websocket-open? ws)
+  "Return #t if the WebSocket WS is in the open state."
+  (eq? (websocket-state ws) 'open))
+
+(define (websocket-closing? ws)
+  "Return #t if the WebSocket WS is in the closing state."
+  (eq? (websocket-state ws) 'closing))
+
+(define (websocket-closed? ws)
+  "Return #t if the WebSocket WS is in the closed state."
+  (eq? (websocket-state ws) 'closed))
 
 ;; See Section 4.1 - Client Requirements
 (define (make-handshake-request uri)
@@ -103,13 +124,15 @@ remote resource described by URI."
          (connection (assoc-ref headers 'connection))
          (accept (assoc-ref headers 'sec-websocket-accept)))
     ;; Validate the handshake.
-    (unless (and (= (response-code response) 101)
-                 (string-ci=? (car upgrade) "websocket")
-                 (equal? connection '(upgrade))
-                 ;; TODO: authenticate accept key.
-                 )
-      (close-websocket ws)
-      (error "websocket handshake failed" (websocket-uri ws)))))
+    (if (and (= (response-code response) 101)
+             (string-ci=? (car upgrade) "websocket")
+             (equal? connection '(upgrade))
+             ;; TODO: authenticate accept key.
+             )
+        (set-websocket-state! ws 'open)
+        (begin
+          (close-websocket ws)
+          (error "websocket handshake failed" (websocket-uri ws))))))
 
 (define (make-websocket uri-or-string)
   "Create and establish a new WebSocket connection for the remote
@@ -118,7 +141,7 @@ resource described by URI-OR-STRING."
                ((? uri? uri) uri)
                ((? string? str) (string->uri str)))))
     (if (websocket-uri? uri)
-        (let ((ws (%make-websocket uri (make-client-socket uri))))
+        (let ((ws (%make-websocket uri (make-client-socket uri) 'connecting)))
           (handshake ws)
           ws)
         (error "not a websocket uri" uri))))
@@ -126,6 +149,7 @@ resource described by URI-OR-STRING."
 (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.
@@ -135,7 +159,8 @@ resource described by URI-OR-STRING."
          (unless (port-eof? socket)
            (read-frame socket) ; throw it away
            (loop)))))
-    (close-port socket)))
+    (close-port socket)
+    (set-websocket-state! ws 'closed)))
 
 (define (websocket-send ws data)
   "Send DATA, a string or bytevector, to the server that WS is
-- 
cgit v1.2.3