code.delx.au - gnu-emacs-elpa/blob - packages/websocket/websocket-test.el

   1 ;;; websocket-test.el --- Unit tests for the websocket layer
   2
   3 ;; Copyright (c) 2013  Free Software Foundation, Inc.
   4 ;;
   5 ;; Author: Andrew Hyatt <ahyatt at gmail dot com>
   6 ;; Maintainer: Andrew Hyatt <ahyatt at gmail dot com>
   7 ;;
   8 ;; This program is free software; you can redistribute it and/or
   9 ;; modify it under the terms of the GNU General Public License as
  10 ;; published by the Free Software Foundation; either version 3 of the
  11 ;; License, or (at your option) any later version.
  12 ;;
  13 ;; This program is distributed in the hope that it will be useful, but
  14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 ;; General Public License for more details.
  17 ;;
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22 ;; This defines and runs ert unit tests.  You can download ert from:
  23 ;; http://github.com/ohler/ert, it also comes with Emacs 24 and above.
  24
  25 (require 'ert)
  26 (require 'websocket)
  27 (eval-when-compile (require 'cl))
  28
  29 (ert-deftest websocket-genbytes-length ()
  30   (loop repeat 100
  31         do (should (= (string-bytes (websocket-genbytes 16)) 16))))
  32
  33 (ert-deftest websocket-calculate-accept ()
  34   ;; This example comes straight from RFC 6455
  35   (should
  36    (equal "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="
  37           (websocket-calculate-accept "dGhlIHNhbXBsZSBub25jZQ=="))))
  38
  39 (defconst websocket-test-hello "\x81\x05\x48\x65\x6c\x6c\x6f"
  40   "'Hello' string example, taken from the RFC.")
  41
  42 (defconst websocket-test-masked-hello
  43   "\x81\x85\x37\xfa\x21\x3d\x7f\x9f\x4d\x51\x58"
  44   "'Hello' masked string example, taken from the RFC.")
  45
  46 (ert-deftest websocket-get-bytes ()
  47   (should (equal #x5 (websocket-get-bytes "\x5" 1)))
  48   (should (equal #x101 (websocket-get-bytes "\x1\x1" 2)))
  49   (should (equal #xffffff
  50                  (websocket-get-bytes "\x0\x0\x0\x0\x0\xFF\xFF\xFF" 8)))
  51   (should-error (websocket-get-bytes "\x0\x0\x0\x1\x0\x0\x0\x1" 8)
  52                 :type 'websocket-unparseable-frame)
  53   (should-error (websocket-get-bytes "\x0\x0\x0" 3))
  54   (should-error (websocket-get-bytes "\x0" 2) :type 'websocket-unparseable-frame))
  55
  56 (ert-deftest websocket-get-opcode ()
  57   (should (equal 'text (websocket-get-opcode websocket-test-hello))))
  58
  59 (ert-deftest websocket-get-payload-len ()
  60   (should (equal '(5 . 1)
  61                  (websocket-get-payload-len
  62                   (substring websocket-test-hello 1))))
  63   (should (equal '(200 . 3)
  64                  (websocket-get-payload-len
  65                   (bindat-pack '((:len u8) (:val u16))
  66                                `((:len . 126)
  67                                  (:val . 200))))))
  68   ;; we don't want to hit up any limits even on strange emacs builds,
  69   ;; so this test has a pretty small test value
  70   (should (equal '(70000 . 9)
  71                  (websocket-get-payload-len
  72                   (bindat-pack '((:len u8) (:val vec 2 u32))
  73                                `((:len . 127)
  74                                  (:val . [0 70000])))))))
  75
  76 (ert-deftest websocket-read-frame ()
  77   (should (equal (make-websocket-frame :opcode 'text :payload "Hello"
  78                                        :length (length websocket-test-hello)
  79                                        :completep t)
  80                  (websocket-read-frame websocket-test-hello)))
  81   (should (equal (make-websocket-frame :opcode 'text :payload "Hello"
  82                                        :length (length websocket-test-hello)
  83                                        :completep t)
  84                  (websocket-read-frame (concat websocket-test-hello
  85                                                "should-not-be-read"))))
  86   (should (equal (make-websocket-frame :opcode 'text :payload "Hello"
  87                                        :length (length websocket-test-masked-hello)
  88                                        :completep t)
  89                  (websocket-read-frame websocket-test-masked-hello)))
  90   (should (equal (make-websocket-frame :opcode 'text :payload "Hello"
  91                                        :length (length websocket-test-hello)
  92                                        :completep nil)
  93                  (websocket-read-frame
  94                   (concat (unibyte-string
  95                            (logand (string-to-char
  96                                     (substring websocket-test-hello 0 1))
  97                                    127))
  98                           (substring websocket-test-hello 1)))))
  99   (dotimes (i (- (length websocket-test-hello) 1))
 100     (should-not (websocket-read-frame
 101                  (substring websocket-test-hello 0
 102                             (- (length websocket-test-hello) (+ i 1))))))
 103   (dotimes (i (- (length websocket-test-masked-hello) 1))
 104     (should-not (websocket-read-frame
 105                  (substring websocket-test-masked-hello 0
 106                             (- (length websocket-test-masked-hello) (+ i 1)))))))
 107
 108 (defun websocket-test-header-with-lines (&rest lines)
 109   (mapconcat 'identity (append lines '("\r\n")) "\r\n"))
 110
 111 (ert-deftest websocket-verify-response-code ()
 112   (should (websocket-verify-response-code "HTTP/1.1 101"))
 113   (should
 114    (eq 400 (cdr (should-error (websocket-verify-response-code "HTTP/1.1 400")
 115                           :type 'websocket-received-error-http-response))))
 116   (should
 117    (eq 200 (cdr (should-error (websocket-verify-response-code "HTTP/1.1 200"))))))
 118
 119 (ert-deftest websocket-verify-headers ()
 120   (let ((accept "Sec-WebSocket-Accept: s3pPLMBiTxaQ9kYGzzhZRbK+xOo=")
 121         (invalid-accept "Sec-WebSocket-Accept: bad")
 122         (upgrade "Upgrade: websocket")
 123         (connection "Connection: upgrade")
 124         (ws (websocket-inner-create
 125              :conn "fake-conn" :url "ws://foo/bar"
 126              :accept-string "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="))
 127         (ws-with-protocol
 128          (websocket-inner-create
 129              :conn "fake-conn" :url "ws://foo/bar"
 130              :accept-string "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="
 131              :protocols '("myprotocol")))
 132         (ws-with-extensions
 133          (websocket-inner-create
 134              :conn "fake-conn" :url "ws://foo/bar"
 135              :accept-string "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="
 136              :extensions '("ext1" "ext2"))))
 137     (should (websocket-verify-headers
 138              ws
 139              (websocket-test-header-with-lines accept upgrade connection)))
 140     (should-error
 141      (websocket-verify-headers
 142       ws
 143       (websocket-test-header-with-lines invalid-accept upgrade connection))
 144      :type 'websocket-invalid-header)
 145     (should-error (websocket-verify-headers
 146                    ws
 147                    (websocket-test-header-with-lines upgrade connection))
 148                   :type 'websocket-invalid-header)
 149     (should-error (websocket-verify-headers
 150                    ws
 151                    (websocket-test-header-with-lines accept connection))
 152                   :type 'websocket-invalid-header)
 153     (should-error (websocket-verify-headers
 154                    ws
 155                    (websocket-test-header-with-lines accept upgrade))
 156                   :type 'websocket-invalid-header)
 157     (should-error (websocket-verify-headers
 158                    ws-with-protocol
 159                    (websocket-test-header-with-lines accept upgrade connection))
 160                   :type 'websocket-invalid-header)
 161     (should-error
 162      (websocket-verify-headers
 163       ws-with-protocol
 164       (websocket-test-header-with-lines accept upgrade connection
 165                                         "Sec-Websocket-Protocol: foo"))
 166      :type 'websocket-invalid-header)
 167     (should
 168      (websocket-verify-headers
 169       ws-with-protocol
 170       (websocket-test-header-with-lines accept upgrade connection
 171                                         "Sec-Websocket-Protocol: myprotocol")))
 172     (should (equal '("myprotocol")
 173                    (websocket-negotiated-protocols ws-with-protocol)))
 174     (should-error
 175      (websocket-verify-headers
 176       ws-with-extensions
 177       (websocket-test-header-with-lines accept upgrade connection
 178                                         "Sec-Websocket-Extensions: foo")))
 179     (should
 180      (websocket-verify-headers
 181       ws-with-extensions
 182       (websocket-test-header-with-lines
 183        accept upgrade connection "Sec-Websocket-Extensions: ext1, ext2; a=1")))
 184     (should (equal '("ext1" "ext2; a=1")
 185                    (websocket-negotiated-extensions ws-with-extensions)))
 186     (should
 187      (websocket-verify-headers
 188       ws-with-extensions
 189       (websocket-test-header-with-lines accept upgrade connection
 190                                         "Sec-Websocket-Extensions: ext1"
 191                                         "Sec-Websocket-Extensions: ext2; a=1")))
 192     (should (equal '("ext1" "ext2; a=1")
 193                    (websocket-negotiated-extensions ws-with-extensions)))))
 194
 195 (ert-deftest websocket-create-headers ()
 196   (let ((system-name "mysystem")
 197         (base-headers (concat "Host: www.example.com\r\n"
 198                               "Upgrade: websocket\r\n"
 199                               "Connection: Upgrade\r\n"
 200                               "Sec-WebSocket-Key: key\r\n"
 201                               "Origin: mysystem\r\n"
 202                               "Sec-WebSocket-Version: 13\r\n")))
 203     (should (equal (concat base-headers "\r\n")
 204                    (websocket-create-headers "ws://www.example.com/path"
 205                                              "key" nil nil)))
 206     (should (equal (concat base-headers
 207                            "Sec-WebSocket-Protocol: protocol\r\n\r\n")
 208                    (websocket-create-headers "ws://www.example.com/path"
 209                                              "key" '("protocol") nil)))
 210     (should (equal
 211              (concat base-headers
 212                      "Sec-WebSocket-Extensions: ext1; a; b=2, ext2\r\n\r\n")
 213              (websocket-create-headers "ws://www.example.com/path"
 214                                        "key" nil
 215                                        '(("ext1" . ("a" "b=2"))
 216                                          ("ext2")))))))
 217
 218 (ert-deftest websocket-process-frame ()
 219   (let* ((sent)
 220          (processed)
 221          (deleted)
 222          (websocket (websocket-inner-create
 223                      :conn t :url t
 224                      :on-message (lambda (websocket frame)
 225                                    (setq
 226                                     processed
 227                                     (websocket-frame-payload frame)))
 228                      :accept-string t)))
 229     (dolist (opcode '(text binary continuation))
 230       (setq processed nil)
 231       (should (equal
 232                "hello"
 233                (progn
 234                  (funcall (websocket-process-frame
 235                    websocket
 236                    (make-websocket-frame :opcode opcode :payload "hello")))
 237                  processed))))
 238     (setq sent nil)
 239     (flet ((websocket-send (websocket content) (setq sent content)))
 240       (should (equal
 241                (make-websocket-frame :opcode 'pong :completep t)
 242                (progn
 243                  (funcall (websocket-process-frame websocket
 244                                            (make-websocket-frame :opcode 'ping)))
 245                  sent))))
 246     (flet ((delete-process (conn) (setq deleted t)))
 247       (should (progn
 248                 (funcall
 249                  (websocket-process-frame websocket
 250                                           (make-websocket-frame :opcode 'close)))
 251                 deleted)))))
 252
 253 (ert-deftest websocket-process-frame-error-handling ()
 254   (let* ((error-called)
 255          (websocket (websocket-inner-create
 256                      :conn t :url t :accept-string t
 257                      :on-message (lambda (websocket frame)
 258                                    (message "In on-message")
 259                                    (error "err"))
 260                      :on-error (lambda (ws type err)
 261                                  (should (eq 'on-message type))
 262                                  (setq error-called t)))))
 263     (funcall (websocket-process-frame websocket
 264                                       (make-websocket-frame :opcode 'text
 265                                                             :payload "hello")))
 266     (should error-called)))
 267
 268 (ert-deftest websocket-to-bytes ()
 269   ;; We've tested websocket-get-bytes by itself, now we can use it to
 270   ;; help test websocket-to-bytes.
 271   (should (equal 30 (websocket-get-bytes (websocket-to-bytes 30 1) 1)))
 272   (should (equal 300 (websocket-get-bytes (websocket-to-bytes 300 2) 2)))
 273   (should (equal 70000 (websocket-get-bytes (websocket-to-bytes 70000 8) 8)))
 274   (should-error (websocket-to-bytes 536870912 8) :type 'websocket-frame-too-large)
 275   (should-error (websocket-to-bytes 30 3))
 276   (should-error (websocket-to-bytes 300 1))
 277   ;; I'd like to test the error for 32-byte systems on 8-byte lengths,
 278   ;; but elisp does not allow us to temporarily set constants such as
 279   ;; most-positive-fixnum.
 280   )
 281
 282 (ert-deftest websocket-encode-frame ()
 283   ;; We've tested websocket-read-frame, now we can use that to help
 284   ;; test websocket-encode-frame.
 285   (let ((websocket-mask-frames nil))
 286     (should (equal
 287              websocket-test-hello
 288              (websocket-encode-frame
 289               (make-websocket-frame :opcode 'text :payload "Hello" :completep t))))
 290     (dolist (len '(200 70000))
 291       (let ((long-string (make-string len ?x)))
 292         (should (equal long-string
 293                        (websocket-frame-payload
 294                         (websocket-read-frame
 295                          (websocket-encode-frame
 296                           (make-websocket-frame :opcode 'text
 297                                                 :payload long-string)))))))))
 298   (let ((websocket-mask-frames t))
 299     (flet ((websocket-genbytes (n) (substring websocket-test-masked-hello 2 6)))
 300       (should (equal websocket-test-masked-hello
 301                      (websocket-encode-frame
 302                       (make-websocket-frame :opcode 'text :payload "Hello"
 303                                             :completep t))))))
 304   (should-not
 305    (websocket-frame-completep
 306     (websocket-read-frame
 307      (websocket-encode-frame (make-websocket-frame :opcode 'text
 308                                                    :payload "Hello"
 309                                                    :completep nil)))))
 310   (dolist (opcode '(close ping pong))
 311     (should (equal
 312              opcode
 313              (websocket-frame-opcode
 314               (websocket-read-frame
 315                (websocket-encode-frame (make-websocket-frame :opcode opcode
 316                                                              :completep t))))))))
 317
 318 (ert-deftest websocket-close ()
 319   (let ((sent-frames)
 320         (processes-deleted))
 321     (flet ((websocket-send (websocket frame) (push frame sent-frames))
 322            (websocket-openp (websocket) t)
 323            (kill-buffer (buffer))
 324            (delete-process (proc))
 325            (process-buffer (conn) (add-to-list 'processes-deleted conn)))
 326       (websocket-close (websocket-inner-create
 327                         :conn "fake-conn"
 328                         :url t
 329                         :accept-string t))
 330       (should (equal sent-frames (list
 331                                   (make-websocket-frame :opcode 'close
 332                                                         :completep t))))
 333       (should (equal processes-deleted '("fake-conn"))))))
 334
 335 (ert-deftest websocket-outer-filter ()
 336   (let* ((fake-ws (websocket-inner-create
 337                    :conn t :url t :accept-string t
 338                    :on-open (lambda (websocket)
 339                               (should (eq (websocket-ready-state websocket)
 340                                           'open))
 341                               (setq open-callback-called t)
 342                               (error "Ignore me!"))
 343                    :on-error (lambda (ws type err))))
 344          (processed-frames)
 345          (frame1 (make-websocket-frame :opcode 'text :payload "foo" :completep t
 346                                        :length 9))
 347          (frame2 (make-websocket-frame :opcode 'text :payload "bar" :completep t
 348                                        :length 9))
 349          (open-callback-called)
 350          (websocket-frames
 351           (concat
 352            (websocket-encode-frame frame1)
 353            (websocket-encode-frame frame2))))
 354     (flet ((websocket-process-frame
 355             (websocket frame)
 356             (lexical-let ((frame frame))
 357               (lambda () (push frame processed-frames))))
 358            (websocket-verify-response-code (output) t)
 359            (websocket-verify-headers (websocket output) t))
 360       (websocket-outer-filter fake-ws "Sec-")
 361       (should (eq (websocket-ready-state fake-ws) 'connecting))
 362       (should-not open-callback-called)
 363       (websocket-outer-filter fake-ws "WebSocket-Accept: acceptstring")
 364       (should-not open-callback-called)
 365       (websocket-outer-filter fake-ws (concat
 366                                        "\r\n\r\n"
 367                                        (substring websocket-frames 0 2)))
 368       (should open-callback-called)
 369       (websocket-outer-filter fake-ws (substring websocket-frames 2))
 370       (should (equal (list frame2 frame1) processed-frames))
 371       (should-not (websocket-inflight-input fake-ws)))
 372     (flet ((websocket-close (websocket)))
 373       (setf (websocket-ready-state fake-ws) 'connecting)
 374       (should (eq 500 (cdr (should-error
 375                                 (websocket-outer-filter fake-ws "HTTP/1.1 500\r\n\r\n")
 376                                 :type 'websocket-received-error-http-response)))))))
 377
 378 (ert-deftest websocket-outer-filter-bad-connection ()
 379   (let* ((on-open-calledp)
 380          (websocket-closed-calledp)
 381          (fake-ws (websocket-inner-create
 382                    :conn t :url t :accept-string t
 383                    :on-open (lambda (websocket)
 384                               (setq on-open-calledp t)))))
 385     (flet ((websocket-verify-response-code (output) t)
 386            (websocket-verify-headers (websocket output) (error "Bad headers!"))
 387            (websocket-close (websocket) (setq websocket-closed-calledp t)))
 388       (condition-case err
 389           (progn (websocket-outer-filter fake-ws "HTTP/1.1 101\r\n\r\n")
 390                  (error "Should have thrown an error!"))
 391         (error
 392          (should-not on-open-calledp)
 393          (should websocket-closed-calledp))))))
 394
 395 (ert-deftest websocket-send-text ()
 396   (flet ((websocket-send (ws frame)
 397                          (should (equal
 398                                   (websocket-frame-payload frame)
 399                                   "\344\275\240\345\245\275"))))
 400     (websocket-send-text nil "你好")))
 401
 402 (ert-deftest websocket-send ()
 403   (let ((ws (websocket-inner-create :conn t :url t :accept-string t)))
 404     (flet ((websocket-ensure-connected (websocket))
 405            (websocket-openp (websocket) t)
 406            (process-send-string (conn string)))
 407       ;; Just make sure there is no error.
 408       (websocket-send ws (make-websocket-frame :opcode 'ping
 409                                                        :completep t)))
 410     (should-error (websocket-send ws
 411                                   (make-websocket-frame :opcode 'text)))
 412     (should-error (websocket-send ws
 413                                   (make-websocket-frame :opcode 'close
 414                                                         :payload "bye!"
 415                                                         :completep t))
 416                   :type 'websocket-illegal-frame)
 417     (should-error (websocket-send ws
 418                                   (make-websocket-frame :opcode :close))
 419                   :type 'websocket-illegal-frame)))
 420
 421 (ert-deftest websocket-verify-client-headers ()
 422   (let* ((http "HTTP/1.1")
 423          (host "Host: authority")
 424          (upgrade "Upgrade: websocket")
 425          (key (format "Sec-Websocket-Key: %s" "key"))
 426          (version "Sec-Websocket-Version: 13")
 427          (origin "Origin: origin")
 428          (protocol "Sec-Websocket-Protocol: protocol")
 429          (extensions1 "Sec-Websocket-Extensions: foo")
 430          (extensions2 "Sec-Websocket-Extensions: bar; baz=2")
 431          (all-required-headers (list host upgrade key version)))
 432     ;; Test that all these headers are necessary
 433     (should (equal
 434              '(:key "key" :protocols ("protocol") :extensions ("foo" "bar; baz=2"))
 435              (websocket-verify-client-headers
 436               (mapconcat 'identity (append (list http "" protocol extensions1 extensions2)
 437                                            all-required-headers) "\r\n"))))
 438     (should (websocket-verify-client-headers
 439               (mapconcat 'identity
 440                          (mapcar 'upcase
 441                                  (append (list http "" protocol extensions1 extensions2)
 442                                          all-required-headers)) "\r\n")))
 443     (dolist (header all-required-headers)
 444       (should-not (websocket-verify-client-headers
 445                    (mapconcat 'identity (append (list http "")
 446                                                 (remove header all-required-headers))
 447                               "\r\n"))))
 448     (should-not (websocket-verify-client-headers
 449                  (mapconcat 'identity (append (list "HTTP/1.0" "") all-required-headers)
 450                             "\r\n")))))
 451
 452 (ert-deftest websocket-intersect ()
 453   (should (equal '(2) (websocket-intersect '(1 2) '(2 3))))
 454   (should (equal nil (websocket-intersect '(1 2) '(3 4))))
 455   (should (equal '(1 2) (websocket-intersect '(1 2) '(1 2)))))
 456
 457 (ert-deftest websocket-get-server-response ()
 458   (let ((ws (websocket-inner-create :conn t :url t :accept-string "key"
 459                                     :protocols '("spa" "spb")
 460                                     :extensions '("sea" "seb"))))
 461     (should (equal (concat
 462                     "HTTP/1.1 101 Switching Protocols\r\n"
 463                     "Upgrade: websocket\r\n"
 464                     "Connection: Upgrade\r\n"
 465                     "Sec-WebSocket-Accept: key\r\n\r\n")
 466                    (websocket-get-server-response ws nil nil)))
 467     (should (string-match "Sec-Websocket-Protocol: spb\r\n"
 468                           (websocket-get-server-response ws '("spb" "spc") nil)))
 469     (should-not (string-match "Sec-Websocket-Protocol:"
 470                               (websocket-get-server-response ws '("spc") nil)))
 471     (let ((output (websocket-get-server-response ws '("spa" "spb") nil)))
 472       (should (string-match "Sec-Websocket-Protocol: spa\r\n" output))
 473       (should (string-match "Sec-Websocket-Protocol: spb\r\n" output)))
 474     (should (string-match "Sec-Websocket-Extensions: sea"
 475                           (websocket-get-server-response ws nil '("sea" "sec"))))
 476     (should-not (string-match "Sec-Websocket-Extensions:"
 477                               (websocket-get-server-response ws nil '("sec"))))
 478     (let ((output (websocket-get-server-response ws nil '("sea" "seb"))))
 479       (should (string-match "Sec-Websocket-Extensions: sea\r\n" output))
 480       (should (string-match "Sec-Websocket-Extensions: seb\r\n" output)))))
 481
 482 (ert-deftest websocket-server-filter ()
 483   (let ((on-open-called)
 484         (ws (websocket-inner-create :conn t :url t :accept-string "key"
 485                                     :on-open (lambda (ws) (setq on-open-called t))))
 486         (closed)
 487         (response)
 488         (processed))
 489     (flet ((process-send-string (p text) (setq response text))
 490            (websocket-close (ws) (setq closed t))
 491            (process-get (process sym) ws))
 492      ;; Bad request, in two parts
 493      (flet ((websocket-verify-client-headers (text) nil))
 494        (websocket-server-filter nil "HTTP/1.0 GET /foo \r\n")
 495        (should-not closed)
 496        (websocket-server-filter nil "\r\n")
 497        (should (equal response "HTTP/1.1 400 Bad Request\r\n\r\n"))
 498        (should-not (websocket-inflight-input ws)))
 499     ;; Good request, followed by packet
 500      (setq closed nil
 501            response nil)
 502      (setf (websocket-inflight-input ws) nil)
 503      (flet ((websocket-verify-client-headers (text) t)
 504             (websocket-get-server-response (ws protocols extensions)
 505                                            "response")
 506             (websocket-process-input-on-open-ws (ws text)
 507                                                 (setq processed t)
 508                                                 (should
 509                                                  (equal text websocket-test-hello))))
 510        (websocket-server-filter nil
 511                                 (concat "\r\n\r\n" websocket-test-hello))
 512        (should (equal (websocket-ready-state ws) 'open))
 513        (should-not closed)
 514        (should (equal response "response"))
 515        (should processed)))))
 516
 517 (ert-deftest websocket-complete-server-response-test ()
 518   ;; Example taken from RFC
 519   (should (equal
 520            (concat "HTTP/1.1 101 Switching Protocols\r\n"
 521                    "Upgrade: websocket\r\n"
 522                    "Connection: Upgrade\r\n"
 523                    "Sec-WebSocket-Accept: s3pPLMBiTxaQ9kYGzzhZRbK+xOo=\r\n"
 524                    "Sec-WebSocket-Protocol: chat\r\n\r\n"
 525                    )
 526            (let ((header-info
 527                           (websocket-verify-client-headers
 528                            (concat "GET /chat HTTP/1.1\r\n"
 529                                    "Host: server.example.com\r\n"
 530                                    "Upgrade: websocket\r\n"
 531                                    "Connection: Upgrade\r\n"
 532                                    "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==\r\n"
 533                                    "Origin: http://example.com\r\n"
 534                                    "Sec-WebSocket-Protocol: chat, superchat\r\n"
 535                                    "Sec-WebSocket-Version: 13\r\n"))))
 536                      (should header-info)
 537                      (let ((ws (websocket-inner-create
 538                                 :conn t :url t
 539                                 :accept-string (websocket-calculate-accept
 540                                                 (plist-get header-info :key))
 541                                 :protocols '("chat"))))
 542                        (websocket-get-server-response
 543                         ws
 544                         (plist-get header-info :protocols)
 545                         (plist-get header-info :extension)))))))
 546
 547 (ert-deftest websocket-server-close ()
 548   (let ((websocket-server-websockets
 549          (list (websocket-inner-create :conn 'conn-a :url t :accept-string t
 550                                        :server-conn 'a
 551                                        :ready-state 'open)
 552                (websocket-inner-create :conn 'conn-b :url t :accept-string t
 553                                        :server-conn 'b
 554                                        :ready-state 'open)
 555                (websocket-inner-create :conn 'conn-c :url t :accept-string t
 556                                        :server-conn 'b
 557                                        :ready-state 'closed)))
 558         (deleted-processes)
 559         (closed-websockets))
 560     (flet ((delete-process (conn) (add-to-list 'deleted-processes conn))
 561            (websocket-close (ws)
 562                             ;; we always remove on closing in the
 563                             ;; actual code.
 564                             (setq websocket-server-websockets
 565                                   (remove ws websocket-server-websockets))
 566                             (should-not (eq (websocket-ready-state ws) 'closed))
 567                             (add-to-list 'closed-websockets ws)))
 568       (websocket-server-close 'b))
 569     (should (equal deleted-processes '(b)))
 570     (should (eq 1 (length closed-websockets)))
 571     (should (eq 'conn-b (websocket-conn (car closed-websockets))))
 572     (should (eq 1 (length websocket-server-websockets)))
 573     (should (eq 'conn-a (websocket-conn (car websocket-server-websockets))))))
 574
 575 (ert-deftest websocket-default-error-handler ()
 576   (flet ((try-error
 577           (callback-type err expected-message)
 578           (flet ((display-warning
 579                   (type message &optional level buffer-name)
 580                   (should (eq type 'websocket))
 581                   (should (eq level :error))
 582                   (should (string= message expected-message))))
 583             (websocket-default-error-handler nil
 584                                              callback-type
 585                                              err))))
 586     (try-error
 587      'on-message
 588      '(end-of-buffer)
 589      "in callback `on-message': End of buffer")
 590
 591     (try-error
 592      'on-close
 593      '(wrong-number-of-arguments 1 2)
 594      "in callback `on-close': Wrong number of arguments: 1, 2")))