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

   1 ;;; web-server-test.el --- Test the Emacs Web Server
   2
   3 ;; Copyright (C) 2013-2014  Free Software Foundation, Inc.
   4
   5 ;; Author: Eric Schulte <schulte.eric@gmail.com>
   6
   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.
  11
  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.
  16
  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/>.
  19
  20 ;;; Code:
  21 (require 'web-server)
  22 (require 'cl-lib)
  23 (eval-when-compile (require 'cl))
  24 (require 'ert)
  25
  26 (defvar ws-test-port 8999)
  27
  28 (defun ws-test-curl-to-string (url &optional get-params post-params curl-flags)
  29   "Curl URL with optional parameters."
  30   (async-shell-command
  31    (format "curl -s -m 4 %s %s %s localhost:%s/%s"
  32            (or curl-flags "")
  33            (if get-params
  34                (mapconcat (lambda (p) (format "-d \"%s=%s\"" (car p) (cdr p)))
  35                           get-params " ")
  36              "")
  37            (if post-params
  38                (mapconcat (lambda (p) (format "-F \"%s=%s\"" (car p) (cdr p)))
  39                           post-params " ")
  40              "")
  41            ws-test-port url))
  42   (unwind-protect
  43       (with-current-buffer "*Async Shell Command*"
  44         (while (get-buffer-process (current-buffer)) (sit-for 0.1))
  45         (goto-char (point-min))
  46         (buffer-string))
  47     (kill-buffer "*Async Shell Command*")))
  48
  49 (defmacro ws-test-with (handler &rest body)
  50   (declare (indent 1))
  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))
  55
  56 (ert-deftest ws/keyword-style-handler ()
  57   "Ensure that a simple keyword-style handler matches correctly."
  58   (ws-test-with (mapcar (lambda (letter)
  59                            `((:GET . ,letter) .
  60                              (lambda (request)
  61                                (ws-response-header (process request) 200
  62                                  '("Content-type" . "text/plain"))
  63                                (process-send-string (process request)
  64                                  (concat "returned:" ,letter)))))
  65                          '("a" "b"))
  66     (should (string= "returned:a" (ws-test-curl-to-string "a")))
  67     (should (string= "returned:b" (ws-test-curl-to-string "b")))))
  68
  69 (ert-deftest ws/function-style-handler ()
  70   "Test that a simple hello-world server responds."
  71   (ws-test-with
  72       '(((lambda (_) t) .
  73          (lambda (request)
  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"))))
  78
  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)))
  83       (ws-stop server)
  84       (should (= (length ws-servers) start-length)))))
  85
  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)))
  90     (unwind-protect
  91         (progn
  92           (setf (pending request)
  93                 "GET / HTTP/1.1
  94 Host: localhost:7777
  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
  99 DNT: 1
 100 Cookie: __utma=111872281.1462392269.1345929539.1345929539.1345929539.1
 101 Connection: keep-alive
 102
 103 ")
 104           (ws-parse-request request)
 105           (let ((headers (cdr (headers request))))
 106             (should (string= (cdr (assoc :ACCEPT-ENCODING headers))
 107                              "gzip, deflate"))
 108             (should (string= (cdr (assoc :GET headers)) "/"))
 109             (should (string= (cdr (assoc :CONNECTION headers)) "keep-alive"))))
 110       (ws-stop server))))
 111
 112 (ert-deftest ws/parse-post-data ()
 113   (let ((server (ws-start nil ws-test-port))
 114         (request (make-instance 'ws-request)))
 115     (unwind-protect
 116         (progn
 117           (setf (pending request)
 118                 "POST / HTTP/1.1
 119 User-Agent: curl/7.33.0
 120 Host: localhost:8080
 121 Accept: */*
 122 Content-Length: 273
 123 Expect: 100-continue
 124 Content-Type: multipart/form-data; boundary=----------------f1270d0deb77af03
 125
 126 ------------------f1270d0deb77af03
 127 Content-Disposition: form-data; name=\"date\"
 128
 129 Wed Dec 18 00:55:39 MST 2013
 130
 131 ------------------f1270d0deb77af03
 132 Content-Disposition: form-data; name=\"name\"
 133
 134 \"schulte\"
 135 ------------------f1270d0deb77af03--
 136 ")
 137           (ws-parse-request request)
 138           (let ((headers (cdr (headers request))))
 139             (should (string= (cdr (assoc 'content (cdr (assoc "name" headers))))
 140                              "\"schulte\""))
 141             (should (string= (cdr (assoc 'content (cdr (assoc "date" headers))))
 142                              "Wed Dec 18 00:55:39 MST 2013\n"))))
 143       (ws-stop server))))
 144
 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)))
 149     (unwind-protect
 150         (progn
 151           (setf (pending request)
 152                 "POST /complex.org HTTP/1.1
 153 Host: localhost:4444
 154 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:26.0) Gecko/20100101 Firefox/26.0
 155 Accept: */*
 156 Accept-Language: en-US,en;q=0.5
 157 Accept-Encoding: gzip, deflate
 158 DNT: 1
 159 Content-Type: application/x-www-form-urlencoded; charset=UTF-8
 160 X-Requested-With: XMLHttpRequest
 161 Referer: http://localhost:4444/complex.org
 162 Content-Length: 78
 163 Cookie: __utma=111872281.1462392269.1345929539.1345929539.1345929539.1
 164 Connection: keep-alive
 165 Pragma: no-cache
 166 Cache-Control: no-cache
 167
 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))
 175                              "- one
 176 - two
 177 - three
 178 - four
 179
 180 "))))
 181       (ws-stop server))))
 182
 183 (ert-deftest ws/simple-post ()
 184   "Test a simple POST server."
 185   (ws-test-with
 186       '(((:POST . ".*") .
 187          (lambda (request)
 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"))))
 196
 197 (ert-deftest ws/in-directory-p ()
 198   (mapc (lambda (pair)
 199           (let ((should-or-not (car pair))
 200                 (dir (cdr pair)))
 201             (message "dir: %S" dir)
 202             (should
 203              (funcall (if should-or-not #'identity #'not)
 204                       (ws-in-directory-p temporary-file-directory dir)))))
 205         `((nil . "foo/bar/../../../")
 206           (t   . ,(concat
 207                    "foo/bar/../../../"
 208                    (file-name-nondirectory
 209                     (directory-file-name temporary-file-directory))
 210                    "/baz"))
 211           (t   . "./")
 212           (nil . "/~/pics")
 213           (nil . "~/pics")
 214           (nil . "/pics")
 215           (nil . "../pics")
 216           (t   . "pics")
 217           (nil . ".."))))
 218
 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"))
 224     (unwind-protect
 225         (progn
 226           (setf (pending request)
 227                 (format "GET / HTTP/1.1
 228 Authorization: Basic %s
 229 Connection: keep-alive
 230
 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)))))
 236       (ws-stop server))))
 237
 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)))
 244     (unwind-protect
 245         (progn
 246           (setf (pending request)
 247                 (format "POST / HTTP/1.1
 248 User-Agent: curl/7.34.0
 249 Host: localhost:9008
 250 Accept: */*
 251 Content-Length: 9086
 252 Expect: 100-continue
 253 Content-Type: multipart/form-data; boundary=----------------e458fb665704290b
 254
 255 ------------------e458fb665704290b
 256 Content-Disposition: form-data; name=\"file\"; filename=\"-\"
 257 Content-Type: application/octet-stream
 258
 259 %s
 260 ------------------e458fb665704290b--
 261
 262 " long-string))
 263           (ws-parse-request request)
 264           (should
 265            (string= long-string
 266                     (cdr (assoc 'content
 267                                 (cdr (assoc "file" (headers request))))))))
 268       (ws-stop server))))
 269
 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=")))
 274
 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))
 280                               0 5) "\201~