;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: wol-tests -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Id: $Id$ ;;;; Purpose: Self Test suite for WOL ;;;; ;;;; ************************************************************************* (in-package #:cl-user) (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))) ;; Keyed URL Tests (defclass test-keyed-url (test-case) ((req :accessor req) (ent :accessor ent))) (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 "/"))))) (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)))) (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")) (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")) (defclass test-keyed-url-2 (test-case) ((req :accessor req) (ent :accessor ent))) (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/"))))) (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)))) (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")) (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")) ;;; Non-keyed URL tests (defclass test-non-keyed-url (test-case) ((req :accessor req) (ent :accessor ent))) (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 "/"))))) (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")) (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")) (defclass test-non-keyed-url-2 (test-case) ((req :accessor req) (ent :accessor ent))) (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/"))))) (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")) (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")) ;;; Test server (defclass test-server (test-case) ((wserver :accessor wserver) (name :accessor name :initform "testproj") (port :accessor port :initform 31322) )) (defmethod set-up ((self test-server)) (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))) (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) (declare (ignore uri)) (assert-true (zerop (length body))) (let ((redir (parse-uri (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)) (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) (declare (ignore uri)) (assert-equal "" body) (let ((redir (parse-uri (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)) (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) (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) (declare (ignore uri headers)) (assert-true (plusp (length body))) (assert-equal response-code 404)) ) ;;; Test two projects (defclass test-two-projects (test-case) ((wserver :accessor wserver) (name1 :accessor name1 :initform "testproj") (prefix1 :accessor prefix1 :initform "/testprefix/") (name2 :accessor name2 :initform "projtest") (prefix12 :accessor prefix2 :initform "/prefixtest/") (port :accessor port :initform 31323) )) (defmethod set-up ((self test-two-projects)) (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)) (wol-project (name2 self) :index "index2" :connector :aserve :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) (declare (ignore uri)) (assert-true (zerop (length body))) (let ((redir (parse-uri (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) (declare (ignore uri)) (assert-true (zerop (length body))) (let ((redir (parse-uri (cdr (assoc "Location" headers :test #'string-equal))))) (assert-equal (uri-path redir) "/prefixtest/index2.html")) (assert-equal response-code 307) )) ;;; Test sessions (defclass test-sessions (test-case) ((wserver :accessor wserver) (name :accessor name :initform "sessions") (prefix :accessor prefix :initform "/") (port :accessor port :initform 31324) )) (defmethod set-up ((self test-sessions)) (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))) (defmethod tear-down ((self test-sessions)) (net.aserve:shutdown :server (wserver self))) (defun test-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~%" (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)) (declare (ignore uri)) (assert-equal response-code 200) (let ((cookies (set-cookies-in-headers headers))) (assert-equal (length cookies) 1)) (let ((lines (delimited-string-to-list body #\newline t))) (assert-equal (length lines) 3) (assert-equal (first lines) "index") (assert-equal (length (second lines)) +length-session-id+) (assert-equal (third lines) (format nil "/~~~A~~/page.html" (second lines)))))) ;;; Test no sessions (defclass test-no-sessions (test-case) ((wserver :accessor wserver) (name :accessor name :initform "sessions") (prefix :accessor prefix :initform "/") (port :accessor port :initform 31325) )) (defmethod set-up ((self test-no-sessions)) (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))) (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) )))) (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)) (declare (ignore uri)) (assert-equal response-code 200) (let ((cookies (set-cookies-in-headers headers))) (assert-equal (length cookies) 0)) (let ((lines (delimited-string-to-list body #\newline t))) (assert-equal (length lines) 3) (assert-equal (first lines) "index") (assert-equal (second lines) "nil") (assert-equal (third lines) "/page.html")))) ;;; All tests (defclass all-tests (test-suite) ()) (defparameter *all-tests* (make-instance 'all-tests)) (add-test *all-tests* (get-suite test-keyed-url)) (add-test *all-tests* (get-suite test-keyed-url-2)) (add-test *all-tests* (get-suite test-non-keyed-url)) (add-test *all-tests* (get-suite test-non-keyed-url-2)) (add-test *all-tests* (get-suite test-server)) (add-test *all-tests* (get-suite test-two-projects)) (add-test *all-tests* (get-suite test-sessions)) (add-test *all-tests* (get-suite test-no-sessions)) (defun do-tests () (or (was-successful (textui-test-run *all-tests*)) (error "Failed tests")))