branch: externals/websocket
commit 413702e94fd95b796e2944705cbac63ca5131859
Author: Andrew Hyatt <ahy...@gmail.com>
Commit: Andrew Hyatt <ahy...@gmail.com>
Update websocket library to version 1.13.
The major changes are:
- Made all tests runnable via ert, and re-introduced the python-based
webserver test.
- Fixes an issue with infinite loops when websockets get an error. We now
do not attempt to reconnect when the connection is dropped.
- Fixes an issue with nowait connection timings.
- Fixes an issue with handshake protocol that was an issue on some servers.
---
testserver.py | 7 +-
websocket-functional-test.el | 227 +++++++++++-----------------
websocket-test.el | 347 ++++++++++++++++++++++++++++++-------------
websocket.el | 39 ++---
4 files changed, 343 insertions(+), 277 deletions(-)
diff --git a/testserver.py b/testserver.py
index 5cfcb96..46cf62d 100644
--- a/testserver.py
+++ b/testserver.py
@@ -1,3 +1,4 @@
+#!/usr/bin/env python3
import logging
import tornado
import tornado.web
@@ -12,8 +13,8 @@ class EchoWebSocket(websocket.WebSocketHandler):
logging.info("OPEN")
def on_message(self, message):
- logging.info(u"ON_MESSAGE: {0}".format(message))
- self.write_message(u"You said: {0}".format(message))
+ logging.info("ON_MESSAGE: {0}".format(message))
+ self.write_message(message)
def on_close(self):
logging.info("ON_CLOSE")
@@ -29,6 +30,6 @@ if __name__ == "__main__":
(r"/", EchoWebSocket),
])
server = httpserver.HTTPServer(application)
- server.listen(9999)
+ server.listen(9999, "127.0.0.1")
logging.info("STARTED: Server start listening")
ioloop.IOLoop.instance().start()
diff --git a/websocket-functional-test.el b/websocket-functional-test.el
index cc9ac70..8a599d0 100644
--- a/websocket-functional-test.el
+++ b/websocket-functional-test.el
@@ -4,7 +4,7 @@
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 3 of the
+;; published by the Free Software Foundation; either version 2 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
@@ -17,147 +17,90 @@
;;; Commentary:
-;; Usage: emacs -batch -Q -L . -l websocket-functional-test.el
+;; These are functional tests that may fail for various environmental reasons,
+;; such as blocked ports. For example Windows users have to have gnutls DLLs in
+;; the Emacs bin directory for this to work. A firewall may also interfere with
+;; these tests.
;;
-;; Note: this functional tests requires that you have python with the
-;; Tornado web server. See http://www.tornadoweb.org/en/stable/ for
-;; information on aquiring.
+;; These tests are written to test the basic connectivity and message-sending.
+;; Corner-cases and error handling is tested in websocket-test.el.
-(require 'tls) ;; tests a particular bug we had on emacs 23
-(setq debug-on-error t)
+(require 'tls) ;; tests a particular bug we had on Emacs 23
(require 'websocket)
-(eval-when-compile (require 'cl))
-
-;;;;;;;;;;;;;;;;;;;;;;;
-;; Local server test ;;
-;;;;;;;;;;;;;;;;;;;;;;;
-
-(message "Testing with local server")
-
-(setq websocket-debug t)
-
-(defvar wstest-server-buffer (get-buffer-create "*wstest-server*"))
-(defvar wstest-server-name "wstest-server")
-(defvar wstest-server-proc
- (start-process wstest-server-name wstest-server-buffer
- "python" "testserver.py" "--log_to_stderr" "--logging=debug"))
-(sleep-for 1)
-
-(defvar wstest-msgs nil)
-(defvar wstest-closed nil)
-
-(message "Opening the websocket")
-
-(defvar wstest-ws
- (websocket-open
- "ws://127.0.0.1:9999"
- :on-message (lambda (_websocket frame)
- (push (websocket-frame-text frame) wstest-msgs)
- (message "ws frame: %S" (websocket-frame-text frame))
- (error "Test error (expected)"))
- :on-close (lambda (_websocket) (setq wstest-closed t))))
-
-(defun wstest-pop-to-debug ()
- "Open websocket log buffer. Not used in testing. Just for debugging."
- (interactive)
- (pop-to-buffer (websocket-get-debug-buffer-create wstest-ws)))
-
-(sleep-for 0.1)
-(assert (websocket-openp wstest-ws))
-
-(assert (null wstest-msgs))
-
-(websocket-send-text wstest-ws "你好")
-
-(sleep-for 0.1)
-(assert (equal (car wstest-msgs) "You said: 你好"))
-(setf (websocket-on-error wstest-ws) (lambda (_ws _type _err)))
-(websocket-send-text wstest-ws "Hi after error!")
-(sleep-for 0.1)
-(assert (equal (car wstest-msgs) "You said: Hi after error!"))
-
-(websocket-close wstest-ws)
-(assert (null (websocket-openp wstest-ws)))
-
-(if (not (eq system-type 'windows-nt))
- ; Windows doesn't have support for the SIGSTP signal, so we'll just kill
- ; the process.
- (stop-process wstest-server-proc))
-(kill-process wstest-server-proc)
-
-;; Make sure the processes are closed. This happens asynchronously,
-;; so let's wait for it.
-(sleep-for 1)
-(assert (null (process-list)) t)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Remote server test, with wss ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; echo.websocket.org has an untrusted certificate, for the test to
-;; proceed, we need to disable trust checking.
-(setq tls-checktrust nil)
-
-(when (>= (string-to-number (substring emacs-version 0 2)) 24)
- (message "Testing with wss://echo.websocket.org")
- (when (eq system-type 'windows-nt)
- (message "Windows users must have gnutls DLLs in the emacs bin
directory."))
- (setq wstest-ws
- (websocket-open
- "wss://echo.websocket.org"
- :on-open (lambda (_websocket)
- (message "Websocket opened"))
- :on-message (lambda (_websocket frame)
- (push (websocket-frame-text frame) wstest-msgs)
- (message "ws frame: %S" (websocket-frame-text frame)))
- :on-close (lambda (_websocket)
- (message "Websocket closed")
- (setq wstest-closed t)))
- wstest-msgs nil)
- (sleep-for 0.3)
- (assert (websocket-openp wstest-ws))
- (sleep-for 0.6)
- (assert (eq 'open (websocket-ready-state wstest-ws)))
- (assert (null wstest-msgs))
- (websocket-send-text wstest-ws "Hi!")
- (sleep-for 1)
- (assert (equal (car wstest-msgs) "Hi!"))
- (websocket-close wstest-ws))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Local client and server ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(message "Testing with emacs websocket server.")
-(message "If this does not pass, make sure your firewall allows the
connection.")
-(setq wstest-closed nil)
-(let ((server-conn (websocket-server
- 9998
- :host 'local
- :on-message (lambda (ws frame)
- (message "Server received text!")
- (websocket-send-text
- ws (websocket-frame-text frame)))
- :on-open (lambda (_websocket) "Client connection opened!")
- :on-close (lambda (_websocket)
- (setq wstest-closed t)))))
- (setq wstest-msgs nil
- wstest-ws
- (websocket-open
- "ws://localhost:9998"
- :on-message (lambda (_websocket frame)
- (message "ws frame: %S" (websocket-frame-text frame))
- (push
- (websocket-frame-text frame) wstest-msgs))))
-
- (assert (websocket-openp wstest-ws))
- (websocket-send-text wstest-ws "你好")
- (sleep-for 0.3)
- (assert (equal (car wstest-msgs) "你好"))
- (websocket-server-close server-conn))
-(assert wstest-closed)
-(websocket-close wstest-ws)
-
-(sleep-for 1)
-(assert (null (process-list)) t)
-(message "\nAll tests passed!\n")
+(require 'cl)
+
+;;; Code:
+
+(defmacro websocket-test-wait-with-timeout (timeout &rest body)
+ "Run BODY until true or TIMEOUT (in seconds) is reached.
+
+Will return false if the timeout was reached. This macro is not
+written to be used widely."
+ `(let ((begin (current-time))
+ (result nil))
+ (while (and (< (- (float-time (time-subtract (current-time) begin)))
,timeout) (not result))
+ (setq result ,@body)
+ (sleep-for 0.5))
+ result))
+
+(defun websocket-functional-client-test (wstest-server-url)
+ "Run the main part of an ert test against WSTEST-SERVER-URL."
+ ;; the server may have an untrusted certificate, for the test to proceed, we
+ ;; need to disable trust checking.
+ (let* ((tls-checktrust nil)
+ (wstest-closed nil)
+ (wstest-msg)
+ (wstest-server-proc)
+ (wstest-ws
+ (websocket-open
+ wstest-server-url
+ :on-message (lambda (_websocket frame)
+ (setq wstest-msg (websocket-frame-text frame)))
+ :on-close (lambda (_websocket) (setq wstest-closed t)))))
+ (should (websocket-test-wait-with-timeout 2 (websocket-openp wstest-ws)))
+ (should (websocket-test-wait-with-timeout 2 (eq 'open
(websocket-ready-state wstest-ws))))
+ (should (null wstest-msg))
+ (websocket-send-text wstest-ws "Hi!")
+ (should (websocket-test-wait-with-timeout 5 (equal wstest-msg "Hi!")))
+ (websocket-close wstest-ws)))
+
+(ert-deftest websocket-client-with-local-server ()
+ ;; If testserver.py cannot start, this test will fail. In general, if you
+ ;; don't care about avoiding outside connections, the remote server variant
is
+ ;; usually easier to run, and tests the same things..
+ (let ((proc (start-process
+ "websocket-testserver" "*websocket-testserver*"
+ "python3" "testserver.py" "--log_to_stderr" "--logging=debug")))
+ (when proc
+ (sleep-for 1)
+ (websocket-functional-client-test "ws://127.0.0.1:9999"))))
+
+(ert-deftest websocket-client-with-remote-server ()
+ ;; Emacs previous to Emacs 24 cannot handle wss.
+ (if (>= (string-to-number (substring emacs-version 0 2)) 24)
+ (websocket-functional-client-test "wss://echo.websocket.org")
+ (websocket-functional-client-test "ws://echo.websocket.org")))
+
+(ert-deftest websocket-server ()
+ (let* ((wstest-closed)
+ (wstest-msg)
+ (server-conn (websocket-server
+ 9998
+ :host 'local
+ :on-message (lambda (ws frame)
+ (websocket-send-text
+ ws (websocket-frame-text frame)))
+ :on-close (lambda (_websocket)
+ (setq wstest-closed t))))
+ (wstest-ws (websocket-open
+ "ws://localhost:9998"
+ :on-message (lambda (_websocket frame)
+ (setq wstest-msg (websocket-frame-text
frame))))))
+ (should (websocket-test-wait-with-timeout 1 (websocket-openp wstest-ws)))
+ (websocket-send-text wstest-ws "你好")
+ (should (websocket-test-wait-with-timeout 1 (equal wstest-msg "你好")))
+ (websocket-server-close server-conn)
+ (should (websocket-test-wait-with-timeout 1 wstest-closed))))
+
+(provide 'websocket-functional-test)
+;;; websocket-functional-test.el ends here
diff --git a/websocket-test.el b/websocket-test.el
index 5de21d3..c133272 100644
--- a/websocket-test.el
+++ b/websocket-test.el
@@ -7,7 +7,7 @@
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 3 of the
+;; published by the Free Software Foundation; either version 2 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
@@ -111,32 +111,41 @@
(ert-deftest websocket-verify-response-code ()
(should (websocket-verify-response-code "HTTP/1.1 101"))
(should
- (eq 400 (cdr (should-error (websocket-verify-response-code "HTTP/1.1 400")
- :type 'websocket-received-error-http-response))))
+ (equal '(400) (cdr (should-error (websocket-verify-response-code "HTTP/1.1
400")
+ :type
'websocket-received-error-http-response))))
(should
- (eq 200 (cdr (should-error (websocket-verify-response-code "HTTP/1.1
200"))))))
+ (equal '(200) (cdr (should-error (websocket-verify-response-code "HTTP/1.1
200")))))
+ (should-error (websocket-verify-response-code "HTTP/1.")
+ :type 'websocket-invalid-header))
(ert-deftest websocket-verify-headers ()
(let ((accept "Sec-WebSocket-Accept: s3pPLMBiTxaQ9kYGzzhZRbK+xOo=")
+ (accept-alt-case "Sec-Websocket-Accept: s3pPLMBiTxaQ9kYGzzhZRbK+xOo=")
(invalid-accept "Sec-WebSocket-Accept: bad")
(upgrade "Upgrade: websocket")
+ (upgrade-alt-case "Upgrade: Websocket")
(connection "Connection: upgrade")
(ws (websocket-inner-create
:conn "fake-conn" :url "ws://foo/bar"
:accept-string "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="))
(ws-with-protocol
(websocket-inner-create
- :conn "fake-conn" :url "ws://foo/bar"
- :accept-string "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="
- :protocols '("myprotocol")))
+ :conn "fake-conn" :url "ws://foo/bar"
+ :accept-string "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="
+ :protocols '("myprotocol")))
(ws-with-extensions
(websocket-inner-create
- :conn "fake-conn" :url "ws://foo/bar"
- :accept-string "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="
- :extensions '("ext1" "ext2"))))
+ :conn "fake-conn" :url "ws://foo/bar"
+ :accept-string "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="
+ :extensions '("ext1" "ext2"))))
(should (websocket-verify-headers
ws
(websocket-test-header-with-lines accept upgrade connection)))
+ ;; Force case sensitivity to make sure we aren't too case sensitive.
+ (let ((case-fold-search nil))
+ (should (websocket-verify-headers
+ ws
+ (websocket-test-header-with-lines accept-alt-case
upgrade-alt-case connection))))
(should-error
(websocket-verify-headers
ws
@@ -192,28 +201,86 @@
(should (equal '("ext1" "ext2; a=1")
(websocket-negotiated-extensions ws-with-extensions)))))
+(ert-deftest websocket-mask-is-unibyte ()
+ (should-not (multibyte-string-p (websocket-mask "\344\275\240\345\245\275"
"abcdef"))))
+
+(ert-deftest websocket-frame-correctly-encoded ()
+ ;; This example comes from
https://github.com/ahyatt/emacs-websocket/issues/58.
+ (cl-letf ((text
"{\"parent_header\":{},\"header\":{\"msg_id\":\"a2940bc8-619e-4872-97bd-4c8d6fb93017\",\"msg_type\":\"history_request\",\"version\":\"5.3\",\"username\":\"n\",\"session\":\"409cf442-74ba-462f-8183-6652503005af\",\"date\":\"2019-06-20T02:17:43.925049-0500\"},\"content\":{\"output\":false,\"raw\":false,\"hist_access_type\":\"tail\",\"n\":100},\"metadata\":{},\"buffers\":[],\"channel\":\"shell\"}")
+ ((symbol-function #'websocket-genbytes)
+ (lambda (&rest _) "\10\206\356\224")))
+ (let ((frame (websocket-read-frame
+ (websocket-encode-frame
+ (make-websocket-frame :opcode 'text
+ :payload (encode-coding-string text
'raw-text)
+ :completep t)
+ t))))
+ (should frame)
+ (should (equal (websocket-frame-payload frame) text)))))
+
(ert-deftest websocket-create-headers ()
- (let ((system-name "mysystem")
- (base-headers (concat "Host: www.example.com\r\n"
+ (let ((base-headers (concat "Host: www.example.com\r\n"
"Upgrade: websocket\r\n"
"Connection: Upgrade\r\n"
"Sec-WebSocket-Key: key\r\n"
- "Origin: mysystem\r\n"
"Sec-WebSocket-Version: 13\r\n")))
- (should (equal (concat base-headers "\r\n")
- (websocket-create-headers "ws://www.example.com/path"
- "key" nil nil)))
- (should (equal (concat base-headers
- "Sec-WebSocket-Protocol: protocol\r\n\r\n")
- (websocket-create-headers "ws://www.example.com/path"
- "key" '("protocol") nil)))
- (should (equal
- (concat base-headers
- "Sec-WebSocket-Extensions: ext1; a; b=2, ext2\r\n\r\n")
- (websocket-create-headers "ws://www.example.com/path"
- "key" nil
- '(("ext1" . ("a" "b=2"))
- ("ext2")))))))
+ (cl-letf (((symbol-function 'url-cookie-generate-header-lines)
+ (lambda (host localpart secure) "")))
+ (should (equal (concat base-headers "\r\n")
+ (websocket-create-headers "ws://www.example.com/path"
+ "key" nil nil nil)))
+ (should (equal (concat base-headers
+ "Sec-WebSocket-Protocol: protocol\r\n\r\n")
+ (websocket-create-headers "ws://www.example.com/path"
+ "key" '("protocol") nil nil)))
+ (should (equal
+ (concat base-headers
+ "Sec-WebSocket-Extensions: ext1; a; b=2, ext2\r\n\r\n")
+ (websocket-create-headers "ws://www.example.com/path"
+ "key" nil
+ '(("ext1" . ("a" "b=2"))
+ ("ext2")) nil)))
+ (should (equal
+ (concat base-headers "Foo: bar\r\nBaz: boo\r\n\r\n")
+ (websocket-create-headers "ws://www.example.com/path"
+ "key" nil nil '(("Foo" . "bar")
("Baz" . "boo"))))))
+ (cl-letf (((symbol-function 'url-cookie-generate-header-lines)
+ (lambda (host localpart secure)
+ (should (equal host "www.example.com:123"))
+ (should (equal localpart "/path"))
+ (should secure)
+ "Cookie: foo=bar\r\n")))
+ (should (equal (websocket-create-headers "wss://www.example.com:123/path"
+ "key" nil nil nil)
+ (concat
+ "Host: www.example.com:123\r\n"
+ "Upgrade: websocket\r\n"
+ "Connection: Upgrade\r\n"
+ "Sec-WebSocket-Key: key\r\n"
+ "Sec-WebSocket-Version: 13\r\n"
+ "Cookie: foo=bar\r\n\r\n"))))
+ (should
+ (string-match
+ "Host: www.example.com:123\r\n"
+ (websocket-create-headers "ws://www.example.com:123/path" "key" nil nil
nil)))))
+
+(ert-deftest websocket-process-headers ()
+ (cl-flet ((url-cookie-handle-set-cookie
+ (text)
+ (should (equal text "foo=bar;"))
+ ;; test that we have set the implicit buffer variable needed
+ ;; by url-cookie-handle-set-cookie
+ (should (equal url-current-object
+ (url-generic-parse-url "ws://example.com/path")))))
+ (websocket-process-headers "ws://example.com/path"
+ (concat
+ "HTTP/1.1 101 Switching Protocols\r\n"
+ "Upgrade: websocket\r\n"
+ "Connection: Upgrade\r\n"
+ "Set-Cookie: foo=bar;\r\n\r\n")))
+ (cl-flet ((url-cookie-handle-set-cookie (text) (should nil)))
+ (websocket-process-headers "ws://example.com/path"
+ "HTTP/1.1 101 Switching Protocols\r\n")))
(ert-deftest websocket-process-frame ()
(let* ((sent)
@@ -236,14 +303,17 @@
(make-websocket-frame :opcode opcode :payload "hello")))
processed))))
(setq sent nil)
- (flet ((websocket-send (websocket content) (setq sent content)))
+ (cl-letf (((symbol-function 'websocket-send)
+ (lambda (websocket content) (setq sent content))))
(should (equal
- (make-websocket-frame :opcode 'pong :completep t)
+ (make-websocket-frame :opcode 'pong :payload "data" :completep
t)
(progn
(funcall (websocket-process-frame websocket
- (make-websocket-frame :opcode
'ping)))
+ (make-websocket-frame
:opcode 'ping
+
:payload "data")))
sent))))
- (flet ((delete-process (conn) (setq deleted t)))
+ (cl-letf (((symbol-function 'delete-process)
+ (lambda (conn) (setq deleted t))))
(should (progn
(funcall
(websocket-process-frame websocket
@@ -271,7 +341,11 @@
(should (equal 30 (websocket-get-bytes (websocket-to-bytes 30 1) 1)))
(should (equal 300 (websocket-get-bytes (websocket-to-bytes 300 2) 2)))
(should (equal 70000 (websocket-get-bytes (websocket-to-bytes 70000 8) 8)))
- (should-error (websocket-to-bytes 536870912 8) :type
'websocket-frame-too-large)
+ ;; Only run if the number we're testing with is not more than the system can
+ ;; handle.
+ (if (equal "1" (calc-eval (format "536870912 < %d" most-positive-fixnum)))
+ (should-error (websocket-to-bytes 536870912 8)
+ :type 'websocket-frame-too-large))
(should-error (websocket-to-bytes 30 3))
(should-error (websocket-to-bytes 300 1))
;; I'd like to test the error for 32-byte systems on 8-byte lengths,
@@ -287,15 +361,16 @@
(websocket-encode-frame
(make-websocket-frame :opcode 'text :payload "Hello" :completep
t) nil)))
(dolist (len '(200 70000))
- (let ((long-string (make-string len ?x)))
- (should (equal long-string
- (websocket-frame-payload
- (websocket-read-frame
- (websocket-encode-frame
- (make-websocket-frame :opcode 'text
- :payload long-string)
t)))))))
- (flet ((websocket-genbytes (n) (substring websocket-test-masked-hello 2 6)))
- (should (equal websocket-test-masked-hello
+ (let ((long-string (make-string len ?x)))
+ (should (equal long-string
+ (websocket-frame-payload
+ (websocket-read-frame
+ (websocket-encode-frame
+ (make-websocket-frame :opcode 'text
+ :payload long-string) t)))))))
+ (cl-letf (((symbol-function 'websocket-genbytes)
+ (lambda (n) (substring websocket-test-masked-hello 2 6))))
+ (should (equal websocket-test-masked-hello
(websocket-encode-frame
(make-websocket-frame :opcode 'text :payload "Hello"
:completep t) t))))
@@ -305,22 +380,53 @@
(websocket-encode-frame (make-websocket-frame :opcode 'text
:payload "Hello"
:completep nil) t))))
- (dolist (opcode '(close ping pong))
- (should (equal
- opcode
- (websocket-frame-opcode
- (websocket-read-frame
- (websocket-encode-frame (make-websocket-frame :opcode opcode
- :completep t)
t)))))))
+ (should (equal 'close (websocket-frame-opcode
+ (websocket-read-frame
+ (websocket-encode-frame
+ (make-websocket-frame :opcode 'close :completep t)
t)))))
+ (dolist (opcode '(ping pong))
+ (let ((read-frame (websocket-read-frame
+ (websocket-encode-frame
+ (make-websocket-frame :opcode opcode
+ :payload "data"
+ :completep t) t))))
+ (should read-frame)
+ (should (equal
+ opcode
+ (websocket-frame-opcode read-frame)))
+ (should (equal
+ "data" (websocket-frame-payload read-frame)))))
+ ;; A frame should be four bytes, even for no-data pings.
+ (should (equal 2 (websocket-frame-length
+ (websocket-read-frame
+ (websocket-encode-frame
+ (make-websocket-frame :opcode 'ping :completep t) t))))))
+
+(ert-deftest websocket-check ()
+ (should (websocket-check (make-websocket-frame :opcode 'close :completep t)))
+ (should-not
+ (websocket-check (make-websocket-frame :opcode 'close :completep nil)))
+ (should-not
+ (websocket-check (make-websocket-frame :opcode 'close :completep t :payload
"")))
+ (should (websocket-check (make-websocket-frame :opcode 'text :completep nil
+ :payload "incompl")))
+ (should (websocket-check (make-websocket-frame :opcode 'ping :completep t)))
+ (should (websocket-check (make-websocket-frame :opcode 'ping :completep t
+ :payload "")))
+ (should (websocket-check (make-websocket-frame :opcode 'pong :completep t
+ :payload "")))
+ (should-not (websocket-check (make-websocket-frame :opcode 'text))))
(ert-deftest websocket-close ()
(let ((sent-frames)
(processes-deleted))
- (flet ((websocket-send (websocket frame) (push frame sent-frames))
- (websocket-openp (websocket) t)
- (kill-buffer (buffer))
- (delete-process (proc))
- (process-buffer (conn) (add-to-list 'processes-deleted conn)))
+ (cl-letf (((symbol-function 'websocket-send)
+ (lambda (websocket frame) (push frame sent-frames)))
+ ((symbol-function 'websocket-openp)
+ (lambda (websocket) t))
+ ((symbol-function 'kill-buffer) (lambda (buffer) t))
+ ((symbol-function 'delete-process)
+ (lambda (proc) (add-to-list 'processes-deleted proc))))
(websocket-close (websocket-inner-create
:conn "fake-conn"
:url t
@@ -350,12 +456,14 @@
(concat
(websocket-encode-frame frame1 t)
(websocket-encode-frame frame2 t))))
- (flet ((websocket-process-frame
- (websocket frame)
- (lexical-let ((frame frame))
- (lambda () (push frame processed-frames))))
- (websocket-verify-response-code (output) t)
- (websocket-verify-headers (websocket output) t))
+ (cl-letf (((symbol-function 'websocket-process-frame)
+ (lambda (websocket frame)
+ (lexical-let ((frame frame))
+ (lambda () (push frame processed-frames)))))
+ ((symbol-function 'websocket-verify-headers)
+ (lambda (websocket output) t))
+ ((symbol-function 'websocket-close) (lambda (websocket) t)))
+ (websocket-outer-filter fake-ws "HTTP/1.1 101 Switching Protocols\r\n")
(websocket-outer-filter fake-ws "Sec-")
(should (eq (websocket-ready-state fake-ws) 'connecting))
(should-not open-callback-called)
@@ -368,11 +476,17 @@
(websocket-outer-filter fake-ws (substring websocket-frames 2))
(should (equal (list frame2 frame1) processed-frames))
(should-not (websocket-inflight-input fake-ws)))
- (flet ((websocket-close (websocket)))
- (setf (websocket-ready-state fake-ws) 'connecting)
- (should (eq 500 (cdr (should-error
- (websocket-outer-filter fake-ws "HTTP/1.1
500\r\n\r\n")
- :type
'websocket-received-error-http-response)))))))
+ (cl-letf (((symbol-function 'websocket-close) (lambda (websocket) t)))
+ (let ((on-error-called))
+ (setf (websocket-ready-state fake-ws) 'connecting)
+ (setf (websocket-on-open fake-ws) (lambda (ws &rest _) t))
+ (setf (websocket-on-error fake-ws)
+ (lambda (_ type err)
+ (should (eq type 'on-open))
+ (should (equal '(websocket-received-error-http-response 500)
err))
+ (setq on-error-called t)))
+ (websocket-outer-filter fake-ws "HTTP/1.1 500\r\n\r\n")
+ (should on-error-called)))))
(ert-deftest websocket-outer-filter-bad-connection ()
(let* ((on-open-calledp)
@@ -381,9 +495,12 @@
:conn t :url t :accept-string t
:on-open (lambda (websocket)
(setq on-open-calledp t)))))
- (flet ((websocket-verify-response-code (output) t)
- (websocket-verify-headers (websocket output) (error "Bad headers!"))
- (websocket-close (websocket) (setq websocket-closed-calledp t)))
+ (cl-letf (((symbol-function 'websocket-verify-response-code)
+ (lambda (output) t))
+ ((symbol-function 'websocket-verify-headers)
+ (lambda (websocket output) (error "Bad headers!")))
+ ((symbol-function 'websocket-close)
+ (lambda (websocket) (setq websocket-closed-calledp t))))
(condition-case err
(progn (websocket-outer-filter fake-ws "HTTP/1.1 101\r\n\r\n")
(error "Should have thrown an error!"))
@@ -391,18 +508,34 @@
(should-not on-open-calledp)
(should websocket-closed-calledp))))))
+(ert-deftest websocket-outer-filter-fragmented-header ()
+ (let* ((on-open-calledp)
+ (websocket-closed-calledp)
+ (fake-ws (websocket-inner-create
+ :protocols '("websocket")
+ :conn t :url t :accept-string "17hG/VoPPd14L9xPSI7LtEr7PQc="
+ :on-open (lambda (websocket)
+ (setq on-open-calledp t)))))
+ (cl-letf (((symbol-function 'websocket-close) (lambda (websocket) t)))
+ (websocket-outer-filter fake-ws "HTTP/1.1 101 Web Socket Protocol
Handsh")
+ (websocket-outer-filter fake-ws "ake\r\nConnection: Upgrade\r\n")
+ (websocket-outer-filter fake-ws "Upgrade: websocket\r\n")
+ (websocket-outer-filter fake-ws "Sec-websocket-Protocol: websocket\r\n")
+ (websocket-outer-filter fake-ws "Sec-WebSocket-Accept:
17hG/VoPPd14L9xPSI7LtEr7PQc=\r\n\r\n"))))
+
(ert-deftest websocket-send-text ()
- (flet ((websocket-send (ws frame)
- (should (equal
- (websocket-frame-payload frame)
- "\344\275\240\345\245\275"))))
+ (cl-letf (((symbol-function 'websocket-send)
+ (lambda (ws frame)
+ (should (equal
+ (websocket-frame-payload frame)
+ "\344\275\240\345\245\275")))))
(websocket-send-text nil "你好")))
(ert-deftest websocket-send ()
(let ((ws (websocket-inner-create :conn t :url t :accept-string t)))
- (flet ((websocket-ensure-connected (websocket))
- (websocket-openp (websocket) t)
- (process-send-string (conn string)))
+ (cl-letf (((symbol-function 'websocket-ensure-connected) (lambda
(websocket) t))
+ ((symbol-function 'websocket-openp) (lambda (websocket) t))
+ ((symbol-function 'process-send-string) (lambda (conn string)
t)))
;; Just make sure there is no error.
(websocket-send ws (make-websocket-frame :opcode 'ping
:completep t)))
@@ -423,7 +556,6 @@
(upgrade "Upgrade: websocket")
(key (format "Sec-Websocket-Key: %s" "key"))
(version "Sec-Websocket-Version: 13")
- (origin "Origin: origin")
(protocol "Sec-Websocket-Protocol: protocol")
(extensions1 "Sec-Websocket-Extensions: foo")
(extensions2 "Sec-Websocket-Extensions: bar; baz=2")
@@ -485,11 +617,12 @@
(closed)
(response)
(processed))
- (flet ((process-send-string (p text) (setq response text))
- (websocket-close (ws) (setq closed t))
- (process-get (process sym) ws))
+ (cl-letf (((symbol-function 'process-send-string) (lambda (p text) (setq
response text)))
+ ((symbol-function 'websocket-close) (lambda (ws) (setq closed
t)))
+ ((symbol-function 'process-get) (lambda (process sym) ws)))
;; Bad request, in two parts
- (flet ((websocket-verify-client-headers (text) nil))
+ (cl-letf (((symbol-function 'websocket-verify-client-headers)
+ (lambda (text) nil)))
(websocket-server-filter nil "HTTP/1.0 GET /foo \r\n")
(should-not closed)
(websocket-server-filter nil "\r\n")
@@ -499,13 +632,16 @@
(setq closed nil
response nil)
(setf (websocket-inflight-input ws) nil)
- (flet ((websocket-verify-client-headers (text) t)
- (websocket-get-server-response (ws protocols extensions)
- "response")
- (websocket-process-input-on-open-ws (ws text)
- (setq processed t)
- (should
- (equal text
websocket-test-hello))))
+ (cl-letf (((symbol-function 'websocket-verify-client-headers)
+ (lambda (text) t))
+ ((symbol-function 'websocket-get-server-response)
+ (lambda (ws protocols extensions)
+ "response"))
+ ((symbol-function 'websocket-process-input-on-open-ws)
+ (lambda (ws text)
+ (setq processed t)
+ (should
+ (equal text websocket-test-hello)))))
(websocket-server-filter nil
(concat "\r\n\r\n" websocket-test-hello))
(should (equal (websocket-ready-state ws) 'open))
@@ -529,7 +665,6 @@
"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)
@@ -556,14 +691,16 @@
:ready-state 'closed)))
(deleted-processes)
(closed-websockets))
- (flet ((delete-process (conn) (add-to-list 'deleted-processes conn))
- (websocket-close (ws)
- ;; we always remove on closing in the
- ;; actual code.
- (setq websocket-server-websockets
- (remove ws websocket-server-websockets))
- (should-not (eq (websocket-ready-state ws)
'closed))
- (add-to-list 'closed-websockets ws)))
+ (cl-letf (((symbol-function 'delete-process)
+ (lambda (conn) (add-to-list 'deleted-processes conn)))
+ ((symbol-function 'websocket-close)
+ (lambda (ws)
+ ;; we always remove on closing in the
+ ;; actual code.
+ (setq websocket-server-websockets
+ (remove ws websocket-server-websockets))
+ (should-not (eq (websocket-ready-state ws) 'closed))
+ (add-to-list 'closed-websockets ws))))
(websocket-server-close 'b))
(should (equal deleted-processes '(b)))
(should (eq 1 (length closed-websockets)))
@@ -572,16 +709,16 @@
(should (eq 'conn-a (websocket-conn (car websocket-server-websockets))))))
(ert-deftest websocket-default-error-handler ()
- (flet ((try-error
- (callback-type err expected-message)
- (flet ((display-warning
- (type message &optional level buffer-name)
- (should (eq type 'websocket))
- (should (eq level :error))
- (should (string= message expected-message))))
- (websocket-default-error-handler nil
- callback-type
- err))))
+ (cl-letf (((symbol-function 'try-error)
+ (lambda (callback-type err expected-message)
+ (cl-flet ((display-warning
+ (type message &optional level buffer-name)
+ (should (eq type 'websocket))
+ (should (eq level :error))
+ (should (string= message expected-message))))
+ (websocket-default-error-handler nil
+ callback-type
+ err)))))
(try-error
'on-message
'(end-of-buffer)
diff --git a/websocket.el b/websocket.el
index 1d69508..3424852 100644
--- a/websocket.el
+++ b/websocket.el
@@ -3,8 +3,9 @@
;; Copyright (c) 2013, 2016-2017 Free Software Foundation, Inc.
;; Author: Andrew Hyatt <ahy...@gmail.com>
+;; Homepage: https://github.com/ahyatt/emacs-websocket
;; Keywords: Communication, Websocket, Server
-;; Version: 1.12
+;; Version: 1.13
;; Package-Requires: ((cl-lib "0.5"))
;;
;; This program is free software; you can redistribute it and/or
@@ -556,7 +557,6 @@ the `websocket-error' condition."
(websocket-debug websocket "Sending frame, opcode: %s payload: %s"
(websocket-frame-opcode frame)
(websocket-frame-payload frame))
- (websocket-ensure-connected websocket)
(unless (websocket-openp websocket)
(signal 'websocket-closed (list frame)))
(process-send-string (websocket-conn websocket)
@@ -580,21 +580,6 @@ the `websocket-error' condition."
(setf (websocket-ready-state websocket) 'closed))
(delete-process (websocket-conn websocket)))
-(defun websocket-ensure-connected (websocket)
- "If the WEBSOCKET connection is closed, open it."
- (unless (and (websocket-conn websocket)
- (cl-ecase (process-status (websocket-conn websocket))
- ((run open listen) t)
- ((stop exit signal closed connect failed nil) nil)))
- (websocket-close websocket)
- (websocket-open (websocket-url websocket)
- :protocols (websocket-protocols websocket)
- :extensions (websocket-extensions websocket)
- :on-open (websocket-on-open websocket)
- :on-message (websocket-on-message websocket)
- :on-close (websocket-on-close websocket)
- :on-error (websocket-on-error websocket))))
-
;;;;;;;;;;;;;;;;;;;;;;
;; Websocket client ;;
;;;;;;;;;;;;;;;;;;;;;;
@@ -722,7 +707,7 @@ to the websocket protocol.
conn
(websocket-sentinel url conn key protocols extensions custom-header-alist
nowait))
(set-process-query-on-exit-flag conn nil)
- (websocket-ensure-handshake url conn key protocols extensions
custom-header-alist)
+ (websocket-ensure-handshake url conn key protocols extensions
custom-header-alist nowait)
websocket))
(defun websocket-sentinel (url conn key protocols extensions
custom-header-alist nowait)
@@ -731,26 +716,26 @@ to the websocket protocol.
(websocket-debug websocket "State change to %s" change)
(let ((status (process-status process)))
(when (and nowait (eq status 'open))
- (websocket-ensure-handshake url conn key protocols extensions
custom-header-alist))
+ (websocket-ensure-handshake url conn key protocols extensions
custom-header-alist nowait))
(when (and (member status '(closed failed exit signal))
(not (eq 'closed (websocket-ready-state websocket))))
(websocket-try-callback 'websocket-on-close 'on-close
websocket))))))
-(defun websocket-ensure-handshake (url conn key protocols extensions
custom-header-alist)
+(defun websocket-ensure-handshake (url conn key protocols extensions
custom-header-alist nowait)
(let ((url-struct (url-generic-parse-url url))
(websocket (process-get conn :websocket)))
(when (and (eq 'connecting (websocket-ready-state websocket))
- (eq 'open (process-status conn)))
- (process-send-string conn
- (format "GET %s HTTP/1.1\r\n"
- (let ((path (url-filename url-struct)))
- (if (> (length path) 0) path "/"))))
+ (memq (process-status conn)
+ (list 'run (if nowait 'connect 'open))))
(websocket-debug websocket "Sending handshake, key: %s, acceptance: %s"
key (websocket-accept-string websocket))
(process-send-string conn
- (websocket-create-headers
- url key protocols extensions
custom-header-alist)))))
+ (format "GET %s HTTP/1.1\r\n%s"
+ (let ((path (url-filename url-struct)))
+ (if (> (length path) 0) path "/"))
+ (websocket-create-headers
+ url key protocols extensions
custom-header-alist))))))
(defun websocket-process-headers (url headers)
"On opening URL, process the HEADERS sent from the server."
