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 Eric Schulte <schulte.eric@gmail.com>
   4
   5 ;; Author: Eric Schulte <schulte.eric@gmail.com>
   6 ;; License: GPLV3 (see the COPYING file in this directory)
   7
   8 ;;; Code:
   9 (require 'web-server)
  10 (require 'cl-lib)
  11 (eval-when-compile (require 'cl))
  12 (require 'ert)
  13
  14 (defvar ws-test-port 8999)
  15
  16 (defun ws-test-curl-to-string (url &optional get-params post-params curl-flags)
  17   "Curl URL with optional parameters."
  18   (async-shell-command
  19    (format "curl -m 4 %s %s %s localhost:%s/%s"
  20            (or curl-flags "")
  21            (if get-params
  22                (mapconcat (lambda (p) (format "-d '%s=%s'" (car p) (cdr p)))
  23                           get-params " ")
  24              "")
  25            (if post-params
  26                (mapconcat (lambda (p) (format "-s -F '%s=%s'" (car p) (cdr p)))
  27                           post-params " ")
  28              "")
  29            ws-test-port url))
  30   (unwind-protect
  31       (with-current-buffer "*Async Shell Command*"
  32         (while (get-buffer-process (current-buffer)) (sit-for 0.1))
  33         (goto-char (point-min))
  34         (buffer-string))
  35     (kill-buffer "*Async Shell Command*")))
  36
  37 (defmacro ws-test-with (handler &rest body)
  38   (declare (indent 1))
  39   (let ((srv (cl-gensym)))
  40     `(let* ((,srv (ws-start ,handler ws-test-port)))
  41        (unwind-protect (progn ,@body) (ws-stop ,srv)))))
  42 (def-edebug-spec ws-test-with (form body))
  43
  44 (ert-deftest ws/keyword-style-handler ()
  45   "Ensure that a simple keyword-style handler matches correctly."
  46   (ws-test-with (mapcar (lambda (letter)
  47                            `((:GET . ,letter) .
  48                              (lambda (request)
  49                                (ws-response-header (process request) 200
  50                                  '("Content-type" . "text/plain"))
  51                                (process-send-string (process request)
  52                                  (concat "returned:" ,letter)))))
  53                          '("a" "b"))
  54     (should (string= "returned:a" (ws-test-curl-to-string "a")))
  55     (should (string= "returned:b" (ws-test-curl-to-string "b")))))
  56
  57 (ert-deftest ws/function-style-handler ()
  58   "Test that a simple hello-world server responds."
  59   (ws-test-with
  60       '(((lambda (_) t) .
  61          (lambda (request)
  62            (ws-response-header (process request) 200
  63              '("Content-type" . "text/plain"))
  64            (process-send-string (process request) "hello world"))))
  65     (should (string= (ws-test-curl-to-string "") "hello world"))))
  66
  67 (ert-deftest ws/removed-from-ws-servers-after-stop ()
  68   (let ((start-length (length ws-servers)))
  69     (let ((server (ws-start nil ws-test-port)))
  70       (should (= (length ws-servers) (+ 1 start-length)))
  71       (ws-stop server)
  72       (should (= (length ws-servers) start-length)))))
  73
  74 (ert-deftest ws/parse-many-headers ()
  75   "Test that a number of headers parse successfully."
  76   (let ((server (ws-start nil ws-test-port))
  77         (request (make-instance 'ws-request)))
  78     (unwind-protect
  79         (progn
  80           (setf (pending request)
  81                 "GET / HTTP/1.1
  82 Host: localhost:7777
  83 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:26.0) Gecko/20100101 Firefox/26.0
  84 Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
  85 Accept-Language: en-US,en;q=0.5
  86 Accept-Encoding: gzip, deflate
  87 DNT: 1
  88 Cookie: __utma=111872281.1462392269.1345929539.1345929539.1345929539.1
  89 Connection: keep-alive
  90
  91 ")
  92           (ws-parse-request request)
  93           (let ((headers (cdr (headers request))))
  94             (should (string= (cdr (assoc :ACCEPT-ENCODING headers))
  95                              "gzip, deflate"))
  96             (should (string= (cdr (assoc :GET headers)) "/"))
  97             (should (string= (cdr (assoc :CONNECTION headers)) "keep-alive"))))
  98       (ws-stop server))))
  99
 100 (ert-deftest ws/parse-post-data ()
 101   (let ((server (ws-start nil ws-test-port))
 102         (request (make-instance 'ws-request)))
 103     (unwind-protect
 104         (progn
 105           (setf (pending request)
 106                 "POST / HTTP/1.1
 107 User-Agent: curl/7.33.0
 108 Host: localhost:8080
 109 Accept: */*
 110 Content-Length: 273
 111 Expect: 100-continue
 112 Content-Type: multipart/form-data; boundary=----------------f1270d0deb77af03
 113
 114 ------------------f1270d0deb77af03
 115 Content-Disposition: form-data; name=\"date\"
 116
 117 Wed Dec 18 00:55:39 MST 2013
 118
 119 ------------------f1270d0deb77af03
 120 Content-Disposition: form-data; name=\"name\"
 121
 122 \"schulte\"
 123 ------------------f1270d0deb77af03--
 124 ")
 125           (ws-parse-request request)
 126           (let ((headers (cdr (headers request))))
 127             (should (string= (cdr (assoc 'content (cdr (assoc "name" headers))))
 128                              "\"schulte\""))
 129             (should (string= (cdr (assoc 'content (cdr (assoc "date" headers))))
 130                              "Wed Dec 18 00:55:39 MST 2013\n"))))
 131       (ws-stop server))))
 132
 133 (ert-deftest ws/parse-another-post-data ()
 134   "This one from an AJAX request."
 135   (let ((server (ws-start nil ws-test-port))
 136         (request (make-instance 'ws-request)))
 137     (unwind-protect
 138         (progn
 139           (setf (pending request)
 140                 "POST /complex.org HTTP/1.1
 141 Host: localhost:4444
 142 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:26.0) Gecko/20100101 Firefox/26.0
 143 Accept: */*
 144 Accept-Language: en-US,en;q=0.5
 145 Accept-Encoding: gzip, deflate
 146 DNT: 1
 147 Content-Type: application/x-www-form-urlencoded; charset=UTF-8
 148 X-Requested-With: XMLHttpRequest
 149 Referer: http://localhost:4444/complex.org
 150 Content-Length: 78
 151 Cookie: __utma=111872281.1462392269.1345929539.1345929539.1345929539.1
 152 Connection: keep-alive
 153 Pragma: no-cache
 154 Cache-Control: no-cache
 155
 156 org=-+one%0A-+two%0A-+three%0A-+four%0A%0A&beg=646&end=667&path=%2Fcomplex.org")
 157           (ws-parse-request request)
 158           (let ((headers (cdr (headers request))))
 159             (should (string= (cdr (assoc "path" headers)) "/complex.org"))
 160             (should (string= (cdr (assoc "beg" headers)) "646"))
 161             (should (string= (cdr (assoc "end" headers)) "667"))
 162             (should (string= (cdr (assoc "org" headers))
 163                              "- one
 164 - two
 165 - three
 166 - four
 167
 168 "))))
 169       (ws-stop server))))
 170
 171 (ert-deftest ws/simple-post ()
 172   "Test a simple POST server."
 173   (ws-test-with
 174       '(((:POST . ".*") .
 175          (lambda (request)
 176            (with-slots (process headers) request
 177              (let ((message (cdr (assoc "message" headers))))
 178                (ws-response-header process 200
 179                  '("Content-type" . "text/plain"))
 180                (process-send-string process
 181                  (format "you said %S\n" (cdr (assoc 'content message)))))))))
 182     (should (string= (ws-test-curl-to-string "" nil '(("message" . "foo")))
 183                      "you said \"foo\"\n"))))
 184
 185 (ert-deftest ws/in-directory-p ()
 186   (should-not (ws-in-directory-p "/tmp/" "foo/bar/../../../"))
 187   (should     (ws-in-directory-p "/tmp/" "foo/bar/../../../tmp/baz"))
 188   (should     (ws-in-directory-p "/tmp/" "./"))
 189   (should-not (ws-in-directory-p "/tmp/" "/~/pics"))
 190   (should-not (ws-in-directory-p "/tmp/" "~/pics"))
 191   (should-not (ws-in-directory-p "/tmp/" "/pics"))
 192   (should-not (ws-in-directory-p "/tmp/" "../pics"))
 193   (should     (ws-in-directory-p "/tmp/" "pics"))
 194   (should-not (ws-in-directory-p "/tmp/" "..")))
 195
 196 (ert-deftest ws/parse-basic-authorization ()
 197   "Test that a number of headers parse successfully."
 198   (let* ((server (ws-start nil ws-test-port))
 199          (request (make-instance 'ws-request))
 200          (username "foo") (password "bar"))
 201     (unwind-protect
 202         (progn
 203           (setf (pending request)
 204                 (format "GET / HTTP/1.1
 205 Authorization: Basic %s
 206 Connection: keep-alive
 207
 208 " (base64-encode-string (concat username ":" password))))
 209           (ws-parse-request request)
 210           (with-slots (headers) request
 211             (cl-tree-equal (cdr (assoc :AUTHORIZATION headers))
 212                            (cons :BASIC (cons username password)))))
 213       (ws-stop server))))
 214
 215 (ert-deftest ws/parse-large-file-upload ()
 216   "Test that `ws-parse-request' can handle at large file upload.
 217 At least when it comes in a single chunk."
 218   (let* ((long-string (mapconcat #'int-to-string (number-sequence 0 20000) " "))
 219          (server (ws-start nil ws-test-port))
 220          (request (make-instance 'ws-request)))
 221     (unwind-protect
 222         (progn
 223           (setf (pending request)
 224                 (format "POST / HTTP/1.1
 225 User-Agent: curl/7.34.0
 226 Host: localhost:9008
 227 Accept: */*
 228 Content-Length: 9086
 229 Expect: 100-continue
 230 Content-Type: multipart/form-data; boundary=----------------e458fb665704290b
 231
 232 ------------------e458fb665704290b
 233 Content-Disposition: form-data; name=\"file\"; filename=\"-\"
 234 Content-Type: application/octet-stream
 235
 236 %s
 237 ------------------e458fb665704290b--
 238
 239 " long-string))
 240           (ws-parse-request request)
 241           (should
 242            (string= long-string
 243                     (cdr (assoc 'content
 244                                 (cdr (assoc "file" (headers request))))))))
 245       (ws-stop server))))
 246
 247 (ert-deftest ws/web-socket-handshake-rfc-example ()
 248   "Ensure that `ws-web-socket-handshake' conforms to the example in RFC6455."
 249   (should (string= (ws-web-socket-handshake "dGhlIHNhbXBsZSBub25jZQ==")
 250                    "s3pPLMBiTxaQ9kYGzzhZRbK+xOo=")))
 251
 252 (ert-deftest ws/web-socket-frame ()
 253   "Test WebSocket frame encoding for the different varint payload lengths:
 254    0-125, 126-64k, 64k-2^64."
 255   (should (string= (ws-web-socket-frame "short") "\201\ 5short"))
 256   (should (string= (substring (ws-web-socket-frame (make-string 126 ?a))
 257                               0 5) "\201~