X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=8sync%2Fsystems%2Fwebsocket%2Fserver.scm;fp=8sync%2Fsystems%2Fwebsocket%2Fserver.scm;h=dd8db94421a9d1ad17fa089a1c3bdb0559e8e9e7;hp=080f0a5949748847541ebd255fd935f010bed09c;hb=d44e92b54f9e31956cd7b7e58ff22abcefd807ec;hpb=955c04b12d16f4e8850766afc0bd5921f2ba1cf7

diff --git a/8sync/systems/websocket/server.scm b/8sync/systems/websocket/server.scm
index 080f0a5..dd8db94 100644
--- a/8sync/systems/websocket/server.scm
+++ b/8sync/systems/websocket/server.scm
@@ -36,7 +36,8 @@
   #:use-module (8sync systems web)
   #:use-module (8sync systems websocket frame)
   #:use-module (8sync systems websocket utils)
-  #:export (<websocket-server>))
+  #:export (<websocket-server>
+            .websocket-handler))
 
 ;; See section 4.2 for explanation of the handshake.
 (define (read-handshake-request client-socket)
@@ -56,12 +57,15 @@ string."
                                 (connection . (upgrade))
                                 (sec-websocket-accept . ,accept-key)))))
 
-(define-actor <websocket-server> (<web-server>)
-  ((new-client websocket-client-loop))
+(define-class <websocket-server> (<web-server>)
+  (upgrade-paths #:init-value `(("websocket" .
+                                 ,(wrap-apply websocket-client-loop)))
+                 #:allocation #:each-subclass
+                 #:accessor .upgrade-paths)
   (websocket-handler #:init-keyword #:websocket-handler
                      #:getter .websocket-handler))
 
-(define (websocket-client-loop websocket-server message client)
+(define (websocket-client-loop websocket-server client request body)
   "Serve client connected via CLIENT by performing the HTTP
 handshake and listening for control and data frames.  HANDLER is
 called for each complete message that is received."
@@ -77,7 +81,6 @@ called for each complete message that is received."
                        (make-binary-frame result))
                       ((not result)
                        #f))))
-
       (when response
         (write-frame response client))))
 
@@ -89,8 +92,7 @@ called for each complete message that is received."
   (setvbuf client 'none)
 
   ;; Perform the HTTP handshake and upgrade to WebSocket protocol.
-  (let* ((request (read-handshake-request client))
-         (client-key (assoc-ref (request-headers request) 'sec-websocket-key))
+  (let* ((client-key (assoc-ref (request-headers request) 'sec-websocket-key))
          (response (make-handshake-response client-key)))
     (write-response response client)
     (let loop ((fragments '())