(defpackage #:wol-tests
(:use #:xlunit #:cl #:wol #:puri #:lml2 #:kmrcl)
(:export #:do-tests #:*all-tests*))
-
+
(in-package #:wol-tests)
(eval-when (:compile-toplevel :load-toplevel :execute)
(import '(wol::req-recode-uri-sans-session-id wol::request-uri
- wol::request-decoded-uri-path wol::websession-from-req
- wol::websession-key wol::+length-session-id+
- wol::set-cookies-in-headers)))
+ wol::request-decoded-uri-path wol::websession-from-req
+ wol::websession-key wol::+length-session-id+
+ wol::set-cookies-in-headers)))
;; Keyed URL Tests
(defmethod set-up ((self test-keyed-url))
(let ((uri (parse-uri "/~abcdefg~/index.html")))
(setf (req self) (make-instance 'wol::http-request
- :raw-uri uri
- :decoded-uri-path (render-uri uri nil)
- :uri uri))
- (setf (ent self) (make-instance 'wol::entity
- :project (make-instance 'wol::wol-project
- :project-prefix "/")))))
+ :raw-uri uri
+ :decoded-uri-path (render-uri uri nil)
+ :uri uri))
+ (setf (ent self) (make-instance 'wol::entity
+ :project (make-instance 'wol::wol-project
+ :project-prefix "/")))))
(def-test-method test-returned-session ((self test-keyed-url) :run nil)
(assert-equal "abcdefg" (req-recode-uri-sans-session-id (req self)
- (ent self))))
-
+ (ent self))))
+
(def-test-method test-recomputed-uri ((self test-keyed-url) :run nil)
(req-recode-uri-sans-session-id (req self) (ent self))
(assert-equal (render-uri (request-uri (req self)) nil)
- "/index.html"))
+ "/index.html"))
(def-test-method test-decoded-uri ((self test-keyed-url) :run nil)
(req-recode-uri-sans-session-id (req self) (ent self))
(assert-equal (request-decoded-uri-path (req self))
- "/index.html"))
+ "/index.html"))
(defclass test-keyed-url-2 (test-case)
(defmethod set-up ((self test-keyed-url-2))
(let ((uri (parse-uri "/app/~abcdefg~/index.html")))
(setf (req self) (make-instance 'wol::http-request
- :raw-uri uri
- :decoded-uri-path (render-uri uri nil)
- :uri uri))
- (setf (ent self) (make-instance 'wol::entity
- :project (make-instance 'wol::wol-project
- :project-prefix "/app/")))))
+ :raw-uri uri
+ :decoded-uri-path (render-uri uri nil)
+ :uri uri))
+ (setf (ent self) (make-instance 'wol::entity
+ :project (make-instance 'wol::wol-project
+ :project-prefix "/app/")))))
(def-test-method test-returned-session ((self test-keyed-url-2) :run nil)
(assert-equal "abcdefg" (req-recode-uri-sans-session-id (req self)
- (ent self))))
-
+ (ent self))))
+
(def-test-method test-recomputed-uri ((self test-keyed-url-2) :run nil)
(req-recode-uri-sans-session-id (req self) (ent self))
(assert-equal (render-uri (request-uri (req self)) nil)
- "/app/index.html"))
+ "/app/index.html"))
(def-test-method test-decoded-uri ((self test-keyed-url-2) :run nil)
(req-recode-uri-sans-session-id (req self) (ent self))
(assert-equal (request-decoded-uri-path (req self))
- "/app/index.html"))
+ "/app/index.html"))
;;; Non-keyed URL tests
(defmethod set-up ((self test-non-keyed-url))
(let ((uri (parse-uri "/index.html")))
(setf (req self) (make-instance 'wol::http-request
- :raw-uri uri
- :decoded-uri-path (render-uri uri nil)
- :uri uri))
- (setf (ent self) (make-instance 'wol::entity
- :project (make-instance 'wol::wol-project
- :project-prefix "/")))))
+ :raw-uri uri
+ :decoded-uri-path (render-uri uri nil)
+ :uri uri))
+ (setf (ent self) (make-instance 'wol::entity
+ :project (make-instance 'wol::wol-project
+ :project-prefix "/")))))
(def-test-method test-returned-session ((self test-non-keyed-url) :run nil)
(assert-false (req-recode-uri-sans-session-id (req self) (ent self))))
-
+
(def-test-method test-recomputed-uri ((self test-non-keyed-url) :run nil)
(req-recode-uri-sans-session-id (req self) (ent self))
(assert-equal (render-uri (request-uri (req self)) nil)
- "/index.html"))
+ "/index.html"))
(def-test-method test-decoded-uri ((self test-non-keyed-url) :run nil)
(req-recode-uri-sans-session-id (req self) (ent self))
(assert-equal (request-decoded-uri-path (req self))
- "/index.html"))
+ "/index.html"))
(defclass test-non-keyed-url-2 (test-case)
((req :accessor req)
(defmethod set-up ((self test-non-keyed-url-2))
(let ((uri (parse-uri "/app1/index.html")))
(setf (req self) (make-instance 'wol::http-request
- :raw-uri uri
- :decoded-uri-path (render-uri uri nil)
- :uri uri))
- (setf (ent self) (make-instance 'wol::entity
- :project (make-instance 'wol::wol-project
- :project-prefix "/app1/")))))
+ :raw-uri uri
+ :decoded-uri-path (render-uri uri nil)
+ :uri uri))
+ (setf (ent self) (make-instance 'wol::entity
+ :project (make-instance 'wol::wol-project
+ :project-prefix "/app1/")))))
(def-test-method test-returned-session ((self test-non-keyed-url-2) :run nil)
(assert-false (req-recode-uri-sans-session-id (req self) (ent self))))
-
+
(def-test-method test-recomputed-uri ((self test-non-keyed-url-2) :run nil)
(req-recode-uri-sans-session-id (req self) (ent self))
(assert-equal (render-uri (request-uri (req self)) nil)
- "/app1/index.html"))
+ "/app1/index.html"))
(def-test-method test-decoded-uri ((self test-non-keyed-url-2) :run nil)
(req-recode-uri-sans-session-id (req self) (ent self))
(assert-equal (request-decoded-uri-path (req self))
- "/app1/index.html"))
+ "/app1/index.html"))
;;; Test server
))
(defmethod set-up ((self test-server))
- (setf (wserver self) (net.aserve:start :port (port self) :server :new))
+ (setf (wserver self) (net.aserve:start :port (port self) :server :new))
(setq net.aserve::*enable-logging* nil)
(wol-project (name self) :index "index" :connector :aserve
- :server (wserver self)))
-
+ :server (wserver self)))
+
(defmethod tear-down ((self test-server))
(net.aserve:shutdown :server (wserver self)))
(def-test-method test-server-index ((self test-server) :run nil)
(multiple-value-bind (body response-code headers uri)
- (net.aserve.client:do-http-request
- (render-uri (copy-uri (parse-uri "http://localhost/")
- :port (port self)) nil)
- :redirect nil)
+ (net.aserve.client:do-http-request
+ (render-uri (copy-uri (parse-uri "http://localhost/")
+ :port (port self)) nil)
+ :redirect nil)
(declare (ignore uri))
(assert-true (zerop (length body)))
(let ((redir (parse-uri
- (cdr (assoc "Location" headers :test #'string-equal)))))
+ (cdr (assoc "Location" headers :test #'string-equal)))))
(assert-equal (uri-path redir) "/index.html"))
(assert-equal response-code 307)
))
(def-test-method test-prefix-index-1 ((self test-server) :run nil)
(wol-project (name self) :index "index" :connector :aserve
- :project-prefix "/aprefix/" :server (wserver self))
+ :project-prefix "/aprefix/" :server (wserver self))
(multiple-value-bind (body response-code headers uri)
- (net.aserve.client:do-http-request
- (render-uri (copy-uri (parse-uri "http://localhost/aprefix/")
- :port (port self)) nil)
- :redirect nil)
+ (net.aserve.client:do-http-request
+ (render-uri (copy-uri (parse-uri "http://localhost/aprefix/")
+ :port (port self)) nil)
+ :redirect nil)
(declare (ignore uri))
(assert-equal "" body)
(let ((redir (parse-uri
- (cdr (assoc "Location" headers :test #'string-equal)))))
+ (cdr (assoc "Location" headers :test #'string-equal)))))
(assert-equal (uri-path redir) "/aprefix/index.html"))
(assert-equal response-code 307)))
(def-test-method test-prefix-index-2 ((self test-server) :run nil)
(wol-project (name self) :index "index" :connector :aserve
- :project-prefix "/aprefix/" :server (wserver self))
+ :project-prefix "/aprefix/" :server (wserver self))
(multiple-value-bind (body response-code headers uri)
- (net.aserve.client:do-http-request
- (render-uri (copy-uri (parse-uri "http://localhost/ab")
- :port (port self)) nil)
- :redirect nil)
+ (net.aserve.client:do-http-request
+ (render-uri (copy-uri (parse-uri "http://localhost/ab")
+ :port (port self)) nil)
+ :redirect nil)
(declare (ignore uri headers))
(assert-equal response-code 404)
(assert-true (plusp (length body))))
-
+
(multiple-value-bind (body response-code headers uri)
- (net.aserve.client:do-http-request
- (render-uri (copy-uri (parse-uri "http://localhost/")
- :port (port self)) nil)
- :redirect nil)
+ (net.aserve.client:do-http-request
+ (render-uri (copy-uri (parse-uri "http://localhost/")
+ :port (port self)) nil)
+ :redirect nil)
(declare (ignore uri headers))
(assert-true (plusp (length body)))
(assert-equal response-code 404))
-
+
)
))
(defmethod set-up ((self test-two-projects))
- (setf (wserver self) (net.aserve:start :port (port self) :server :new))
+ (setf (wserver self) (net.aserve:start :port (port self) :server :new))
(setq net.aserve::*enable-logging* nil)
(wol-project (name1 self) :index "index1" :connector :aserve
- :project-prefix (prefix1 self)
- :server (wserver self))
+ :project-prefix (prefix1 self)
+ :server (wserver self))
(wol-project (name2 self) :index "index2" :connector :aserve
- :project-prefix (prefix2 self)
- :server (wserver self))
- )
-
+ :project-prefix (prefix2 self)
+ :server (wserver self))
+ )
+
(defmethod tear-down ((self test-two-projects))
(net.aserve:shutdown :server (wserver self)))
(def-test-method test-two-project-index ((self test-two-projects) :run nil)
(multiple-value-bind (body response-code headers uri)
- (net.aserve.client:do-http-request
- (render-uri (copy-uri (parse-uri "http://localhost/testprefix/")
- :port (port self)) nil)
- :redirect nil)
+ (net.aserve.client:do-http-request
+ (render-uri (copy-uri (parse-uri "http://localhost/testprefix/")
+ :port (port self)) nil)
+ :redirect nil)
(declare (ignore uri))
(assert-true (zerop (length body)))
(let ((redir (parse-uri
- (cdr (assoc "Location" headers :test #'string-equal)))))
+ (cdr (assoc "Location" headers :test #'string-equal)))))
(assert-equal (uri-path redir) "/testprefix/index1.html"))
(assert-equal response-code 307))
(multiple-value-bind (body response-code headers uri)
- (net.aserve.client:do-http-request
- (render-uri (copy-uri (parse-uri "http://localhost/prefixtest/")
- :port (port self)) nil)
- :redirect nil)
+ (net.aserve.client:do-http-request
+ (render-uri (copy-uri (parse-uri "http://localhost/prefixtest/")
+ :port (port self)) nil)
+ :redirect nil)
(declare (ignore uri))
(assert-true (zerop (length body)))
(let ((redir (parse-uri
- (cdr (assoc "Location" headers :test #'string-equal)))))
+ (cdr (assoc "Location" headers :test #'string-equal)))))
(assert-equal (uri-path redir) "/prefixtest/index2.html"))
(assert-equal response-code 307)
))
))
(defmethod set-up ((self test-sessions))
- (setf (wserver self) (net.aserve:start :port (port self) :server :new))
+ (setf (wserver self) (net.aserve:start :port (port self) :server :new))
(setq net.aserve::*enable-logging* nil)
(wol-project (name self) :index "index" :connector :aserve
- :sessions t
- :map '(("index" test-sessions-index))
- :project-prefix (prefix self)
- :server (wserver self)))
-
+ :sessions t
+ :map '(("index" test-sessions-index))
+ :project-prefix (prefix self)
+ :server (wserver self)))
+
(defmethod tear-down ((self test-sessions))
(net.aserve:shutdown :server (wserver self)))
(let ((session (websession-from-req req)))
(with-wol-page (req ent)
(let ((url (make-wol-url "page" req ent)))
- (format *html-stream* "index~%")
- (format *html-stream* "~A~%" (websession-key session))
- (format *html-stream* "~A~%" url)
- ))))
+ (format *html-stream* "index~%")
+ (format *html-stream* "~A~%" (websession-key session))
+ (format *html-stream* "~A~%" url)
+ ))))
(def-test-method test-sessions ((self test-sessions) :run nil)
(multiple-value-bind (body response-code headers uri)
- (net.aserve.client:do-http-request
- (render-uri (copy-uri (parse-uri "http://localhost/index.html")
- :port (port self)) nil))
+ (net.aserve.client:do-http-request
+ (render-uri (copy-uri (parse-uri "http://localhost/index.html")
+ :port (port self)) nil))
(declare (ignore uri))
(assert-equal response-code 200)
(let ((cookies (set-cookies-in-headers headers)))
(assert-equal (first lines) "index")
(assert-equal (length (second lines)) +length-session-id+)
(assert-equal (third lines)
- (format nil "/~~~A~~/page.html" (second lines))))))
+ (format nil "/~~~A~~/page.html" (second lines))))))
;;; Test no sessions
))
(defmethod set-up ((self test-no-sessions))
- (setf (wserver self) (net.aserve:start :port (port self) :server :new))
+ (setf (wserver self) (net.aserve:start :port (port self) :server :new))
(setq net.aserve::*enable-logging* nil)
(wol-project (name self) :index "index" :connector :aserve
- :sessions nil
- :map '(("index" test-no-sessions-index))
- :project-prefix (prefix self)
- :server (wserver self)))
+ :sessions nil
+ :map '(("index" test-no-sessions-index))
+ :project-prefix (prefix self)
+ :server (wserver self)))
(defun test-no-sessions-index (req ent)
(let ((session (websession-from-req req)))
(with-wol-page (req ent)
(let ((url (make-wol-url "page" req ent)))
- (format *html-stream* "index~%")
- (format *html-stream* "~(~A~)~%" session)
- (format *html-stream* "~A~%" url)
- ))))
+ (format *html-stream* "index~%")
+ (format *html-stream* "~(~A~)~%" session)
+ (format *html-stream* "~A~%" url)
+ ))))
(defmethod tear-down ((self test-no-sessions))
(net.aserve:shutdown :server (wserver self)))
(def-test-method test-no-sessions ((self test-no-sessions) :run nil)
(multiple-value-bind (body response-code headers uri)
- (net.aserve.client:do-http-request
- (render-uri (copy-uri (parse-uri "http://localhost/index.html")
- :port (port self)) nil))
+ (net.aserve.client:do-http-request
+ (render-uri (copy-uri (parse-uri "http://localhost/index.html")
+ :port (port self)) nil))
(declare (ignore uri))
(assert-equal response-code 200)
(let ((cookies (set-cookies-in-headers headers)))
projects / wol.git / blobdiff