Skip to content

Commit

Permalink
Fix many issues with server connections.
Browse files Browse the repository at this point in the history 
There is still an issue with multibyte strings, though.
  • Loading branch information
@ahyatt
ahyatt committed Aug 13, 2012
1 parent 0202adc commit 74d5c10
Show file tree
Hide file tree
Showing 2 changed files with 47 additions and 14 deletions.
33 changes: 32 additions & 1 deletion websocket-test.el
View file
Expand Up @@ -202,7 +202,8 @@
(base-headers (concat "Host: www.example.com\r\n" (base-headers (concat "Host: www.example.com\r\n"
"Upgrade: websocket\r\n" "Upgrade: websocket\r\n"
"Connection: Upgrade\r\n" "Connection: Upgrade\r\n"
"Sec-WebSocket-Key: key\r\n" (format "Sec-WebSocket-Key: %s\r\n"
(websocket-calculate-accept "key"))
"Origin: mysystem\r\n" "Origin: mysystem\r\n"
"Sec-WebSocket-Version: 13\r\n"))) "Sec-WebSocket-Version: 13\r\n")))
(should (equal (concat base-headers "\r\n") (should (equal (concat base-headers "\r\n")
Expand Down Expand Up @@ -509,3 +510,33 @@
(should-not closed) (should-not closed)
(should (equal response "response")) (should (equal response "response"))
(should processed))))) (should processed)))))

(ert-deftest websocket-complete-server-response-test ()
;; Example taken from RFC
(should (equal
(concat "HTTP/1.1 101 Switching Protocols\r\n"
"Upgrade: websocket\r\n"
"Connection: Upgrade\r\n"
"Sec-WebSocket-Accept: s3pPLMBiTxaQ9kYGzzhZRbK+xOo=\r\n"
"Sec-WebSocket-Protocol: chat\r\n\r\n"
)
(let ((header-info
(websocket-verify-client-headers
(concat "GET /chat HTTP/1.1\r\n"
"Host: server.example.com\r\n"
"Upgrade: websocket\r\n"
"Connection: Upgrade\r\n"
"Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==\r\n"
"Origin: http://example.com\r\n"
"Sec-WebSocket-Protocol: chat, superchat\r\n"
"Sec-WebSocket-Version: 13\r\n"))))
(should header-info)
(let ((ws (websocket-inner-create
:conn t :url t
:accept-string (websocket-calculate-accept
(plist-get header-info :key))
:protocols '("chat"))))
(websocket-get-server-response
ws
(plist-get header-info :protocols)
(plist-get header-info :extension)))))))
28 changes: 15 additions & 13 deletions websocket.el
View file
Expand Up @@ -521,11 +521,12 @@ describing the problem with the frame.
(message "Connected from %S: %s" client message) (message "Connected from %S: %s" client message)
(let ((ws (websocket-inner-create (let ((ws (websocket-inner-create
:conn client :conn client
:on-open (or (process-get proc :on-open) 'identity) :url client
:on-message (or (process-get proc :on-message) (lambda (ws frame))) :on-open (or (process-get server :on-open) 'identity)
:on-error (or (process-get proc :on-error) 'identity) :on-message (or (process-get server :on-message) (lambda (ws frame)))
:protocol (process-get proc :protocol) :on-error (or (process-get server :on-error) 'identity)
:extensions (mapcar 'car (process-get proc :extensions))))) :protocols (process-get server :protocol)
:extensions (mapcar 'car (process-get server :extensions)))))
(process-put client :websocket ws) (process-put client :websocket ws)
(set-process-filter client 'websocket-server-filter))) (set-process-filter client 'websocket-server-filter)))


Expand All @@ -538,7 +539,7 @@ messages and a plist containing `:key', the websocket key,
(block nil (block nil
(let ((case-fold-search t) (let ((case-fold-search t)
(plist)) (plist))
(unless (string-match "^HTTP/1.1" output) (unless (string-match "HTTP/1.1" output)
(message "Websocket client connection: HTTP/1.1 not found") (message "Websocket client connection: HTTP/1.1 not found")
(return nil)) (return nil))
(unless (string-match "^Host: " output) (unless (string-match "^Host: " output)
Expand All @@ -548,18 +549,17 @@ messages and a plist containing `:key', the websocket key,
(message "Websocket client connection: Upgrade: websocket not found") (message "Websocket client connection: Upgrade: websocket not found")
(return nil)) (return nil))
(if (string-match "^Sec-WebSocket-Key: \\([[:graph:]]+\\)\r\n" output) (if (string-match "^Sec-WebSocket-Key: \\([[:graph:]]+\\)\r\n" output)
(setq plist (plist-put plist :key (base64-decode-string (setq plist (plist-put plist :key (match-string 1 output)))
(match-string 1 output))))
(message "Websocket client connect: No key sent") (message "Websocket client connect: No key sent")
(return nil)) (return nil))
(unless (string-match "^Sec-WebSocket-Version: 13" output) (unless (string-match "^Sec-WebSocket-Version: 13" output)
(message "Websocket client connect: Websocket version 13 not found") (message "Websocket client connect: Websocket version 13 not found")
(return nil)) (return nil))
(when (string-match "^Sec-WebSocket-Protocol: \\([[:graph:]]+\\)\r\n" output) (when (string-match "^Sec-WebSocket-Protocol:" output)
(setq plist (plist-put plist :protocols (websocket-parse-repeated-field (setq plist (plist-put plist :protocols (websocket-parse-repeated-field
output output
"Sec-Websocket-Protocol")))) "Sec-Websocket-Protocol"))))
(when (string-match "^Sec-WebSocket-Extensions: \\([[:graph:]]+\\)\r\n" output) (when (string-match "^Sec-WebSocket-Extensions:" output)
(setq plist (plist-put plist :extensions (websocket-parse-repeated-field (setq plist (plist-put plist :extensions (websocket-parse-repeated-field
output output
"Sec-Websocket-Extensions")))) "Sec-Websocket-Extensions"))))
Expand All @@ -577,7 +577,7 @@ messages and a plist containing `:key', the websocket key,
(when pos (+ 4 pos))))) (when pos (+ 4 pos)))))
(if end-of-header-pos (if end-of-header-pos
(progn (progn
(let ((header-info (websocket-verify-client-headers ws text))) (let ((header-info (websocket-verify-client-headers text)))
(if header-info (if header-info
(progn (setf (websocket-accept-string ws) (progn (setf (websocket-accept-string ws)
(websocket-calculate-accept (websocket-calculate-accept
Expand Down Expand Up @@ -639,12 +639,14 @@ messages and a plist containing `:key', the websocket key,
separator))) separator)))


(defun* websocket-server (port &rest plist) (defun* websocket-server (port &rest plist)
"Open a websocket server on PORT." "Open a websocket server on PORT.
PORT can be `t' to get a random port."
(let* ((conn (make-network-process (let* ((conn (make-network-process
:name (format "websocket server on port %d" port) :name (format "websocket server on port %d" port)
:server t :server t
:family 'ipv4 :family 'ipv4
:log 'websocket-server-accept :log 'websocket-server-accept
:filter-multibyte nil
:plist plist :plist plist
:host 'local :host 'local
:service port :service port
Expand Down Expand Up @@ -832,7 +834,7 @@ connection is invalid, the connection will be closed."
(setf (websocket-inflight-input websocket) (setf (websocket-inflight-input websocket)
(substring text start-point))) (substring text start-point)))
(dolist (to-process (nreverse processing-queue)) (dolist (to-process (nreverse processing-queue))
(funcall to-process))))) (funcall to-process))))


(defun websocket-send-text (websocket text) (defun websocket-send-text (websocket text)
"To the WEBSOCKET, send TEXT as a complete frame." "To the WEBSOCKET, send TEXT as a complete frame."
Expand Down

0 comments on commit 74d5c10

Please sign in to comment.