Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
676 lines (640 sloc) 32.1 KB
;;; 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 3 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
;; 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 <>.
;;; Commentary:
;; This defines and runs ert unit tests. You can download ert from:
;;, 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
(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
"'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)
(substring websocket-test-hello 1))))
(should (equal '(200 . 3)
(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)
(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 (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)
(concat (unibyte-string
(logand (string-to-char
(substring websocket-test-hello 0 1))
(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"))
(eq 400 (cdr (should-error (websocket-verify-response-code "HTTP/1.1 400")
:type 'websocket-received-error-http-response))))
(eq 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=")
(invalid-accept "Sec-WebSocket-Accept: bad")
(upgrade "Upgrade: websocket")
(connection "Connection: upgrade")
(ws (websocket-inner-create
:conn "fake-conn" :url "ws://foo/bar"
:accept-string "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="))
:conn "fake-conn" :url "ws://foo/bar"
:accept-string "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="
:protocols '("myprotocol")))
:conn "fake-conn" :url "ws://foo/bar"
:accept-string "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="
:extensions '("ext1" "ext2"))))
(should (websocket-verify-headers
(websocket-test-header-with-lines accept upgrade connection)))
(websocket-test-header-with-lines invalid-accept upgrade connection))
:type 'websocket-invalid-header)
(should-error (websocket-verify-headers
(websocket-test-header-with-lines upgrade connection))
:type 'websocket-invalid-header)
(should-error (websocket-verify-headers
(websocket-test-header-with-lines accept connection))
:type 'websocket-invalid-header)
(should-error (websocket-verify-headers
(websocket-test-header-with-lines accept upgrade))
:type 'websocket-invalid-header)
(should-error (websocket-verify-headers
(websocket-test-header-with-lines accept upgrade connection))
:type 'websocket-invalid-header)
(websocket-test-header-with-lines accept upgrade connection
"Sec-Websocket-Protocol: foo"))
:type 'websocket-invalid-header)
(websocket-test-header-with-lines accept upgrade connection
"Sec-Websocket-Protocol: myprotocol")))
(should (equal '("myprotocol")
(websocket-negotiated-protocols ws-with-protocol)))
(websocket-test-header-with-lines accept upgrade connection
"Sec-Websocket-Extensions: foo")))
accept upgrade connection "Sec-Websocket-Extensions: ext1, ext2; a=1")))
(should (equal '("ext1" "ext2; a=1")
(websocket-negotiated-extensions 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-create-headers ()
(let ((base-headers (concat "Host:\r\n"
"Upgrade: websocket\r\n"
"Connection: Upgrade\r\n"
"Sec-WebSocket-Key: key\r\n"
"Sec-WebSocket-Version: 13\r\n")))
(flet ((url-cookie-generate-header-lines
(host localpart secure) ""))
(should (equal (concat base-headers "\r\n")
(websocket-create-headers "ws://"
"key" nil nil)))
(should (equal (concat base-headers
"Sec-WebSocket-Protocol: protocol\r\n\r\n")
(websocket-create-headers "ws://"
"key" '("protocol") nil)))
(should (equal
(concat base-headers
"Sec-WebSocket-Extensions: ext1; a; b=2, ext2\r\n\r\n")
(websocket-create-headers "ws://"
"key" nil
'(("ext1" . ("a" "b=2"))
(flet ((url-cookie-generate-header-lines
(host localpart secure)
(should (equal host ""))
(should (equal localpart "/path"))
(should secure)
"Cookie: foo=bar\r\n"))
(should (equal (websocket-create-headers "wss://"
"key" nil nil)
"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"))))
(websocket-create-headers "ws://" "key" nil nil)))))
(ert-deftest websocket-process-headers ()
(flet ((url-cookie-handle-set-cookie
(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://")))))
(websocket-process-headers "ws://"
"HTTP/1.1 101 Switching Protocols\r\n"
"Upgrade: websocket\r\n"
"Connection: Upgrade\r\n"
"Set-Cookie: foo=bar;\r\n\r\n")))
(flet ((url-cookie-handle-set-cookie (text) (should nil)))
(websocket-process-headers "ws://"
"HTTP/1.1 101 Switching Protocols\r\n")))
(ert-deftest websocket-process-frame ()
(let* ((sent)
(websocket (websocket-inner-create
:conn t :url t
:on-message (lambda (websocket frame)
(websocket-frame-payload frame)))
:accept-string t)))
(dolist (opcode '(text binary continuation))
(setq processed nil)
(should (equal
(funcall (websocket-process-frame
(make-websocket-frame :opcode opcode :payload "hello")))
(setq sent nil)
(flet ((websocket-send (websocket content) (setq sent content)))
(should (equal
(make-websocket-frame :opcode 'pong :payload "data" :completep t)
(funcall (websocket-process-frame websocket
(make-websocket-frame :opcode 'ping
:payload "data")))
(flet ((delete-process (conn) (setq deleted t)))
(should (progn
(websocket-process-frame websocket
(make-websocket-frame :opcode 'close)))
(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)))
(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
(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
(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
(make-websocket-frame :opcode 'text :payload "Hello"
:completep t) t))))
(websocket-encode-frame (make-websocket-frame :opcode 'text
:payload "Hello"
:completep nil) t))))
(should (equal 'close (websocket-frame-opcode
(make-websocket-frame :opcode 'close :completep t) t)))))
(dolist (opcode '(ping pong))
(let ((read-frame (websocket-read-frame
(make-websocket-frame :opcode opcode
:payload "data"
:completep t) t))))
(should read-frame)
(should (equal
(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
(make-websocket-frame :opcode 'ping :completep t) t))))))
(ert-deftest websocket-check ()
(should (websocket-check (make-websocket-frame :opcode 'close :completep t)))
(websocket-check (make-websocket-frame :opcode 'close :completep nil)))
(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)
(flet ((websocket-send (websocket frame) (push frame sent-frames))
(websocket-openp (websocket) t)
(kill-buffer (buffer))
(delete-process (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)
(setq open-callback-called t)
(error "Ignore me!"))
:on-error (lambda (ws type err))))
(frame1 (make-websocket-frame :opcode 'text :payload "foo" :completep t
:length 9))
(frame2 (make-websocket-frame :opcode 'text :payload "bar" :completep t
:length 9))
(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-headers (websocket output) t)
(websocket-close (websocket)))
(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
(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)))
(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)))))))
(ert-deftest websocket-outer-filter-bad-connection ()
(let* ((on-open-calledp)
(fake-ws (websocket-inner-create
: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)))
(condition-case err
(progn (websocket-outer-filter fake-ws "HTTP/1.1 101\r\n\r\n")
(error "Should have thrown an error!"))
(should-not on-open-calledp)
(should websocket-closed-calledp))))))
(ert-deftest websocket-outer-filter-fragmented-header ()
(let* ((on-open-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)))))
(flet ((websocket-close (websocket)))
(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)
(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)))
;; 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"))
(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))
(should-not (websocket-verify-client-headers
(mapconcat 'identity (append (list "HTTP/1.0" "") all-required-headers)
(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))))
(flet ((process-send-string (p text) (setq response text))
(websocket-close (ws) (setq closed t))
(process-get (process sym) ws))
;; Bad request, in two parts
(flet ((websocket-verify-client-headers (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)
(flet ((websocket-verify-client-headers (text) t)
(websocket-get-server-response (ws protocols extensions)
(websocket-process-input-on-open-ws (ws text)
(setq processed t)
(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
(concat "GET /chat HTTP/1.1\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"))))
(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)))
(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)))
(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 ()
(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
"in callback `on-message': End of buffer")
'(wrong-number-of-arguments 1 2)
"in callback `on-close': Wrong number of arguments: 1, 2")))
Something went wrong with that request. Please try again.