1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
;;; simple-httpd-test.el --- simple-httpd unit tests
;;; Commentary:
;; Run standalone with this,
;; emacs -batch -L . -l simple-httpd-test.el -f ert-run-tests-batch
;;; Code:
(require 'ert)
(require 'cl-lib)
(require 'simple-httpd)
(defmacro httpd--flet (funcs &rest body)
"Like `cl-flet' but with dynamic function scope."
(declare (indent 1))
(let* ((names (mapcar #'car funcs))
(lambdas (mapcar #'cdr funcs))
(gensyms (cl-loop for name in names
collect (make-symbol (symbol-name name)))))
`(let ,(cl-loop for name in names
for gensym in gensyms
collect `(,gensym (symbol-function ',name)))
(unwind-protect
(progn
,@(cl-loop for name in names
for lambda in lambdas
for body = `(lambda ,@lambda)
collect `(setf (symbol-function ',name) ,body))
,@body)
,@(cl-loop for name in names
for gensym in gensyms
collect `(setf (symbol-function ',name) ,gensym))))))
(ert-deftest httpd-clean-path-test ()
"Ensure that paths are sanitized properly."
(should (equal (httpd-clean-path "/") "./"))
(should (equal (httpd-clean-path "../") "./"))
(should (equal (httpd-clean-path "/../../foo/../..") "./foo"))
(should (equal (httpd-clean-path "/tmp/../root/foo") "./tmp/root/foo"))
(should (equal (httpd-clean-path "~") "./~"))
(should (equal (httpd-clean-path "/~/.gnupg") "./~/.gnupg")))
(ert-deftest httpd-mime-test ()
"Test MIME type fetching."
(should (equal (httpd-get-mime "unknown") "application/octet-stream"))
(should (equal (httpd-get-mime nil) "application/octet-stream")))
(ert-deftest httpd-parse-test ()
"Test HTTP header parsing."
(with-temp-buffer
(set-buffer-multibyte nil)
(insert "GET /f%20b HTTP/1.1\r\n"
"Host: localhost:8080\r\n"
"DNT: 1, 2\r\n\r\n")
(let ((p (httpd-parse)))
(should (equal (cl-cadar p) "/f%20b"))
(should (equal (cadr (assoc "Host" p)) "localhost:8080"))
(should (equal (cadr (assoc "Dnt" p)) "1, 2")))))
(ert-deftest httpd-parse-uri-test ()
"Test URI parsing."
(let* ((url "/foo/bar%20baz.html?q=test%26case&v=10#page10")
(p (httpd-parse-uri url))
(args (cadr p))
(fragment (cl-caddr p)))
(should (equal (car p) "/foo/bar%20baz.html"))
(should (equal (cadr (assoc "v" args)) "10"))
(should (equal (cadr (assoc "q" args)) "test&case"))
(should (equal fragment "page10"))))
(ert-deftest httpd-send-header-test ()
"Test server header output."
(with-temp-buffer
(set-buffer-multibyte nil)
(let ((buffer (current-buffer)))
(httpd--flet ((process-send-region (_proc _start _end)
(let ((send-buffer (current-buffer)))
(with-current-buffer buffer
(insert-buffer-substring send-buffer)))))
(httpd-send-header nil "text/html" 404 :Foo "bar")))
(let ((out (httpd-parse)))
(should (equal (cl-cadar out) "404"))
(should (equal (cadr (assoc "Content-Type" out)) "text/html"))
(should (equal (cadr (assoc "Foo" out)) "bar")))))
(ert-deftest httpd-get-servlet-test ()
"Test servlet dispatch."
(httpd--flet ((httpd/foo/bar () t))
(let ((httpd-servlets t))
(should (eq (httpd-get-servlet "/foo/bar") 'httpd/foo/bar))
(should (eq (httpd-get-servlet "/foo/bar/baz") 'httpd/foo/bar))
(should (eq (httpd-get-servlet "/undefined") 'httpd/)))))
(ert-deftest httpd-unhex-test ()
"Test URL decoding."
(should (equal (httpd-unhex "I+%2Bam%2B+foo.") "I +am+ foo."))
(should (equal (httpd-unhex "foo%0D%0Abar") "foo\nbar"))
(should (equal (httpd-unhex "na%C3%AFve") "naïve"))
(should (eq (httpd-unhex nil) nil)))
(ert-deftest httpd-parse-args-test ()
"Test argument parsing."
(should (equal (httpd-parse-args "na=foo&v=1") '(("na" "foo") ("v" "1"))))
(should (equal (httpd-parse-args "") ())))
(ert-deftest httpd-parse-endpoint ()
"Test endpoint parsing for defservlet*."
(should (equal (httpd-parse-endpoint 'example/foos/:n/:d)
'(example/foos ((n . 2) (d . 3))))))
(ert-deftest httpd-escape-html-test ()
"Test URL decoding."
(let ((tests '(("hello world" .
"hello world")
("a <b>bold</b> request" .
"a <b>bold</b> request")
("alpha & beta" .
"alpha & beta")
("&&&" .
"&&&"))))
(cl-loop for (in . out) in tests
do (should (equal (httpd-escape-html in) out)))))
;;; simple-httpd-test.el ends here
|
