;;; websocket-test.el --- Unit tests for the websocket layer ;; Copyright (c) 2013 Free Software Foundation, Inc. ;; ;; Author: Andrew Hyatt ;; Maintainer: Andrew Hyatt ;; ;; 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 ;; 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 . ;;; 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 (eq 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")))))) (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=")) (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))) (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-create-headers () (let ((system-name "mysystem") (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"))))))) (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) (flet ((websocket-send (websocket content) (setq sent content))) (should (equal (make-websocket-frame :opcode 'pong :completep t) (progn (funcall (websocket-process-frame websocket (make-websocket-frame :opcode 'ping))) sent)))) (flet ((delete-process (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))) (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. (let ((websocket-mask-frames nil)) (should (equal websocket-test-hello (websocket-encode-frame (make-websocket-frame :opcode 'text :payload "Hello" :completep t)))) (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))))))))) (let ((websocket-mask-frames t)) (flet ((websocket-genbytes (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)))))) (should-not (websocket-frame-completep (websocket-read-frame (websocket-encode-frame (make-websocket-frame :opcode 'text :payload "Hello" :completep nil))))) (dolist (opcode '(close ping pong)) (should (equal opcode (websocket-frame-opcode (websocket-read-frame (websocket-encode-frame (make-websocket-frame :opcode opcode :completep t)))))))) (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))) (websocket-close (websocket-inner-create :conn "fake-conn" :url t :accept-string t)) (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) (websocket-encode-frame frame2)))) (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)) (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))) (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) (websocket-closed-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!")) (error (should-not on-open-calledp) (should websocket-closed-calledp)))))) (ert-deftest websocket-send-text () (flet ((websocket-send (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))) ;; 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") (origin "Origin: origin") (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)) (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) "response") (websocket-process-input-on-open-ws (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" "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))))))) (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)) (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 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")))