tests.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: wol-tests -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Id:      $Id$
   6 ;;;; Purpose: Self Test suite for WOL
   7 ;;;;
   8 ;;;; *************************************************************************
   9
  10 (in-package #:cl-user)
  11
  12 (defpackage #:wol-tests
  13   (:use #:xlunit #:cl #:wol #:puri #:lml2 #:kmrcl)
  14   (:export #:do-tests #:*all-tests*))
  15
  16 (in-package #:wol-tests)
  17
  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)))
  23
  24
  25 ;; Keyed URL Tests
  26
  27 (defclass test-keyed-url (test-case)
  28   ((req :accessor req)
  29    (ent :accessor ent)))
  30
  31 (defmethod set-up ((self test-keyed-url))
  32   (let ((uri (parse-uri "/~abcdefg~/index.html")))
  33     (setf (req self) (make-instance 'wol::http-request
  34                        :raw-uri uri
  35                        :decoded-uri-path (render-uri uri nil)
  36                        :uri uri))
  37     (setf (ent self) (make-instance 'wol::entity
  38                        :project (make-instance 'wol::wol-project
  39                                   :project-prefix "/")))))
  40
  41 (def-test-method test-returned-session ((self test-keyed-url) :run nil)
  42   (assert-equal "abcdefg" (req-recode-uri-sans-session-id (req self)
  43                                                           (ent self))))
  44
  45 (def-test-method test-recomputed-uri ((self test-keyed-url) :run nil)
  46   (req-recode-uri-sans-session-id (req self) (ent self))
  47   (assert-equal (render-uri (request-uri (req self)) nil)
  48                 "/index.html"))
  49
  50 (def-test-method test-decoded-uri ((self test-keyed-url) :run nil)
  51   (req-recode-uri-sans-session-id (req self) (ent self))
  52   (assert-equal (request-decoded-uri-path (req self))
  53                 "/index.html"))
  54
  55
  56 (defclass test-keyed-url-2 (test-case)
  57   ((req :accessor req)
  58    (ent :accessor ent)))
  59
  60 (defmethod set-up ((self test-keyed-url-2))
  61   (let ((uri (parse-uri "/app/~abcdefg~/index.html")))
  62     (setf (req self) (make-instance 'wol::http-request
  63                        :raw-uri uri
  64                        :decoded-uri-path (render-uri uri nil)
  65                        :uri uri))
  66     (setf (ent self) (make-instance 'wol::entity
  67                        :project (make-instance 'wol::wol-project
  68                                   :project-prefix "/app/")))))
  69
  70 (def-test-method test-returned-session ((self test-keyed-url-2) :run nil)
  71   (assert-equal "abcdefg" (req-recode-uri-sans-session-id (req self)
  72                                                           (ent self))))
  73
  74 (def-test-method test-recomputed-uri ((self test-keyed-url-2) :run nil)
  75   (req-recode-uri-sans-session-id (req self) (ent self))
  76   (assert-equal (render-uri (request-uri (req self)) nil)
  77                 "/app/index.html"))
  78
  79 (def-test-method test-decoded-uri ((self test-keyed-url-2) :run nil)
  80   (req-recode-uri-sans-session-id (req self) (ent self))
  81   (assert-equal (request-decoded-uri-path (req self))
  82                 "/app/index.html"))
  83
  84 ;;; Non-keyed URL tests
  85
  86 (defclass test-non-keyed-url (test-case)
  87   ((req :accessor req)
  88    (ent :accessor ent)))
  89
  90 (defmethod set-up ((self test-non-keyed-url))
  91   (let ((uri (parse-uri "/index.html")))
  92     (setf (req self) (make-instance 'wol::http-request
  93                        :raw-uri uri
  94                        :decoded-uri-path (render-uri uri nil)
  95                        :uri uri))
  96     (setf (ent self) (make-instance 'wol::entity
  97                        :project (make-instance 'wol::wol-project
  98                                   :project-prefix "/")))))
  99
 100 (def-test-method test-returned-session ((self test-non-keyed-url) :run nil)
 101   (assert-false (req-recode-uri-sans-session-id (req self) (ent self))))
 102
 103 (def-test-method test-recomputed-uri ((self test-non-keyed-url) :run nil)
 104   (req-recode-uri-sans-session-id (req self) (ent self))
 105   (assert-equal (render-uri (request-uri (req self)) nil)
 106                 "/index.html"))
 107
 108 (def-test-method test-decoded-uri ((self test-non-keyed-url) :run nil)
 109   (req-recode-uri-sans-session-id (req self) (ent self))
 110   (assert-equal (request-decoded-uri-path (req self))
 111                 "/index.html"))
 112
 113 (defclass test-non-keyed-url-2 (test-case)
 114   ((req :accessor req)
 115    (ent :accessor ent)))
 116
 117 (defmethod set-up ((self test-non-keyed-url-2))
 118   (let ((uri (parse-uri "/app1/index.html")))
 119     (setf (req self) (make-instance 'wol::http-request
 120                        :raw-uri uri
 121                        :decoded-uri-path (render-uri uri nil)
 122                        :uri uri))
 123     (setf (ent self) (make-instance 'wol::entity
 124                        :project (make-instance 'wol::wol-project
 125                                   :project-prefix "/app1/")))))
 126
 127 (def-test-method test-returned-session ((self test-non-keyed-url-2) :run nil)
 128   (assert-false (req-recode-uri-sans-session-id (req self) (ent self))))
 129
 130 (def-test-method test-recomputed-uri ((self test-non-keyed-url-2) :run nil)
 131   (req-recode-uri-sans-session-id (req self) (ent self))
 132   (assert-equal (render-uri (request-uri (req self)) nil)
 133                 "/app1/index.html"))
 134
 135 (def-test-method test-decoded-uri ((self test-non-keyed-url-2) :run nil)
 136   (req-recode-uri-sans-session-id (req self) (ent self))
 137   (assert-equal (request-decoded-uri-path (req self))
 138                 "/app1/index.html"))
 139
 140 ;;; Test server
 141
 142 (defclass test-server (test-case)
 143   ((wserver :accessor wserver)
 144    (name :accessor name :initform "testproj")
 145    (port :accessor port :initform 31322)
 146    ))
 147
 148 (defmethod set-up ((self test-server))
 149   (setf (wserver self) (net.aserve:start :port (port self) :server :new))
 150   (setq net.aserve::*enable-logging* nil)
 151   (wol-project (name self) :index "index" :connector :aserve
 152                :server (wserver self)))
 153
 154
 155 (defmethod tear-down ((self test-server))
 156   (net.aserve:shutdown :server (wserver self)))
 157
 158
 159 (def-test-method test-server-index ((self test-server) :run nil)
 160   (multiple-value-bind (body response-code headers uri)
 161       (net.aserve.client:do-http-request
 162           (render-uri (copy-uri (parse-uri "http://localhost/")
 163                                 :port (port self)) nil)
 164         :redirect nil)
 165     (declare (ignore uri))
 166     (assert-true (zerop (length body)))
 167     (let ((redir (parse-uri
 168                   (cdr (assoc "Location" headers :test #'string-equal)))))
 169       (assert-equal (uri-path redir) "/index.html"))
 170     (assert-equal response-code 307)
 171     ))
 172
 173 (def-test-method test-prefix-index-1 ((self test-server) :run nil)
 174   (wol-project (name self) :index "index" :connector :aserve
 175                :project-prefix "/aprefix/" :server (wserver self))
 176
 177   (multiple-value-bind (body response-code headers uri)
 178       (net.aserve.client:do-http-request
 179           (render-uri (copy-uri (parse-uri "http://localhost/aprefix/")
 180                                 :port (port self)) nil)
 181         :redirect nil)
 182     (declare (ignore uri))
 183     (assert-equal "" body)
 184     (let ((redir (parse-uri
 185                   (cdr (assoc "Location" headers :test #'string-equal)))))
 186       (assert-equal (uri-path redir) "/aprefix/index.html"))
 187     (assert-equal response-code 307)))
 188
 189
 190 (def-test-method test-prefix-index-2 ((self test-server) :run nil)
 191   (wol-project (name self) :index "index" :connector :aserve
 192                :project-prefix "/aprefix/" :server (wserver self))
 193
 194     (multiple-value-bind (body response-code headers uri)
 195       (net.aserve.client:do-http-request
 196           (render-uri (copy-uri (parse-uri "http://localhost/ab")
 197                                 :port (port self)) nil)
 198         :redirect nil)
 199     (declare (ignore uri headers))
 200     (assert-equal response-code 404)
 201     (assert-true (plusp (length body))))
 202
 203     (multiple-value-bind (body response-code headers uri)
 204       (net.aserve.client:do-http-request
 205           (render-uri (copy-uri (parse-uri "http://localhost/")
 206                                 :port (port self)) nil)
 207         :redirect nil)
 208     (declare (ignore uri headers))
 209     (assert-true (plusp (length body)))
 210     (assert-equal response-code 404))
 211
 212 )
 213
 214
 215 ;;; Test two projects
 216
 217 (defclass test-two-projects (test-case)
 218   ((wserver :accessor wserver)
 219    (name1 :accessor name1 :initform "testproj")
 220    (prefix1 :accessor prefix1 :initform "/testprefix/")
 221    (name2 :accessor name2 :initform "projtest")
 222    (prefix12 :accessor prefix2 :initform "/prefixtest/")
 223    (port :accessor port :initform 31323)
 224    ))
 225
 226 (defmethod set-up ((self test-two-projects))
 227   (setf (wserver self) (net.aserve:start :port (port self) :server :new))
 228   (setq net.aserve::*enable-logging* nil)
 229   (wol-project (name1 self) :index "index1" :connector :aserve
 230                :project-prefix (prefix1 self)
 231                :server (wserver self))
 232   (wol-project (name2 self) :index "index2" :connector :aserve
 233                :project-prefix (prefix2 self)
 234                :server (wserver self))
 235   )
 236
 237
 238 (defmethod tear-down ((self test-two-projects))
 239   (net.aserve:shutdown :server (wserver self)))
 240
 241 (def-test-method test-two-project-index ((self test-two-projects) :run nil)
 242   (multiple-value-bind (body response-code headers uri)
 243       (net.aserve.client:do-http-request
 244           (render-uri (copy-uri (parse-uri "http://localhost/testprefix/")
 245                                 :port (port self)) nil)
 246         :redirect nil)
 247     (declare (ignore uri))
 248     (assert-true (zerop (length body)))
 249     (let ((redir (parse-uri
 250                   (cdr (assoc "Location" headers :test #'string-equal)))))
 251       (assert-equal (uri-path redir) "/testprefix/index1.html"))
 252     (assert-equal response-code 307))
 253   (multiple-value-bind (body response-code headers uri)
 254       (net.aserve.client:do-http-request
 255           (render-uri (copy-uri (parse-uri "http://localhost/prefixtest/")
 256                                 :port (port self)) nil)
 257         :redirect nil)
 258     (declare (ignore uri))
 259     (assert-true (zerop (length body)))
 260     (let ((redir (parse-uri
 261                   (cdr (assoc "Location" headers :test #'string-equal)))))
 262       (assert-equal (uri-path redir) "/prefixtest/index2.html"))
 263     (assert-equal response-code 307)
 264     ))
 265
 266
 267 ;;; Test sessions
 268
 269 (defclass test-sessions (test-case)
 270   ((wserver :accessor wserver)
 271    (name :accessor name :initform "sessions")
 272    (prefix :accessor prefix :initform "/")
 273    (port :accessor port :initform 31324)
 274    ))
 275
 276 (defmethod set-up ((self test-sessions))
 277   (setf (wserver self) (net.aserve:start :port (port self) :server :new))
 278   (setq net.aserve::*enable-logging* nil)
 279   (wol-project (name self) :index "index" :connector :aserve
 280                :sessions t
 281                :map '(("index" test-sessions-index))
 282                :project-prefix (prefix self)
 283                :server (wserver self)))
 284
 285
 286 (defmethod tear-down ((self test-sessions))
 287   (net.aserve:shutdown :server (wserver self)))
 288
 289 (defun test-sessions-index (req ent)
 290   (let ((session (websession-from-req req)))
 291     (with-wol-page (req ent)
 292       (let ((url (make-wol-url "page" req ent)))
 293         (format *html-stream* "index~%")
 294         (format *html-stream* "~A~%" (websession-key session))
 295         (format *html-stream* "~A~%" url)
 296         ))))
 297
 298 (def-test-method test-sessions ((self test-sessions) :run nil)
 299   (multiple-value-bind (body response-code headers uri)
 300       (net.aserve.client:do-http-request
 301           (render-uri (copy-uri (parse-uri "http://localhost/index.html")
 302                                 :port (port self)) nil))
 303     (declare (ignore uri))
 304     (assert-equal response-code 200)
 305     (let ((cookies (set-cookies-in-headers headers)))
 306       (assert-equal (length cookies) 1))
 307     (let ((lines (delimited-string-to-list body #\newline t)))
 308       (assert-equal (length lines) 3)
 309       (assert-equal (first lines) "index")
 310       (assert-equal (length (second lines)) +length-session-id+)
 311       (assert-equal (third lines)
 312                     (format nil "/~~~A~~/page.html" (second lines))))))
 313
 314
 315 ;;; Test no sessions
 316
 317 (defclass test-no-sessions (test-case)
 318   ((wserver :accessor wserver)
 319    (name :accessor name :initform "sessions")
 320    (prefix :accessor prefix :initform "/")
 321    (port :accessor port :initform 31325)
 322    ))
 323
 324 (defmethod set-up ((self test-no-sessions))
 325   (setf (wserver self) (net.aserve:start :port (port self) :server :new))
 326   (setq net.aserve::*enable-logging* nil)
 327   (wol-project (name self) :index "index" :connector :aserve
 328                :sessions nil
 329                :map '(("index" test-no-sessions-index))
 330                :project-prefix (prefix self)
 331                :server (wserver self)))
 332
 333 (defun test-no-sessions-index (req ent)
 334   (let ((session (websession-from-req req)))
 335     (with-wol-page (req ent)
 336       (let ((url (make-wol-url "page" req ent)))
 337         (format *html-stream* "index~%")
 338         (format *html-stream* "~(~A~)~%" session)
 339         (format *html-stream* "~A~%" url)
 340         ))))
 341
 342 (defmethod tear-down ((self test-no-sessions))
 343   (net.aserve:shutdown :server (wserver self)))
 344
 345 (def-test-method test-no-sessions ((self test-no-sessions) :run nil)
 346   (multiple-value-bind (body response-code headers uri)
 347       (net.aserve.client:do-http-request
 348           (render-uri (copy-uri (parse-uri "http://localhost/index.html")
 349                                 :port (port self)) nil))
 350     (declare (ignore uri))
 351     (assert-equal response-code 200)
 352     (let ((cookies (set-cookies-in-headers headers)))
 353       (assert-equal (length cookies) 0))
 354     (let ((lines (delimited-string-to-list body #\newline t)))
 355       (assert-equal (length lines) 3)
 356       (assert-equal (first lines) "index")
 357       (assert-equal (second lines) "nil")
 358       (assert-equal (third lines) "/page.html"))))
 359
 360
 361 ;;; All tests
 362
 363 (defclass all-tests (test-suite) ())
 364 (defparameter *all-tests* (make-instance 'all-tests))
 365
 366 (add-test *all-tests* (get-suite test-keyed-url))
 367 (add-test *all-tests* (get-suite test-keyed-url-2))
 368 (add-test *all-tests* (get-suite test-non-keyed-url))
 369 (add-test *all-tests* (get-suite test-non-keyed-url-2))
 370 (add-test *all-tests* (get-suite test-server))
 371 (add-test *all-tests* (get-suite test-two-projects))
 372 (add-test *all-tests* (get-suite test-sessions))
 373 (add-test *all-tests* (get-suite test-no-sessions))
 374
 375 (defun do-tests ()
 376   (or (was-successful (textui-test-run *all-tests*))
 377       (error "Failed tests")))