Skip to content
Newer
Older
100644 576 lines (545 sloc) 27.1 KB
0202adc @ahyatt Finish and test the server filter function.
authored Aug 11, 2012
1 ;; websocket-test.el --- Unit tests for the websocket layer
59697b4 @ahyatt Initial checkin of files. These files were initially part of the
authored May 6, 2012
2
3 ;; Copyright (c) 2010 Andrew Hyatt
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 2 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 this program; if not, write to the Free Software
20 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
21 ;; 02110-1301, USA.
22
23 ;;; Commentary:
24 ;; This defines and runs ert unit tests. You can download ert from:
25 ;; http://github.com/ohler/ert, it also comes with Emacs 24 and above.
26
27 (require 'ert)
9d8794a @tkf Suppress compilation warning in websocket-test.el
tkf authored May 7, 2012
28 (require 'websocket)
29 (eval-when-compile (require 'cl))
59697b4 @ahyatt Initial checkin of files. These files were initially part of the
authored May 6, 2012
30
45245a4 @tkf Add test websocket-genbytes-length
tkf authored May 7, 2012
31 (ert-deftest websocket-genbytes-length ()
32 (loop repeat 100
82e85aa @ahyatt Fix test for websocket-genbytes
authored May 22, 2012
33 do (should (= (string-bytes (websocket-genbytes 16)) 16))))
45245a4 @tkf Add test websocket-genbytes-length
tkf authored May 6, 2012
34
b5bbce1 @ahyatt Add a function to calculate the accept header expected.
authored May 6, 2012
35 (ert-deftest websocket-calculate-accept ()
36 ;; This example comes straight from RFC 6455
37 (should
38 (equal "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="
237b190 @ahyatt Various whitespace changes
authored May 24, 2012
39 (websocket-calculate-accept "dGhlIHNhbXBsZSBub25jZQ=="))))
b5bbce1 @ahyatt Add a function to calculate the accept header expected.
authored May 7, 2012
40
f4e1aa8 @ahyatt Add helper functions for websocket-get-opcode and
authored May 17, 2012
41 (defconst websocket-test-hello "\x81\x05\x48\x65\x6c\x6c\x6f"
42 "'Hello' string example, taken from the RFC.")
237b190 @ahyatt Various whitespace changes
authored May 25, 2012
43
4c8dbe2 @ahyatt Implement masking and unmasking.
authored May 19, 2012
44 (defconst websocket-test-masked-hello
45 "\x81\x85\x37\xfa\x21\x3d\x7f\x9f\x4d\x51\x58"
46 "'Hello' masked string example, taken from the RFC.")
f4e1aa8 @ahyatt Add helper functions for websocket-get-opcode and
authored May 17, 2012
47
b948e95 @ahyatt Fixed payload len logic, and rewrote the bit-grabbing bits to just
authored May 18, 2012
48 (ert-deftest websocket-get-bytes ()
49 (should (equal #x5 (websocket-get-bytes "\x5" 1)))
50 (should (equal #x101 (websocket-get-bytes "\x1\x1" 2)))
d29b171 @ahyatt Remove calc requirement, based on observations and suggestions by Jul…
authored Sep 2, 2012
51 (should (equal #xffffff
52 (websocket-get-bytes "\x0\x0\x0\x0\x0\xFF\xFF\xFF" 8)))
b65328c @ahyatt Made the max number of bytes transimssible 2^29 - 1 instead of 2^32 - 1.
authored Sep 2, 2012
53 (should-error (websocket-get-bytes "\x0\x0\x0\x1\x0\x0\x0\x1" 8)
54 :type 'websocket-unparseable-frame)
b948e95 @ahyatt Fixed payload len logic, and rewrote the bit-grabbing bits to just
authored May 19, 2012
55 (should-error (websocket-get-bytes "\x0\x0\x0" 3))
8904556 @ahyatt Switch from using generic errors, to using named symbols.
authored Aug 5, 2012
56 (should-error (websocket-get-bytes "\x0" 2) :type 'websocket-unparseable-frame))
b948e95 @ahyatt Fixed payload len logic, and rewrote the bit-grabbing bits to just
authored May 19, 2012
57
f4e1aa8 @ahyatt Add helper functions for websocket-get-opcode and
authored May 17, 2012
58 (ert-deftest websocket-get-opcode ()
59 (should (equal 'text (websocket-get-opcode websocket-test-hello))))
60
61 (ert-deftest websocket-get-payload-len ()
b948e95 @ahyatt Fixed payload len logic, and rewrote the bit-grabbing bits to just
authored May 19, 2012
62 (should (equal '(5 . 1)
63 (websocket-get-payload-len
64 (substring websocket-test-hello 1))))
f4e1aa8 @ahyatt Add helper functions for websocket-get-opcode and
authored May 17, 2012
65 (should (equal '(200 . 3)
66 (websocket-get-payload-len
b948e95 @ahyatt Fixed payload len logic, and rewrote the bit-grabbing bits to just
authored May 19, 2012
67 (bindat-pack '((:len u8) (:val u16))
68 `((:len . 126)
f4e1aa8 @ahyatt Add helper functions for websocket-get-opcode and
authored May 17, 2012
69 (:val . 200))))))
70 ;; we don't want to hit up any limits even on strange emacs builds,
71 ;; so this test has a pretty small test value
72 (should (equal '(70000 . 9)
73 (websocket-get-payload-len
b948e95 @ahyatt Fixed payload len logic, and rewrote the bit-grabbing bits to just
authored May 19, 2012
74 (bindat-pack '((:len u8) (:val vec 2 u32))
75 `((:len . 127)
f4e1aa8 @ahyatt Add helper functions for websocket-get-opcode and
authored May 17, 2012
76 (:val . [0 70000])))))))
ae51a78 @ahyatt Code to read a frame. Does not yet support masking.
authored May 18, 2012
77
78 (ert-deftest websocket-read-frame ()
7900cda @ahyatt Return the length of the websocket frame from websocket-read-frame.
authored May 20, 2012
79 (should (equal (make-websocket-frame :opcode 'text :payload "Hello"
b0a2970 @ahyatt Add completep in frame
authored May 21, 2012
80 :length (length websocket-test-hello)
81 :completep t)
4c8dbe2 @ahyatt Implement masking and unmasking.
authored May 19, 2012
82 (websocket-read-frame websocket-test-hello)))
7900cda @ahyatt Return the length of the websocket frame from websocket-read-frame.
authored May 20, 2012
83 (should (equal (make-websocket-frame :opcode 'text :payload "Hello"
b0a2970 @ahyatt Add completep in frame
authored May 22, 2012
84 :length (length websocket-test-hello)
85 :completep t)
7900cda @ahyatt Return the length of the websocket frame from websocket-read-frame.
authored May 20, 2012
86 (websocket-read-frame (concat websocket-test-hello
87 "should-not-be-read"))))
88 (should (equal (make-websocket-frame :opcode 'text :payload "Hello"
b0a2970 @ahyatt Add completep in frame
authored May 22, 2012
89 :length (length websocket-test-masked-hello)
90 :completep t)
51b5764 @ahyatt Ensure the websocket frame is complete, and return NIL if not.
authored May 19, 2012
91 (websocket-read-frame websocket-test-masked-hello)))
b0a2970 @ahyatt Add completep in frame
authored May 22, 2012
92 (should (equal (make-websocket-frame :opcode 'text :payload "Hello"
93 :length (length websocket-test-hello)
94 :completep nil)
1081075 @ahyatt More whitespace changes
authored May 25, 2012
95 (websocket-read-frame
96 (concat (unibyte-string
97 (logand (string-to-char
98 (substring websocket-test-hello 0 1))
99 127))
100 (substring websocket-test-hello 1)))))
51b5764 @ahyatt Ensure the websocket frame is complete, and return NIL if not.
authored May 20, 2012
101 (dotimes (i (- (length websocket-test-hello) 1))
102 (should-not (websocket-read-frame
103 (substring websocket-test-hello 0
104 (- (length websocket-test-hello) (+ i 1))))))
105 (dotimes (i (- (length websocket-test-masked-hello) 1))
106 (should-not (websocket-read-frame
107 (substring websocket-test-masked-hello 0
108 (- (length websocket-test-masked-hello) (+ i 1)))))))
8da9119 @ahyatt Separate out the handshake verification logic, and test it. Look for
authored May 20, 2012
109
fb26aa7 @ahyatt Make the API more like W3C's API.
authored May 31, 2012
110 (defun websocket-test-header-with-lines (&rest lines)
111 (mapconcat 'identity (append lines '("\r\n")) "\r\n"))
8da9119 @ahyatt Separate out the handshake verification logic, and test it. Look for
authored May 20, 2012
112
6c42988 @ahyatt Check for HTTP 101 response code, and if there is any failure in the
authored Jun 2, 2012
113 (ert-deftest websocket-verify-response-code ()
114 (should (websocket-verify-response-code "HTTP/1.1 101"))
8904556 @ahyatt Switch from using generic errors, to using named symbols.
authored Aug 6, 2012
115 (should
116 (eq 400 (cdr (should-error (websocket-verify-response-code "HTTP/1.1 400")
117 :type 'websocket-received-error-http-response))))
118 (should
119 (eq 200 (cdr (should-error (websocket-verify-response-code "HTTP/1.1 200"))))))
6c42988 @ahyatt Check for HTTP 101 response code, and if there is any failure in the
authored Jun 3, 2012
120
fb26aa7 @ahyatt Make the API more like W3C's API.
authored Jun 1, 2012
121 (ert-deftest websocket-verify-headers ()
122 (let ((accept "Sec-WebSocket-Accept: s3pPLMBiTxaQ9kYGzzhZRbK+xOo=")
123 (invalid-accept "Sec-WebSocket-Accept: bad")
124 (upgrade "Upgrade: websocket")
125 (connection "Connection: upgrade")
126 (ws (websocket-inner-create
127 :conn "fake-conn" :url "ws://foo/bar"
128 :accept-string "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="))
129 (ws-with-protocol
130 (websocket-inner-create
131 :conn "fake-conn" :url "ws://foo/bar"
132 :accept-string "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="
5a8b995 @ahyatt Add server header generation, and refactor protocol and extension han…
authored Aug 11, 2012
133 :protocols '("myprotocol")))
881c6ca @ahyatt Implement support for specifying extensions.
authored Jun 1, 2012
134 (ws-with-extensions
135 (websocket-inner-create
136 :conn "fake-conn" :url "ws://foo/bar"
137 :accept-string "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="
138 :extensions '("ext1" "ext2"))))
fb26aa7 @ahyatt Make the API more like W3C's API.
authored Jun 1, 2012
139 (should (websocket-verify-headers
140 ws
141 (websocket-test-header-with-lines accept upgrade connection)))
142 (should-error
143 (websocket-verify-headers
144 ws
8904556 @ahyatt Switch from using generic errors, to using named symbols.
authored Aug 6, 2012
145 (websocket-test-header-with-lines invalid-accept upgrade connection))
146 :type 'websocket-invalid-header)
fb26aa7 @ahyatt Make the API more like W3C's API.
authored Jun 1, 2012
147 (should-error (websocket-verify-headers
148 ws
8904556 @ahyatt Switch from using generic errors, to using named symbols.
authored Aug 6, 2012
149 (websocket-test-header-with-lines upgrade connection))
150 :type 'websocket-invalid-header)
fb26aa7 @ahyatt Make the API more like W3C's API.
authored Jun 1, 2012
151 (should-error (websocket-verify-headers
152 ws
8904556 @ahyatt Switch from using generic errors, to using named symbols.
authored Aug 6, 2012
153 (websocket-test-header-with-lines accept connection))
154 :type 'websocket-invalid-header)
fb26aa7 @ahyatt Make the API more like W3C's API.
authored Jun 1, 2012
155 (should-error (websocket-verify-headers
156 ws
8904556 @ahyatt Switch from using generic errors, to using named symbols.
authored Aug 6, 2012
157 (websocket-test-header-with-lines accept upgrade))
158 :type 'websocket-invalid-header)
fb26aa7 @ahyatt Make the API more like W3C's API.
authored Jun 1, 2012
159 (should-error (websocket-verify-headers
160 ws-with-protocol
8904556 @ahyatt Switch from using generic errors, to using named symbols.
authored Aug 6, 2012
161 (websocket-test-header-with-lines accept upgrade connection))
162 :type 'websocket-invalid-header)
fb26aa7 @ahyatt Make the API more like W3C's API.
authored Jun 1, 2012
163 (should-error
164 (websocket-verify-headers
165 ws-with-protocol
166 (websocket-test-header-with-lines accept upgrade connection
8904556 @ahyatt Switch from using generic errors, to using named symbols.
authored Aug 6, 2012
167 "Sec-Websocket-Protocol: foo"))
168 :type 'websocket-invalid-header)
fb26aa7 @ahyatt Make the API more like W3C's API.
authored Jun 1, 2012
169 (should
170 (websocket-verify-headers
171 ws-with-protocol
172 (websocket-test-header-with-lines accept upgrade connection
881c6ca @ahyatt Implement support for specifying extensions.
authored Jun 2, 2012
173 "Sec-Websocket-Protocol: myprotocol")))
5a8b995 @ahyatt Add server header generation, and refactor protocol and extension han…
authored Aug 11, 2012
174 (should (equal '("myprotocol")
175 (websocket-negotiated-protocols ws-with-protocol)))
881c6ca @ahyatt Implement support for specifying extensions.
authored Jun 2, 2012
176 (should-error
177 (websocket-verify-headers
178 ws-with-extensions
179 (websocket-test-header-with-lines accept upgrade connection
180 "Sec-Websocket-Extensions: foo")))
181 (should
182 (websocket-verify-headers
183 ws-with-extensions
184 (websocket-test-header-with-lines
185 accept upgrade connection "Sec-Websocket-Extensions: ext1, ext2; a=1")))
186 (should (equal '("ext1" "ext2; a=1")
5a8b995 @ahyatt Add server header generation, and refactor protocol and extension han…
authored Aug 11, 2012
187 (websocket-negotiated-extensions ws-with-extensions)))
881c6ca @ahyatt Implement support for specifying extensions.
authored Jun 2, 2012
188 (should
189 (websocket-verify-headers
190 ws-with-extensions
191 (websocket-test-header-with-lines accept upgrade connection
192 "Sec-Websocket-Extensions: ext1"
193 "Sec-Websocket-Extensions: ext2; a=1")))
194 (should (equal '("ext1" "ext2; a=1")
5a8b995 @ahyatt Add server header generation, and refactor protocol and extension han…
authored Aug 11, 2012
195 (websocket-negotiated-extensions ws-with-extensions)))))
881c6ca @ahyatt Implement support for specifying extensions.
authored Jun 2, 2012
196
197 (ert-deftest websocket-create-headers ()
198 (let ((system-name "mysystem")
199 (base-headers (concat "Host: www.example.com\r\n"
200 "Upgrade: websocket\r\n"
201 "Connection: Upgrade\r\n"
23b132e @ahyatt Fix failing ert tests
authored Aug 14, 2012
202 "Sec-WebSocket-Key: key\r\n"
881c6ca @ahyatt Implement support for specifying extensions.
authored Jun 2, 2012
203 "Origin: mysystem\r\n"
204 "Sec-WebSocket-Version: 13\r\n")))
205 (should (equal (concat base-headers "\r\n")
206 (websocket-create-headers "ws://www.example.com/path"
207 "key" nil nil)))
208 (should (equal (concat base-headers
209 "Sec-WebSocket-Protocol: protocol\r\n\r\n")
210 (websocket-create-headers "ws://www.example.com/path"
5a8b995 @ahyatt Add server header generation, and refactor protocol and extension han…
authored Aug 11, 2012
211 "key" '("protocol") nil)))
881c6ca @ahyatt Implement support for specifying extensions.
authored Jun 2, 2012
212 (should (equal
213 (concat base-headers
214 "Sec-WebSocket-Extensions: ext1; a; b=2, ext2\r\n\r\n")
215 (websocket-create-headers "ws://www.example.com/path"
216 "key" nil
217 '(("ext1" . ("a" "b=2"))
218 ("ext2")))))))
3a7798f @ahyatt Added frame processing, and more of the structure to use it.
authored May 20, 2012
219
220 (ert-deftest websocket-process-frame ()
221 (let* ((sent)
222 (processed)
223 (deleted)
fb26aa7 @ahyatt Make the API more like W3C's API.
authored Jun 1, 2012
224 (websocket (websocket-inner-create
225 :conn t :url t
226 :on-message (lambda (websocket frame)
227 (setq
228 processed
229 (websocket-frame-payload frame)))
230 :accept-string t)))
3a7798f @ahyatt Added frame processing, and more of the structure to use it.
authored May 21, 2012
231 (dolist (opcode '(text binary continuation))
232 (setq processed nil)
233 (should (equal
234 "hello"
235 (progn
14e94a4 @ahyatt Revamp how error processing works, increasing user control and
authored Jul 14, 2012
236 (funcall (websocket-process-frame
237 websocket
238 (make-websocket-frame :opcode opcode :payload "hello")))
3a7798f @ahyatt Added frame processing, and more of the structure to use it.
authored May 21, 2012
239 processed))))
240 (setq sent nil)
241 (flet ((websocket-send (websocket content) (setq sent content)))
242 (should (equal
7bc2aae @ahyatt Make websocket-send work on frames, and use it to send pongs.
authored May 21, 2012
243 (make-websocket-frame :opcode 'pong :completep t)
3a7798f @ahyatt Added frame processing, and more of the structure to use it.
authored May 21, 2012
244 (progn
14e94a4 @ahyatt Revamp how error processing works, increasing user control and
authored Jul 14, 2012
245 (funcall (websocket-process-frame websocket
246 (make-websocket-frame :opcode 'ping)))
3a7798f @ahyatt Added frame processing, and more of the structure to use it.
authored May 21, 2012
247 sent))))
248 (flet ((delete-process (conn) (setq deleted t)))
249 (should (progn
14e94a4 @ahyatt Revamp how error processing works, increasing user control and
authored Jul 14, 2012
250 (funcall
251 (websocket-process-frame websocket
252 (make-websocket-frame :opcode 'close)))
3a7798f @ahyatt Added frame processing, and more of the structure to use it.
authored May 21, 2012
253 deleted)))))
2148c5a @ahyatt Create the websocket-to-bytes function, to encode a number in a
authored May 21, 2012
254
14e94a4 @ahyatt Revamp how error processing works, increasing user control and
authored Jul 14, 2012
255 (ert-deftest websocket-process-frame-error-handling ()
256 (let* ((error-called)
257 (websocket (websocket-inner-create
258 :conn t :url t :accept-string t
259 :on-message (lambda (websocket frame)
260 (message "In on-message")
261 (error "err"))
262 :on-error (lambda (ws type err)
263 (should (eq 'on-message type))
264 (setq error-called t)))))
265 (funcall (websocket-process-frame websocket
266 (make-websocket-frame :opcode 'text
267 :payload "hello")))
268 (should error-called)))
269
2148c5a @ahyatt Create the websocket-to-bytes function, to encode a number in a
authored May 22, 2012
270 (ert-deftest websocket-to-bytes ()
271 ;; We've tested websocket-get-bytes by itself, now we can use it to
272 ;; help test websocket-to-bytes.
273 (should (equal 30 (websocket-get-bytes (websocket-to-bytes 30 1) 1)))
274 (should (equal 300 (websocket-get-bytes (websocket-to-bytes 300 2) 2)))
b65328c @ahyatt Made the max number of bytes transimssible 2^29 - 1 instead of 2^32 - 1.
authored Sep 3, 2012
275 (should (equal 70000 (websocket-get-bytes (websocket-to-bytes 70000 8) 8)))
276 (should-error (websocket-to-bytes 536870912 8) :type 'websocket-frame-too-large)
2148c5a @ahyatt Create the websocket-to-bytes function, to encode a number in a
authored May 22, 2012
277 (should-error (websocket-to-bytes 30 3))
cf885f0 @ahyatt Fix issue on < 64-bit systems in packing an 8 byte value.
authored Jul 7, 2012
278 (should-error (websocket-to-bytes 300 1))
279 ;; I'd like to test the error for 32-byte systems on 8-byte lengths,
280 ;; but elisp does not allow us to temporarily set constants such as
281 ;; most-positive-fixnum.
282 )
2148c5a @ahyatt Create the websocket-to-bytes function, to encode a number in a
authored May 22, 2012
283
3596d84 @ahyatt Write and test websocket-encode-frame.
authored May 21, 2012
284 (ert-deftest websocket-encode-frame ()
285 ;; We've tested websocket-read-frame, now we can use that to help
286 ;; test websocket-encode-frame.
655cf1e @ahyatt Support outbound masking
authored May 22, 2012
287 (let ((websocket-mask-frames nil))
288 (should (equal
289 websocket-test-hello
290 (websocket-encode-frame
291 (make-websocket-frame :opcode 'text :payload "Hello" :completep t))))
b65328c @ahyatt Made the max number of bytes transimssible 2^29 - 1 instead of 2^32 - 1.
authored Sep 3, 2012
292 (dolist (len '(200 70000))
237b190 @ahyatt Various whitespace changes
authored May 25, 2012
293 (let ((long-string (make-string len ?x)))
294 (should (equal long-string
295 (websocket-frame-payload
296 (websocket-read-frame
297 (websocket-encode-frame
1081075 @ahyatt More whitespace changes
authored May 26, 2012
298 (make-websocket-frame :opcode 'text
299 :payload long-string)))))))))
655cf1e @ahyatt Support outbound masking
authored May 23, 2012
300 (let ((websocket-mask-frames t))
301 (flet ((websocket-genbytes (n) (substring websocket-test-masked-hello 2 6)))
237b190 @ahyatt Various whitespace changes
authored May 25, 2012
302 (should (equal websocket-test-masked-hello
303 (websocket-encode-frame
1081075 @ahyatt More whitespace changes
authored May 26, 2012
304 (make-websocket-frame :opcode 'text :payload "Hello"
305 :completep t))))))
3596d84 @ahyatt Write and test websocket-encode-frame.
authored May 22, 2012
306 (should-not
307 (websocket-frame-completep
308 (websocket-read-frame
1081075 @ahyatt More whitespace changes
authored May 26, 2012
309 (websocket-encode-frame (make-websocket-frame :opcode 'text
310 :payload "Hello"
311 :completep nil)))))
0e04e15 @ahyatt Fix issue with encoding & decoding non-payload frames, and fix the
authored May 24, 2012
312 (dolist (opcode '(close ping pong))
3596d84 @ahyatt Write and test websocket-encode-frame.
authored May 22, 2012
313 (should (equal
314 opcode
315 (websocket-frame-opcode
316 (websocket-read-frame
0e04e15 @ahyatt Fix issue with encoding & decoding non-payload frames, and fix the
authored May 25, 2012
317 (websocket-encode-frame (make-websocket-frame :opcode opcode
318 :completep t))))))))
3596d84 @ahyatt Write and test websocket-encode-frame.
authored May 22, 2012
319
33ff92c @ahyatt Update websocket-close and test
authored May 25, 2012
320 (ert-deftest websocket-close ()
5c2b235 @ahyatt Implement proper behavior on closing of server.
authored Aug 16, 2012
321 (let ((sent-frames)
322 (processes-deleted))
33ff92c @ahyatt Update websocket-close and test
authored May 26, 2012
323 (flet ((websocket-send (websocket frame) (push frame sent-frames))
324 (websocket-openp (websocket) t)
325 (kill-buffer (buffer))
5c2b235 @ahyatt Implement proper behavior on closing of server.
authored Aug 16, 2012
326 (delete-process (proc))
327 (process-buffer (conn) (add-to-list 'processes-deleted conn)))
fb26aa7 @ahyatt Make the API more like W3C's API.
authored Jun 1, 2012
328 (websocket-close (websocket-inner-create
329 :conn "fake-conn"
330 :url t
331 :accept-string t))
33ff92c @ahyatt Update websocket-close and test
authored May 26, 2012
332 (should (equal sent-frames (list
333 (make-websocket-frame :opcode 'close
5c2b235 @ahyatt Implement proper behavior on closing of server.
authored Aug 16, 2012
334 :completep t))))
335 (should (equal processes-deleted '("fake-conn"))))))
b89e002 @ahyatt Test for websocket-outer-filter, plus removing some useless code from…
authored May 25, 2012
336
337 (ert-deftest websocket-outer-filter ()
fb26aa7 @ahyatt Make the API more like W3C's API.
authored Jun 1, 2012
338 (let* ((fake-ws (websocket-inner-create
339 :conn t :url t :accept-string t
340 :on-open (lambda (websocket)
341 (should (eq (websocket-ready-state websocket)
342 'open))
343 (setq open-callback-called t)
14e94a4 @ahyatt Revamp how error processing works, increasing user control and
authored Jul 14, 2012
344 (error "Ignore me!"))
345 :on-error (lambda (ws type err))))
b89e002 @ahyatt Test for websocket-outer-filter, plus removing some useless code from…
authored May 26, 2012
346 (processed-frames)
347 (frame1 (make-websocket-frame :opcode 'text :payload "foo" :completep t
348 :length 9))
349 (frame2 (make-websocket-frame :opcode 'text :payload "bar" :completep t
350 :length 9))
078fbf3 @ahyatt Implemented onopen callback. Soon to be renamed.
authored May 29, 2012
351 (open-callback-called)
b89e002 @ahyatt Test for websocket-outer-filter, plus removing some useless code from…
authored May 26, 2012
352 (websocket-frames
353 (concat
354 (websocket-encode-frame frame1)
355 (websocket-encode-frame frame2))))
14e94a4 @ahyatt Revamp how error processing works, increasing user control and
authored Jul 14, 2012
356 (flet ((websocket-process-frame
357 (websocket frame)
358 (lexical-let ((frame frame))
359 (lambda () (push frame processed-frames))))
6c42988 @ahyatt Check for HTTP 101 response code, and if there is any failure in the
authored Jun 3, 2012
360 (websocket-verify-response-code (output) t)
fb26aa7 @ahyatt Make the API more like W3C's API.
authored Jun 1, 2012
361 (websocket-verify-headers (websocket output) t))
b89e002 @ahyatt Test for websocket-outer-filter, plus removing some useless code from…
authored May 26, 2012
362 (websocket-outer-filter fake-ws "Sec-")
fb26aa7 @ahyatt Make the API more like W3C's API.
authored Jun 1, 2012
363 (should (eq (websocket-ready-state fake-ws) 'connecting))
078fbf3 @ahyatt Implemented onopen callback. Soon to be renamed.
authored May 30, 2012
364 (should-not open-callback-called)
b89e002 @ahyatt Test for websocket-outer-filter, plus removing some useless code from…
authored May 26, 2012
365 (websocket-outer-filter fake-ws "WebSocket-Accept: acceptstring")
078fbf3 @ahyatt Implemented onopen callback. Soon to be renamed.
authored May 30, 2012
366 (should-not open-callback-called)
b89e002 @ahyatt Test for websocket-outer-filter, plus removing some useless code from…
authored May 26, 2012
367 (websocket-outer-filter fake-ws (concat
368 "\r\n\r\n"
369 (substring websocket-frames 0 2)))
078fbf3 @ahyatt Implemented onopen callback. Soon to be renamed.
authored May 30, 2012
370 (should open-callback-called)
b89e002 @ahyatt Test for websocket-outer-filter, plus removing some useless code from…
authored May 26, 2012
371 (websocket-outer-filter fake-ws (substring websocket-frames 2))
a723952 @ahyatt Fix issue with inflight-input not being cleared out.
authored Aug 24, 2012
372 (should (equal (list frame2 frame1) processed-frames))
373 (should-not (websocket-inflight-input fake-ws)))
4040ae0 @jscheid Add test case for bugfix in 8513a7e.
jscheid authored Aug 5, 2012
374 (flet ((websocket-ready-state (websocket) 'connecting)
375 (websocket-close (websocket)))
8904556 @ahyatt Switch from using generic errors, to using named symbols.
authored Aug 6, 2012
376 (should (eq 500 (cdr (should-error
377 (websocket-outer-filter fake-ws "HTTP/1.1 500\r\n\r\n")
378 :type 'websocket-received-error-http-response)))))))
6c42988 @ahyatt Check for HTTP 101 response code, and if there is any failure in the
authored Jun 3, 2012
379
380 (ert-deftest websocket-outer-filter-bad-connection ()
381 (let* ((on-open-calledp)
382 (websocket-closed-calledp)
383 (fake-ws (websocket-inner-create
384 :conn t :url t :accept-string t
385 :on-open (lambda (websocket)
386 (setq on-open-calledp t)))))
387 (flet ((websocket-verify-response-code (output) t)
388 (websocket-verify-headers (websocket output) (error "Bad headers!"))
389 (websocket-close (websocket) (setq websocket-closed-calledp t)))
390 (condition-case err
391 (progn (websocket-outer-filter fake-ws "HTTP/1.1 101\r\n\r\n")
392 (error "Should have thrown an error!"))
393 (error
394 (should-not on-open-calledp)
395 (should websocket-closed-calledp))))))
a5f1895 @ahyatt Re-apply the error handling, removed by accident during the merge.
authored May 26, 2012
396
29d8f2f @ahyatt Encode all text sent from the websocket-send-text function.
authored Sep 2, 2012
397 (ert-deftest websocket-send-text ()
398 (flet ((websocket-send (ws frame)
399 (should (equal
400 (websocket-frame-payload frame)
401 "\344\275\240\345\245\275"))))
402 (websocket-send-text nil "你好")))
403
d2e4272 @ahyatt Check frame validity, and test it as part of websocket-send
authored May 26, 2012
404 (ert-deftest websocket-send ()
fb26aa7 @ahyatt Make the API more like W3C's API.
authored Jun 1, 2012
405 (let ((ws (websocket-inner-create :conn t :url t :accept-string t)))
d2e4272 @ahyatt Check frame validity, and test it as part of websocket-send
authored May 27, 2012
406 (flet ((websocket-ensure-connected (websocket))
407 (websocket-openp (websocket) t)
408 (process-send-string (conn string)))
409 ;; Just make sure there is no error.
410 (websocket-send ws (make-websocket-frame :opcode 'ping
411 :completep t)))
412 (should-error (websocket-send ws
8904556 @ahyatt Switch from using generic errors, to using named symbols.
authored Aug 6, 2012
413 (make-websocket-frame :opcode 'text)))
d2e4272 @ahyatt Check frame validity, and test it as part of websocket-send
authored May 27, 2012
414 (should-error (websocket-send ws
415 (make-websocket-frame :opcode 'close
416 :payload "bye!"
8904556 @ahyatt Switch from using generic errors, to using named symbols.
authored Aug 6, 2012
417 :completep t))
418 :type 'websocket-illegal-frame)
d2e4272 @ahyatt Check frame validity, and test it as part of websocket-send
authored May 27, 2012
419 (should-error (websocket-send ws
8904556 @ahyatt Switch from using generic errors, to using named symbols.
authored Aug 6, 2012
420 (make-websocket-frame :opcode :close))
421 :type 'websocket-illegal-frame)))
d2e4272 @ahyatt Check frame validity, and test it as part of websocket-send
authored May 27, 2012
422
a98e56f @ahyatt Beginning of server functionality. Completed header checking.
authored Aug 1, 2012
423 (ert-deftest websocket-verify-client-headers ()
424 (let* ((http "HTTP/1.1")
425 (host "Host: authority")
426 (upgrade "Upgrade: websocket")
23b132e @ahyatt Fix failing ert tests
authored Aug 15, 2012
427 (key (format "Sec-Websocket-Key: %s" "key"))
a98e56f @ahyatt Beginning of server functionality. Completed header checking.
authored Aug 2, 2012
428 (version "Sec-Websocket-Version: 13")
429 (origin "Origin: origin")
430 (protocol "Sec-Websocket-Protocol: protocol")
431 (extensions1 "Sec-Websocket-Extensions: foo")
432 (extensions2 "Sec-Websocket-Extensions: bar; baz=2")
433 (all-required-headers (list host upgrade key version)))
434 ;; Test that all these headers are necessary
435 (should (equal
436 '(:key "key" :protocols ("protocol") :extensions ("foo" "bar; baz=2"))
437 (websocket-verify-client-headers
438 (mapconcat 'identity (append (list http "" protocol extensions1 extensions2)
439 all-required-headers) "\r\n"))))
440 (should (websocket-verify-client-headers
441 (mapconcat 'identity
442 (mapcar 'upcase
443 (append (list http "" protocol extensions1 extensions2)
444 all-required-headers)) "\r\n")))
445 (dolist (header all-required-headers)
446 (should-not (websocket-verify-client-headers
447 (mapconcat 'identity (append (list http "")
448 (remove header all-required-headers))
449 "\r\n"))))
450 (should-not (websocket-verify-client-headers
451 (mapconcat 'identity (append (list "HTTP/1.0" "") all-required-headers)
452 "\r\n")))))
453
5a8b995 @ahyatt Add server header generation, and refactor protocol and extension han…
authored Aug 11, 2012
454 (ert-deftest websocket-intersect ()
455 (should (equal '(2) (websocket-intersect '(1 2) '(2 3))))
456 (should (equal nil (websocket-intersect '(1 2) '(3 4))))
457 (should (equal '(1 2) (websocket-intersect '(1 2) '(1 2)))))
458
459 (ert-deftest websocket-get-server-response ()
460 (let ((ws (websocket-inner-create :conn t :url t :accept-string "key"
461 :protocols '("spa" "spb")
462 :extensions '("sea" "seb"))))
463 (should (equal (concat
464 "HTTP/1.1 101 Switching Protocols\r\n"
465 "Upgrade: websocket\r\n"
466 "Connection: Upgrade\r\n"
467 "Sec-WebSocket-Accept: key\r\n\r\n")
468 (websocket-get-server-response ws nil nil)))
469 (should (string-match "Sec-Websocket-Protocol: spb\r\n"
470 (websocket-get-server-response ws '("spb" "spc") nil)))
471 (should-not (string-match "Sec-Websocket-Protocol:"
472 (websocket-get-server-response ws '("spc") nil)))
473 (let ((output (websocket-get-server-response ws '("spa" "spb") nil)))
474 (should (string-match "Sec-Websocket-Protocol: spa\r\n" output))
475 (should (string-match "Sec-Websocket-Protocol: spb\r\n" output)))
476 (should (string-match "Sec-Websocket-Extensions: sea"
477 (websocket-get-server-response ws nil '("sea" "sec"))))
478 (should-not (string-match "Sec-Websocket-Extensions:"
479 (websocket-get-server-response ws nil '("sec"))))
480 (let ((output (websocket-get-server-response ws nil '("sea" "seb"))))
481 (should (string-match "Sec-Websocket-Extensions: sea\r\n" output))
482 (should (string-match "Sec-Websocket-Extensions: seb\r\n" output)))))
483
0202adc @ahyatt Finish and test the server filter function.
authored Aug 12, 2012
484 (ert-deftest websocket-server-filter ()
485 (let ((on-open-called)
486 (ws (websocket-inner-create :conn t :url t :accept-string "key"
487 :on-open (lambda (ws) (setq on-open-called t))))
488 (closed)
489 (response)
490 (processed))
491 (flet ((process-send-string (p text) (setq response text))
492 (websocket-close (ws) (setq closed t))
493 (process-get (process sym) ws))
494 ;; Bad request, in two parts
23b132e @ahyatt Fix failing ert tests
authored Aug 15, 2012
495 (flet ((websocket-verify-client-headers (text) nil))
0202adc @ahyatt Finish and test the server filter function.
authored Aug 12, 2012
496 (websocket-server-filter nil "HTTP/1.0 GET /foo \r\n")
497 (should-not closed)
498 (websocket-server-filter nil "\r\n")
499 (should (equal response "HTTP/1.1 400 Bad Request\r\n\r\n"))
500 (should-not (websocket-inflight-input ws)))
501 ;; Good request, followed by packet
502 (setq closed nil
503 response nil)
504 (setf (websocket-inflight-input ws) nil)
23b132e @ahyatt Fix failing ert tests
authored Aug 15, 2012
505 (flet ((websocket-verify-client-headers (text) t)
0202adc @ahyatt Finish and test the server filter function.
authored Aug 12, 2012
506 (websocket-get-server-response (ws protocols extensions)
507 "response")
508 (websocket-process-input-on-open-ws (ws text)
509 (setq processed t)
510 (should
511 (equal text websocket-test-hello))))
512 (websocket-server-filter nil
513 (concat "\r\n\r\n" websocket-test-hello))
514 (should (equal (websocket-ready-state ws) 'open))
515 (should-not closed)
516 (should (equal response "response"))
517 (should processed)))))
74d5c10 @ahyatt Fix many issues with server connections.
authored Aug 12, 2012
518
519 (ert-deftest websocket-complete-server-response-test ()
520 ;; Example taken from RFC
521 (should (equal
522 (concat "HTTP/1.1 101 Switching Protocols\r\n"
523 "Upgrade: websocket\r\n"
524 "Connection: Upgrade\r\n"
525 "Sec-WebSocket-Accept: s3pPLMBiTxaQ9kYGzzhZRbK+xOo=\r\n"
526 "Sec-WebSocket-Protocol: chat\r\n\r\n"
527 )
528 (let ((header-info
529 (websocket-verify-client-headers
530 (concat "GET /chat HTTP/1.1\r\n"
531 "Host: server.example.com\r\n"
532 "Upgrade: websocket\r\n"
533 "Connection: Upgrade\r\n"
534 "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==\r\n"
535 "Origin: http://example.com\r\n"
536 "Sec-WebSocket-Protocol: chat, superchat\r\n"
537 "Sec-WebSocket-Version: 13\r\n"))))
538 (should header-info)
539 (let ((ws (websocket-inner-create
540 :conn t :url t
541 :accept-string (websocket-calculate-accept
542 (plist-get header-info :key))
543 :protocols '("chat"))))
544 (websocket-get-server-response
545 ws
546 (plist-get header-info :protocols)
547 (plist-get header-info :extension)))))))
5c2b235 @ahyatt Implement proper behavior on closing of server.
authored Aug 16, 2012
548
549 (ert-deftest websocket-server-close ()
550 (let ((websocket-server-websockets
551 (list (websocket-inner-create :conn 'conn-a :url t :accept-string t
552 :server-conn 'a
553 :ready-state 'open)
554 (websocket-inner-create :conn 'conn-b :url t :accept-string t
555 :server-conn 'b
556 :ready-state 'open)
557 (websocket-inner-create :conn 'conn-c :url t :accept-string t
558 :server-conn 'b
559 :ready-state 'closed)))
560 (deleted-processes)
561 (closed-websockets))
562 (flet ((delete-process (conn) (add-to-list 'deleted-processes conn))
563 (websocket-close (ws)
564 ;; we always remove on closing in the
565 ;; actual code.
566 (setq websocket-server-websockets
567 (remove ws websocket-server-websockets))
568 (should-not (eq (websocket-ready-state ws) 'closed))
569 (add-to-list 'closed-websockets ws)))
570 (websocket-server-close 'b))
571 (should (equal deleted-processes '(b)))
572 (should (eq 1 (length closed-websockets)))
573 (should (eq 'conn-b (websocket-conn (car closed-websockets))))
574 (should (eq 1 (length websocket-server-websockets)))
575 (should (eq 'conn-a (websocket-conn (car websocket-server-websockets))))))
Something went wrong with that request. Please try again.