1 ;;; web-server-test.el --- Test the Emacs Web Server
3 ;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
5 ;; Author: Eric Schulte <schulte.eric@gmail.com>
7 ;; This software is free software: you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation, either version 3 of the License, or
10 ;; (at your option) any later version.
12 ;; This software is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 (eval-when-compile (require 'cl))
26 (defvar ws-test-port 8999)
28 (defun ws-test-curl-to-string (url &optional get-params post-params curl-flags)
29 "Curl URL with optional parameters."
31 (format "curl -s -m 4 %s %s %s localhost:%s/%s"
34 (mapconcat (lambda (p) (format "-d \"%s=%s\"" (car p) (cdr p)))
38 (mapconcat (lambda (p) (format "-F \"%s=%s\"" (car p) (cdr p)))
43 (with-current-buffer "*Async Shell Command*"
44 (while (get-buffer-process (current-buffer)) (sit-for 0.1))
45 (goto-char (point-min))
47 (kill-buffer "*Async Shell Command*")))
49 (defmacro ws-test-with (handler &rest body)
51 (let ((srv (cl-gensym)))
52 `(let* ((,srv (ws-start ,handler ws-test-port)))
53 (unwind-protect (progn ,@body) (ws-stop ,srv)))))
54 (def-edebug-spec ws-test-with (form body))
56 (ert-deftest ws/keyword-style-handler ()
57 "Ensure that a simple keyword-style handler matches correctly."
58 (ws-test-with (mapcar (lambda (letter)
61 (ws-response-header (process request) 200
62 '("Content-type" . "text/plain"))
63 (process-send-string (process request)
64 (concat "returned:" ,letter)))))
66 (should (string= "returned:a" (ws-test-curl-to-string "a")))
67 (should (string= "returned:b" (ws-test-curl-to-string "b")))))
69 (ert-deftest ws/function-style-handler ()
70 "Test that a simple hello-world server responds."
74 (ws-response-header (process request) 200
75 '("Content-type" . "text/plain"))
76 (process-send-string (process request) "hello world"))))
77 (should (string= (ws-test-curl-to-string "") "hello world"))))
79 (ert-deftest ws/removed-from-ws-servers-after-stop ()
80 (let ((start-length (length ws-servers)))
81 (let ((server (ws-start nil ws-test-port)))
82 (should (= (length ws-servers) (+ 1 start-length)))
84 (should (= (length ws-servers) start-length)))))
86 (ert-deftest ws/parse-many-headers ()
87 "Test that a number of headers parse successfully."
88 (let ((server (ws-start nil ws-test-port))
89 (request (make-instance 'ws-request)))
92 (setf (pending request)
95 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:26.0) Gecko/20100101 Firefox/26.0
96 Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
97 Accept-Language: en-US,en;q=0.5
98 Accept-Encoding: gzip, deflate
100 Cookie: __utma=111872281.1462392269.1345929539.1345929539.1345929539.1
101 Connection: keep-alive
104 (ws-parse-request request)
105 (let ((headers (cdr (headers request))))
106 (should (string= (cdr (assoc :ACCEPT-ENCODING headers))
108 (should (string= (cdr (assoc :GET headers)) "/"))
109 (should (string= (cdr (assoc :CONNECTION headers)) "keep-alive"))))
112 (ert-deftest ws/parse-post-data ()
113 (let ((server (ws-start nil ws-test-port))
114 (request (make-instance 'ws-request)))
117 (setf (pending request)
119 User-Agent: curl/7.33.0
124 Content-Type: multipart/form-data; boundary=----------------f1270d0deb77af03
126 ------------------f1270d0deb77af03
127 Content-Disposition: form-data; name=\"date\"
129 Wed Dec 18 00:55:39 MST 2013
131 ------------------f1270d0deb77af03
132 Content-Disposition: form-data; name=\"name\"
135 ------------------f1270d0deb77af03--
137 (ws-parse-request request)
138 (let ((headers (cdr (headers request))))
139 (should (string= (cdr (assoc 'content (cdr (assoc "name" headers))))
141 (should (string= (cdr (assoc 'content (cdr (assoc "date" headers))))
142 "Wed Dec 18 00:55:39 MST 2013\n"))))
145 (ert-deftest ws/parse-another-post-data ()
146 "This one from an AJAX request."
147 (let ((server (ws-start nil ws-test-port))
148 (request (make-instance 'ws-request)))
151 (setf (pending request)
152 "POST /complex.org HTTP/1.1
154 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:26.0) Gecko/20100101 Firefox/26.0
156 Accept-Language: en-US,en;q=0.5
157 Accept-Encoding: gzip, deflate
159 Content-Type: application/x-www-form-urlencoded; charset=UTF-8
160 X-Requested-With: XMLHttpRequest
161 Referer: http://localhost:4444/complex.org
163 Cookie: __utma=111872281.1462392269.1345929539.1345929539.1345929539.1
164 Connection: keep-alive
166 Cache-Control: no-cache
168 org=-+one%0A-+two%0A-+three%0A-+four%0A%0A&beg=646&end=667&path=%2Fcomplex.org")
169 (ws-parse-request request)
170 (let ((headers (cdr (headers request))))
171 (should (string= (cdr (assoc "path" headers)) "/complex.org"))
172 (should (string= (cdr (assoc "beg" headers)) "646"))
173 (should (string= (cdr (assoc "end" headers)) "667"))
174 (should (string= (cdr (assoc "org" headers))
183 (ert-deftest ws/simple-post ()
184 "Test a simple POST server."
188 (with-slots (process headers) request
189 (let ((message (cdr (assoc "message" headers))))
190 (ws-response-header process 200
191 '("Content-type" . "text/plain"))
192 (process-send-string process
193 (format "you said %S\n" (cdr (assoc 'content message)))))))))
194 (should (string= (ws-test-curl-to-string "" nil '(("message" . "foo")))
195 "you said \"foo\"\n"))))
197 (ert-deftest ws/in-directory-p ()
199 (let ((should-or-not (car pair))
201 (message "dir: %S" dir)
203 (funcall (if should-or-not #'identity #'not)
204 (ws-in-directory-p temporary-file-directory dir)))))
205 `((nil . "foo/bar/../../../")
208 (file-name-nondirectory
209 (directory-file-name temporary-file-directory))
219 (ert-deftest ws/parse-basic-authorization ()
220 "Test that a number of headers parse successfully."
221 (let* ((server (ws-start nil ws-test-port))
222 (request (make-instance 'ws-request))
223 (username "foo") (password "bar"))
226 (setf (pending request)
227 (format "GET / HTTP/1.1
228 Authorization: Basic %s
229 Connection: keep-alive
231 " (base64-encode-string (concat username ":" password))))
232 (ws-parse-request request)
233 (with-slots (headers) request
234 (cl-tree-equal (cdr (assoc :AUTHORIZATION headers))
235 (cons :BASIC (cons username password)))))
238 (ert-deftest ws/parse-large-file-upload ()
239 "Test that `ws-parse-request' can handle at large file upload.
240 At least when it comes in a single chunk."
241 (let* ((long-string (mapconcat #'int-to-string (number-sequence 0 20000) " "))
242 (server (ws-start nil ws-test-port))
243 (request (make-instance 'ws-request)))
246 (setf (pending request)
247 (format "POST / HTTP/1.1
248 User-Agent: curl/7.34.0
253 Content-Type: multipart/form-data; boundary=----------------e458fb665704290b
255 ------------------e458fb665704290b
256 Content-Disposition: form-data; name=\"file\"; filename=\"-\"
257 Content-Type: application/octet-stream
260 ------------------e458fb665704290b--
263 (ws-parse-request request)
267 (cdr (assoc "file" (headers request))))))))
270 (ert-deftest ws/web-socket-handshake-rfc-example ()
271 "Ensure that `ws-web-socket-handshake' conforms to the example in RFC6455."
272 (should (string= (ws-web-socket-handshake "dGhlIHNhbXBsZSBub25jZQ==")
273 "s3pPLMBiTxaQ9kYGzzhZRbK+xOo=")))
275 (ert-deftest ws/web-socket-frame ()
276 "Test WebSocket frame encoding for the different varint payload lengths:
277 0-125, 126-64k, 64k-2^64."
278 (should (string= (ws-web-socket-frame "short") "\201
\ 5short"))
279 (should (string= (substring (ws-web-socket-frame (make-string 126 ?a))