[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/websocket 6954d08: Version 1.13.1 - removing websocket-
|
From: |
Andrew Hyatt |
|
Subject: |
[elpa] externals/websocket 6954d08: Version 1.13.1 - removing websocket-test.el. |
|
Date: |
Sun, 10 Jan 2021 13:45:09 -0500 (EST) |
branch: externals/websocket
commit 6954d08eb8bac28d504a11f1fcf5d84fe16f6c51
Author: Andrew Hyatt <ahyatt@gmail.com>
Commit: Andrew Hyatt <ahyatt@gmail.com>
Version 1.13.1 - removing websocket-test.el.
The websocket-test.el file should not be in the elpa repository. This does
not
change the functionality at all. Those who want to run the unit tests can
find
the tests in the websocket github repository.
---
websocket-test.el | 730 ------------------------------------------------------
websocket.el | 2 +-
2 files changed, 1 insertion(+), 731 deletions(-)
diff --git a/websocket-test.el b/websocket-test.el
deleted file mode 100644
index c133272..0000000
--- a/websocket-test.el
+++ /dev/null
@@ -1,730 +0,0 @@
-;;; websocket-test.el --- Unit tests for the websocket layer
-
-;; Copyright (c) 2013 Free Software Foundation, Inc.
-;;
-;; Author: Andrew Hyatt <ahyatt at gmail dot com>
-;; Maintainer: Andrew Hyatt <ahyatt at gmail dot com>
-;;
-;; 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 2 of the
-;; License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;; This defines and runs ert unit tests. You can download ert from:
-;; http://github.com/ohler/ert, it also comes with Emacs 24 and above.
-
-(require 'ert)
-(require 'websocket)
-(eval-when-compile (require 'cl))
-
-(ert-deftest websocket-genbytes-length ()
- (loop repeat 100
- do (should (= (string-bytes (websocket-genbytes 16)) 16))))
-
-(ert-deftest websocket-calculate-accept ()
- ;; This example comes straight from RFC 6455
- (should
- (equal "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="
- (websocket-calculate-accept "dGhlIHNhbXBsZSBub25jZQ=="))))
-
-(defconst websocket-test-hello "\x81\x05\x48\x65\x6c\x6c\x6f"
- "'Hello' string example, taken from the RFC.")
-
-(defconst websocket-test-masked-hello
- "\x81\x85\x37\xfa\x21\x3d\x7f\x9f\x4d\x51\x58"
- "'Hello' masked string example, taken from the RFC.")
-
-(ert-deftest websocket-get-bytes ()
- (should (equal #x5 (websocket-get-bytes "\x5" 1)))
- (should (equal #x101 (websocket-get-bytes "\x1\x1" 2)))
- (should (equal #xffffff
- (websocket-get-bytes "\x0\x0\x0\x0\x0\xFF\xFF\xFF" 8)))
- (should-error (websocket-get-bytes "\x0\x0\x0\x1\x0\x0\x0\x1" 8)
- :type 'websocket-unparseable-frame)
- (should-error (websocket-get-bytes "\x0\x0\x0" 3))
- (should-error (websocket-get-bytes "\x0" 2) :type
'websocket-unparseable-frame))
-
-(ert-deftest websocket-get-opcode ()
- (should (equal 'text (websocket-get-opcode websocket-test-hello))))
-
-(ert-deftest websocket-get-payload-len ()
- (should (equal '(5 . 1)
- (websocket-get-payload-len
- (substring websocket-test-hello 1))))
- (should (equal '(200 . 3)
- (websocket-get-payload-len
- (bindat-pack '((:len u8) (:val u16))
- `((:len . 126)
- (:val . 200))))))
- ;; we don't want to hit up any limits even on strange emacs builds,
- ;; so this test has a pretty small test value
- (should (equal '(70000 . 9)
- (websocket-get-payload-len
- (bindat-pack '((:len u8) (:val vec 2 u32))
- `((:len . 127)
- (:val . [0 70000])))))))
-
-(ert-deftest websocket-read-frame ()
- (should (equal (make-websocket-frame :opcode 'text :payload "Hello"
- :length (length websocket-test-hello)
- :completep t)
- (websocket-read-frame websocket-test-hello)))
- (should (equal (make-websocket-frame :opcode 'text :payload "Hello"
- :length (length websocket-test-hello)
- :completep t)
- (websocket-read-frame (concat websocket-test-hello
- "should-not-be-read"))))
- (should (equal (make-websocket-frame :opcode 'text :payload "Hello"
- :length (length
websocket-test-masked-hello)
- :completep t)
- (websocket-read-frame websocket-test-masked-hello)))
- (should (equal (make-websocket-frame :opcode 'text :payload "Hello"
- :length (length websocket-test-hello)
- :completep nil)
- (websocket-read-frame
- (concat (unibyte-string
- (logand (string-to-char
- (substring websocket-test-hello 0 1))
- 127))
- (substring websocket-test-hello 1)))))
- (dotimes (i (- (length websocket-test-hello) 1))
- (should-not (websocket-read-frame
- (substring websocket-test-hello 0
- (- (length websocket-test-hello) (+ i 1))))))
- (dotimes (i (- (length websocket-test-masked-hello) 1))
- (should-not (websocket-read-frame
- (substring websocket-test-masked-hello 0
- (- (length websocket-test-masked-hello) (+ i
1)))))))
-
-(defun websocket-test-header-with-lines (&rest lines)
- (mapconcat 'identity (append lines '("\r\n")) "\r\n"))
-
-(ert-deftest websocket-verify-response-code ()
- (should (websocket-verify-response-code "HTTP/1.1 101"))
- (should
- (equal '(400) (cdr (should-error (websocket-verify-response-code "HTTP/1.1
400")
- :type
'websocket-received-error-http-response))))
- (should
- (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")))
- (ws-with-extensions
- (websocket-inner-create
- :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
- (websocket-test-header-with-lines invalid-accept upgrade connection))
- :type 'websocket-invalid-header)
- (should-error (websocket-verify-headers
- ws
- (websocket-test-header-with-lines upgrade connection))
- :type 'websocket-invalid-header)
- (should-error (websocket-verify-headers
- ws
- (websocket-test-header-with-lines accept connection))
- :type 'websocket-invalid-header)
- (should-error (websocket-verify-headers
- ws
- (websocket-test-header-with-lines accept upgrade))
- :type 'websocket-invalid-header)
- (should-error (websocket-verify-headers
- ws-with-protocol
- (websocket-test-header-with-lines accept upgrade
connection))
- :type 'websocket-invalid-header)
- (should-error
- (websocket-verify-headers
- ws-with-protocol
- (websocket-test-header-with-lines accept upgrade connection
- "Sec-Websocket-Protocol: foo"))
- :type 'websocket-invalid-header)
- (should
- (websocket-verify-headers
- ws-with-protocol
- (websocket-test-header-with-lines accept upgrade connection
- "Sec-Websocket-Protocol: myprotocol")))
- (should (equal '("myprotocol")
- (websocket-negotiated-protocols ws-with-protocol)))
- (should-error
- (websocket-verify-headers
- ws-with-extensions
- (websocket-test-header-with-lines accept upgrade connection
- "Sec-Websocket-Extensions: foo")))
- (should
- (websocket-verify-headers
- ws-with-extensions
- (websocket-test-header-with-lines
- accept upgrade connection "Sec-Websocket-Extensions: ext1, ext2; a=1")))
- (should (equal '("ext1" "ext2; a=1")
- (websocket-negotiated-extensions ws-with-extensions)))
- (should
- (websocket-verify-headers
- ws-with-extensions
- (websocket-test-header-with-lines accept upgrade connection
- "Sec-Websocket-Extensions: ext1"
- "Sec-Websocket-Extensions: ext2;
a=1")))
- (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 ((base-headers (concat "Host: www.example.com\r\n"
- "Upgrade: websocket\r\n"
- "Connection: Upgrade\r\n"
- "Sec-WebSocket-Key: key\r\n"
- "Sec-WebSocket-Version: 13\r\n")))
- (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)
- (processed)
- (deleted)
- (websocket (websocket-inner-create
- :conn t :url t
- :on-message (lambda (websocket frame)
- (setq
- processed
- (websocket-frame-payload frame)))
- :accept-string t)))
- (dolist (opcode '(text binary continuation))
- (setq processed nil)
- (should (equal
- "hello"
- (progn
- (funcall (websocket-process-frame
- websocket
- (make-websocket-frame :opcode opcode :payload "hello")))
- processed))))
- (setq sent nil)
- (cl-letf (((symbol-function 'websocket-send)
- (lambda (websocket content) (setq sent content))))
- (should (equal
- (make-websocket-frame :opcode 'pong :payload "data" :completep
t)
- (progn
- (funcall (websocket-process-frame websocket
- (make-websocket-frame
:opcode 'ping
-
:payload "data")))
- sent))))
- (cl-letf (((symbol-function 'delete-process)
- (lambda (conn) (setq deleted t))))
- (should (progn
- (funcall
- (websocket-process-frame websocket
- (make-websocket-frame :opcode
'close)))
- deleted)))))
-
-(ert-deftest websocket-process-frame-error-handling ()
- (let* ((error-called)
- (websocket (websocket-inner-create
- :conn t :url t :accept-string t
- :on-message (lambda (websocket frame)
- (message "In on-message")
- (error "err"))
- :on-error (lambda (ws type err)
- (should (eq 'on-message type))
- (setq error-called t)))))
- (funcall (websocket-process-frame websocket
- (make-websocket-frame :opcode 'text
- :payload "hello")))
- (should error-called)))
-
-(ert-deftest websocket-to-bytes ()
- ;; We've tested websocket-get-bytes by itself, now we can use it to
- ;; help test websocket-to-bytes.
- (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)))
- ;; 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,
- ;; but elisp does not allow us to temporarily set constants such as
- ;; most-positive-fixnum.
- )
-
-(ert-deftest websocket-encode-frame ()
- ;; We've tested websocket-read-frame, now we can use that to help
- ;; test websocket-encode-frame.
- (should (equal
- websocket-test-hello
- (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)))))))
- (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))))
- (should-not
- (websocket-frame-completep
- (websocket-read-frame
- (websocket-encode-frame (make-websocket-frame :opcode 'text
- :payload "Hello"
- :completep nil) 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))
- (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
- :accept-string t
- :on-close 'identity))
- (should (equal sent-frames (list
- (make-websocket-frame :opcode 'close
- :completep t))))
- (should (equal processes-deleted '("fake-conn"))))))
-
-(ert-deftest websocket-outer-filter ()
- (let* ((fake-ws (websocket-inner-create
- :conn t :url t :accept-string t
- :on-open (lambda (websocket)
- (should (eq (websocket-ready-state websocket)
- 'open))
- (setq open-callback-called t)
- (error "Ignore me!"))
- :on-error (lambda (ws type err))))
- (processed-frames)
- (frame1 (make-websocket-frame :opcode 'text :payload "foo" :completep
t
- :length 9))
- (frame2 (make-websocket-frame :opcode 'text :payload "bar" :completep
t
- :length 9))
- (open-callback-called)
- (websocket-frames
- (concat
- (websocket-encode-frame frame1 t)
- (websocket-encode-frame frame2 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)
- (websocket-outer-filter fake-ws "WebSocket-Accept: acceptstring")
- (should-not open-callback-called)
- (websocket-outer-filter fake-ws (concat
- "\r\n\r\n"
- (substring websocket-frames 0 2)))
- (should open-callback-called)
- (websocket-outer-filter fake-ws (substring websocket-frames 2))
- (should (equal (list frame2 frame1) processed-frames))
- (should-not (websocket-inflight-input fake-ws)))
- (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)
- (websocket-closed-calledp)
- (fake-ws (websocket-inner-create
- :conn t :url t :accept-string t
- :on-open (lambda (websocket)
- (setq on-open-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!"))
- (error
- (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 ()
- (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)))
- (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)))
- (should-error (websocket-send ws
- (make-websocket-frame :opcode 'text)))
- (should-error (websocket-send ws
- (make-websocket-frame :opcode 'close
- :payload "bye!"
- :completep t))
- :type 'websocket-illegal-frame)
- (should-error (websocket-send ws
- (make-websocket-frame :opcode :close))
- :type 'websocket-illegal-frame)))
-
-(ert-deftest websocket-verify-client-headers ()
- (let* ((http "HTTP/1.1")
- (host "Host: authority")
- (upgrade "Upgrade: websocket")
- (key (format "Sec-Websocket-Key: %s" "key"))
- (version "Sec-Websocket-Version: 13")
- (protocol "Sec-Websocket-Protocol: protocol")
- (extensions1 "Sec-Websocket-Extensions: foo")
- (extensions2 "Sec-Websocket-Extensions: bar; baz=2")
- (all-required-headers (list host upgrade key version)))
- ;; Test that all these headers are necessary
- (should (equal
- '(:key "key" :protocols ("protocol") :extensions ("foo" "bar;
baz=2"))
- (websocket-verify-client-headers
- (mapconcat 'identity (append (list http "" protocol extensions1
extensions2)
- all-required-headers) "\r\n"))))
- (should (websocket-verify-client-headers
- (mapconcat 'identity
- (mapcar 'upcase
- (append (list http "" protocol extensions1
extensions2)
- all-required-headers)) "\r\n")))
- (dolist (header all-required-headers)
- (should-not (websocket-verify-client-headers
- (mapconcat 'identity (append (list http "")
- (remove header
all-required-headers))
- "\r\n"))))
- (should-not (websocket-verify-client-headers
- (mapconcat 'identity (append (list "HTTP/1.0" "")
all-required-headers)
- "\r\n")))))
-
-(ert-deftest websocket-intersect ()
- (should (equal '(2) (websocket-intersect '(1 2) '(2 3))))
- (should (equal nil (websocket-intersect '(1 2) '(3 4))))
- (should (equal '(1 2) (websocket-intersect '(1 2) '(1 2)))))
-
-(ert-deftest websocket-get-server-response ()
- (let ((ws (websocket-inner-create :conn t :url t :accept-string "key"
- :protocols '("spa" "spb")
- :extensions '("sea" "seb"))))
- (should (equal (concat
- "HTTP/1.1 101 Switching Protocols\r\n"
- "Upgrade: websocket\r\n"
- "Connection: Upgrade\r\n"
- "Sec-WebSocket-Accept: key\r\n\r\n")
- (websocket-get-server-response ws nil nil)))
- (should (string-match "Sec-Websocket-Protocol: spb\r\n"
- (websocket-get-server-response ws '("spb" "spc")
nil)))
- (should-not (string-match "Sec-Websocket-Protocol:"
- (websocket-get-server-response ws '("spc") nil)))
- (let ((output (websocket-get-server-response ws '("spa" "spb") nil)))
- (should (string-match "Sec-Websocket-Protocol: spa\r\n" output))
- (should (string-match "Sec-Websocket-Protocol: spb\r\n" output)))
- (should (string-match "Sec-Websocket-Extensions: sea"
- (websocket-get-server-response ws nil '("sea"
"sec"))))
- (should-not (string-match "Sec-Websocket-Extensions:"
- (websocket-get-server-response ws nil '("sec"))))
- (let ((output (websocket-get-server-response ws nil '("sea" "seb"))))
- (should (string-match "Sec-Websocket-Extensions: sea\r\n" output))
- (should (string-match "Sec-Websocket-Extensions: seb\r\n" output)))))
-
-(ert-deftest websocket-server-filter ()
- (let ((on-open-called)
- (ws (websocket-inner-create :conn t :url t :accept-string "key"
- :on-open (lambda (ws) (setq on-open-called
t))))
- (closed)
- (response)
- (processed))
- (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
- (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")
- (should (equal response "HTTP/1.1 400 Bad Request\r\n\r\n"))
- (should-not (websocket-inflight-input ws)))
- ;; Good request, followed by packet
- (setq closed nil
- response nil)
- (setf (websocket-inflight-input ws) nil)
- (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))
- (should-not closed)
- (should (equal response "response"))
- (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"
- "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)))))))
-
-(ert-deftest websocket-server-close ()
- (let ((websocket-server-websockets
- (list (websocket-inner-create :conn 'conn-a :url t :accept-string t
- :server-conn 'a
- :ready-state 'open)
- (websocket-inner-create :conn 'conn-b :url t :accept-string t
- :server-conn 'b
- :ready-state 'open)
- (websocket-inner-create :conn 'conn-c :url t :accept-string t
- :server-conn 'b
- :ready-state 'closed)))
- (deleted-processes)
- (closed-websockets))
- (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)))
- (should (eq 'conn-b (websocket-conn (car closed-websockets))))
- (should (eq 1 (length websocket-server-websockets)))
- (should (eq 'conn-a (websocket-conn (car websocket-server-websockets))))))
-
-(ert-deftest websocket-default-error-handler ()
- (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)
- "in callback `on-message': End of buffer")
-
- (try-error
- 'on-close
- '(wrong-number-of-arguments 1 2)
- "in callback `on-close': Wrong number of arguments: 1, 2")))
diff --git a/websocket.el b/websocket.el
index 3424852..f155522 100644
--- a/websocket.el
+++ b/websocket.el
@@ -5,7 +5,7 @@
;; Author: Andrew Hyatt <ahyatt@gmail.com>
;; Homepage: https://github.com/ahyatt/emacs-websocket
;; Keywords: Communication, Websocket, Server
-;; Version: 1.13
+;; Version: 1.13.1
;; Package-Requires: ((cl-lib "0.5"))
;;
;; This program is free software; you can redistribute it and/or
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] externals/websocket 6954d08: Version 1.13.1 - removing websocket-test.el.,
Andrew Hyatt <=