1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: wol-tests -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Id: $Id: tests.lisp,v 1.2 2003/08/10 05:16:52 kevin Exp $
6 ;;;; Purpose: Self Test suite for WOL
8 ;;;; *************************************************************************
10 (in-package #:cl-user)
12 (defpackage #:wol-tests
13 (:use #:xlunit #:cl #:wol #:puri #:lml2 #:kmrcl)
14 (:export #:do-tests #:*all-tests*))
16 (in-package #:wol-tests)
18 (eval-when (:compile-toplevel :load-toplevel :execute)
19 (import '(wol::req-recode-uri-sans-session-id wol::request-uri
20 wol::request-decoded-uri-path wol::websession-from-req
21 wol::websession-key wol::+length-session-id+
22 wol::set-cookies-in-headers)))
27 (defclass test-keyed-url (test-case)
28 ((req :accessor req)))
30 (defmethod set-up ((self test-keyed-url))
31 (let ((uri (parse-uri "/~abcdefg~/index.html")))
32 (setf (req self) (make-instance 'wol::http-request
34 :decoded-uri-path (render-uri uri nil)
37 (def-test-method test-returned-session ((self test-keyed-url) :run nil)
38 (assert-equal "abcdefg" (req-recode-uri-sans-session-id (req self))))
40 (def-test-method test-recomputed-uri ((self test-keyed-url) :run nil)
41 (req-recode-uri-sans-session-id (req self))
42 (assert-equal (render-uri (request-uri (req self)) nil)
45 (def-test-method test-decoded-uri ((self test-keyed-url) :run nil)
46 (req-recode-uri-sans-session-id (req self))
47 (assert-equal (request-decoded-uri-path (req self))
50 ;;; Non-keyed URL tests
52 (defclass test-non-keyed-url (test-case)
53 ((req :accessor req)))
55 (defmethod set-up ((self test-non-keyed-url))
56 (let ((uri (parse-uri "/index.html")))
57 (setf (req self) (make-instance 'wol::http-request
59 :decoded-uri-path (render-uri uri nil)
62 (def-test-method test-returned-session ((self test-non-keyed-url) :run nil)
63 (assert-false (req-recode-uri-sans-session-id (req self))))
65 (def-test-method test-recomputed-uri ((self test-non-keyed-url) :run nil)
66 (req-recode-uri-sans-session-id (req self))
67 (assert-equal (render-uri (request-uri (req self)) nil)
70 (def-test-method test-decoded-uri ((self test-non-keyed-url) :run nil)
71 (req-recode-uri-sans-session-id (req self))
72 (assert-equal (request-decoded-uri-path (req self))
77 (defclass test-server (test-case)
78 ((wserver :accessor wserver)
79 (name :accessor name :initform "testproj")
80 (port :accessor port :initform 31322)
83 (defmethod set-up ((self test-server))
84 (setf (wserver self) (net.aserve:start :port (port self) :server :new))
85 (setq net.aserve::*enable-logging* nil)
86 (wol-project (name self) :index "index" :connector :aserve
87 :server (wserver self)))
90 (defmethod tear-down ((self test-server))
91 (net.aserve:shutdown :server (wserver self))
92 (stop-wol-project (name self)))
94 (def-test-method test-server-index ((self test-server) :run nil)
95 (multiple-value-bind (body response-code headers uri)
96 (net.aserve.client:do-http-request
97 (render-uri (copy-uri (parse-uri "http://localhost/")
98 :port (port self)) nil)
100 (declare (ignore uri))
101 (assert-true (zerop (length body)))
102 (let ((redir (parse-uri
103 (cdr (assoc "Location" headers :test #'string-equal)))))
104 (assert-equal (uri-path redir) "/index.html"))
105 (assert-equal response-code 307)
108 (def-test-method test-prefix-index-1 ((self test-server) :run nil)
109 (wol-project (name self) :index "index" :connector :aserve
110 :project-prefix "/aprefix/" :server (wserver self))
112 (multiple-value-bind (body response-code headers uri)
113 (net.aserve.client:do-http-request
114 (render-uri (copy-uri (parse-uri "http://localhost/aprefix/")
115 :port (port self)) nil)
117 (declare (ignore uri))
118 (assert-equal "" body)
119 (let ((redir (parse-uri
120 (cdr (assoc "Location" headers :test #'string-equal)))))
121 (assert-equal (uri-path redir) "/aprefix/index.html"))
122 (assert-equal response-code 307)))
125 (def-test-method test-prefix-index-2 ((self test-server) :run nil)
126 (wol-project (name self) :index "index" :connector :aserve
127 :project-prefix "/aprefix/" :server (wserver self))
129 (multiple-value-bind (body response-code headers uri)
130 (net.aserve.client:do-http-request
131 (render-uri (copy-uri (parse-uri "http://localhost/ab")
132 :port (port self)) nil)
134 (declare (ignore uri headers))
135 (assert-equal response-code 404)
136 (assert-true (plusp (length body))))
138 (multiple-value-bind (body response-code headers uri)
139 (net.aserve.client:do-http-request
140 (render-uri (copy-uri (parse-uri "http://localhost/")
141 :port (port self)) nil)
143 (declare (ignore uri headers))
144 (assert-true (plusp (length body)))
145 (assert-equal response-code 404))
150 ;;; Test two projects
152 (defclass test-two-projects (test-case)
153 ((wserver :accessor wserver)
154 (name1 :accessor name1 :initform "testproj")
155 (prefix1 :accessor prefix1 :initform "/testprefix/")
156 (name2 :accessor name2 :initform "projtest")
157 (prefix12 :accessor prefix2 :initform "/prefixtest/")
158 (port :accessor port :initform 31323)
161 (defmethod set-up ((self test-two-projects))
162 (setf (wserver self) (net.aserve:start :port (port self) :server :new))
163 (setq net.aserve::*enable-logging* nil)
164 (wol-project (name1 self) :index "index1" :connector :aserve
165 :project-prefix (prefix1 self)
166 :server (wserver self))
167 (wol-project (name2 self) :index "index2" :connector :aserve
168 :project-prefix (prefix2 self)
169 :server (wserver self))
173 (defmethod tear-down ((self test-two-projects))
174 (net.aserve:shutdown :server (wserver self))
175 (stop-wol-project (name1 self))
176 (stop-wol-project (name2 self)))
178 (def-test-method test-two-project-index ((self test-two-projects) :run nil)
179 (multiple-value-bind (body response-code headers uri)
180 (net.aserve.client:do-http-request
181 (render-uri (copy-uri (parse-uri "http://localhost/testprefix/")
182 :port (port self)) nil)
184 (declare (ignore uri))
185 (assert-true (zerop (length body)))
186 (let ((redir (parse-uri
187 (cdr (assoc "Location" headers :test #'string-equal)))))
188 (assert-equal (uri-path redir) "/testprefix/index1.html"))
189 (assert-equal response-code 307))
190 (multiple-value-bind (body response-code headers uri)
191 (net.aserve.client:do-http-request
192 (render-uri (copy-uri (parse-uri "http://localhost/prefixtest/")
193 :port (port self)) nil)
195 (declare (ignore uri))
196 (assert-true (zerop (length body)))
197 (let ((redir (parse-uri
198 (cdr (assoc "Location" headers :test #'string-equal)))))
199 (assert-equal (uri-path redir) "/prefixtest/index2.html"))
200 (assert-equal response-code 307)
206 (defclass test-sessions (test-case)
207 ((wserver :accessor wserver)
208 (name :accessor name :initform "sessions")
209 (prefix :accessor prefix :initform "/")
210 (port :accessor port :initform 31324)
213 (defmethod set-up ((self test-sessions))
214 (setf (wserver self) (net.aserve:start :port (port self) :server :new))
215 (setq net.aserve::*enable-logging* nil)
216 (wol-project (name self) :index "index" :connector :aserve
218 :map '(("index" test-sessions-index))
219 :project-prefix (prefix self)
220 :server (wserver self)))
223 (defmethod tear-down ((self test-sessions))
224 (net.aserve:shutdown :server (wserver self))
225 (stop-wol-project (name self)))
227 (defun test-sessions-index (req ent)
228 (let ((session (websession-from-req req)))
229 (with-wol-page (req ent)
230 (let ((url (make-wol-url "page" req ent)))
231 (format *html-stream* "index~%")
232 (format *html-stream* "~A~%" (websession-key session))
233 (format *html-stream* "~A~%" url)
236 (def-test-method test-sessions ((self test-sessions) :run nil)
237 (multiple-value-bind (body response-code headers uri)
238 (net.aserve.client:do-http-request
239 (render-uri (copy-uri (parse-uri "http://localhost/index.html")
240 :port (port self)) nil))
241 (declare (ignore uri))
242 (assert-equal response-code 200)
243 (let ((cookies (set-cookies-in-headers headers)))
244 (assert-equal (length cookies) 1))
245 (let ((lines (delimited-string-to-list body #\newline t)))
246 (assert-equal (length lines) 3)
247 (assert-equal (first lines) "index")
248 (assert-equal (length (second lines)) +length-session-id+)
249 (assert-equal (third lines)
250 (format nil "/~~~A~~/page.html" (second lines))))))
255 (defclass test-no-sessions (test-case)
256 ((wserver :accessor wserver)
257 (name :accessor name :initform "sessions")
258 (prefix :accessor prefix :initform "/")
259 (port :accessor port :initform 31325)
262 (defmethod set-up ((self test-no-sessions))
263 (setf (wserver self) (net.aserve:start :port (port self) :server :new))
264 (setq net.aserve::*enable-logging* nil)
265 (wol-project (name self) :index "index" :connector :aserve
267 :map '(("index" test-no-sessions-index))
268 :project-prefix (prefix self)
269 :server (wserver self)))
271 (defun test-no-sessions-index (req ent)
272 (let ((session (websession-from-req req)))
273 (with-wol-page (req ent)
274 (let ((url (make-wol-url "page" req ent)))
275 (format *html-stream* "index~%")
276 (format *html-stream* "~(~A~)~%" session)
277 (format *html-stream* "~A~%" url)
280 (defmethod tear-down ((self test-no-sessions))
281 (net.aserve:shutdown :server (wserver self))
282 (stop-wol-project (name self)))
284 (def-test-method test-no-sessions ((self test-no-sessions) :run nil)
285 (multiple-value-bind (body response-code headers uri)
286 (net.aserve.client:do-http-request
287 (render-uri (copy-uri (parse-uri "http://localhost/index.html")
288 :port (port self)) nil))
289 (declare (ignore uri))
290 (assert-equal response-code 200)
291 (let ((cookies (set-cookies-in-headers headers)))
292 (assert-equal (length cookies) 0))
293 (let ((lines (delimited-string-to-list body #\newline t)))
294 (assert-equal (length lines) 3)
295 (assert-equal (first lines) "index")
296 (assert-equal (second lines) "nil")
297 (assert-equal (third lines) "/page.html"))))
302 (defclass all-tests (test-suite) ())
303 (defparameter *all-tests* (make-instance 'all-tests))
305 (add-test *all-tests* (get-suite test-keyed-url))
306 (add-test *all-tests* (get-suite test-non-keyed-url))
307 (add-test *all-tests* (get-suite test-server))
308 (add-test *all-tests* (get-suite test-two-projects))
309 (add-test *all-tests* (get-suite test-sessions))
310 (add-test *all-tests* (get-suite test-no-sessions))
313 (or (was-successful (textui-test-run *all-tests*))
314 (error "Failed tests")))