X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests.lisp;h=bbcb3b6411414a4d96bd9adac2e62850d1d063f6;hb=2271934ed37d266a4ebf206549ca213158489f13;hp=a946f79811e5b8422af70db286e1f4e09f618c81;hpb=115593575b49ab252692a959380e94707e385de3;p=wol.git diff --git a/tests.lisp b/tests.lisp index a946f79..bbcb3b6 100644 --- a/tests.lisp +++ b/tests.lisp @@ -12,14 +12,14 @@ (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 @@ -31,26 +31,26 @@ (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) @@ -60,26 +60,26 @@ (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 @@ -90,25 +90,25 @@ (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) @@ -117,25 +117,25 @@ (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 @@ -146,11 +146,11 @@ )) (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))) @@ -158,57 +158,57 @@ (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)) - + ) @@ -224,41 +224,41 @@ )) (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) )) @@ -274,14 +274,14 @@ )) (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))) @@ -290,16 +290,16 @@ (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))) @@ -309,7 +309,7 @@ (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 @@ -322,31 +322,31 @@ )) (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)))