tests.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: wol-tests -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Id:      $Id: tests.lisp,v 1.3 2003/08/10 17:56:44 kevin Exp $
   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
  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
  33                        :raw-uri uri
  34                        :decoded-uri-path (render-uri uri nil)
  35                        :uri uri))))
  36
  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))))
  39
  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)
  43                 "/index.html"))
  44
  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))
  48                 "/index.html"))
  49
  50 ;;; Non-keyed URL tests
  51
  52 (defclass test-non-keyed-url (test-case)
  53   ((req :accessor req)))
  54
  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
  58                        :raw-uri uri
  59                        :decoded-uri-path (render-uri uri nil)
  60                        :uri uri))))
  61
  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))))
  64
  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)
  68                 "/index.html"))
  69
  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))
  73                 "/index.html"))
  74
  75 ;;; Test server
  76
  77 (defclass test-server (test-case)
  78   ((wserver :accessor wserver)
  79    (name :accessor name :initform "testproj")
  80    (port :accessor port :initform 31322)
  81    ))
  82
  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)))
  88
  89
  90 (defmethod tear-down ((self test-server))
  91   (net.aserve:shutdown :server (wserver self)))
  92
  93
  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)
  99         :redirect 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)
 106     ))
 107
 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))
 111
 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)
 116         :redirect 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)))
 123
 124
 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))
 128
 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)
 133         :redirect nil)
 134     (declare (ignore uri headers))
 135     (assert-equal response-code 404)
 136     (assert-true (plusp (length body))))
 137
 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)
 142         :redirect nil)
 143     (declare (ignore uri headers))
 144     (assert-true (plusp (length body)))
 145     (assert-equal response-code 404))
 146
 147 )
 148
 149
 150 ;;; Test two projects
 151
 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)
 159    ))
 160
 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))
 170   )
 171
 172
 173 (defmethod tear-down ((self test-two-projects))
 174   (net.aserve:shutdown :server (wserver self)))
 175
 176 (def-test-method test-two-project-index ((self test-two-projects) :run nil)
 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/testprefix/")
 180                                 :port (port self)) nil)
 181         :redirect nil)
 182     (declare (ignore uri))
 183     (assert-true (zerop (length body)))
 184     (let ((redir (parse-uri
 185                   (cdr (assoc "Location" headers :test #'string-equal)))))
 186       (assert-equal (uri-path redir) "/testprefix/index1.html"))
 187     (assert-equal response-code 307))
 188   (multiple-value-bind (body response-code headers uri)
 189       (net.aserve.client:do-http-request
 190           (render-uri (copy-uri (parse-uri "http://localhost/prefixtest/")
 191                                 :port (port self)) nil)
 192         :redirect nil)
 193     (declare (ignore uri))
 194     (assert-true (zerop (length body)))
 195     (let ((redir (parse-uri
 196                   (cdr (assoc "Location" headers :test #'string-equal)))))
 197       (assert-equal (uri-path redir) "/prefixtest/index2.html"))
 198     (assert-equal response-code 307)
 199     ))
 200
 201
 202 ;;; Test sessions
 203
 204 (defclass test-sessions (test-case)
 205   ((wserver :accessor wserver)
 206    (name :accessor name :initform "sessions")
 207    (prefix :accessor prefix :initform "/")
 208    (port :accessor port :initform 31324)
 209    ))
 210
 211 (defmethod set-up ((self test-sessions))
 212   (setf (wserver self) (net.aserve:start :port (port self) :server :new))
 213   (setq net.aserve::*enable-logging* nil)
 214   (wol-project (name self) :index "index" :connector :aserve
 215                :sessions t
 216                :map '(("index" test-sessions-index))
 217                :project-prefix (prefix self)
 218                :server (wserver self)))
 219
 220
 221 (defmethod tear-down ((self test-sessions))
 222   (net.aserve:shutdown :server (wserver self)))
 223
 224 (defun test-sessions-index (req ent)
 225   (let ((session (websession-from-req req)))
 226     (with-wol-page (req ent)
 227       (let ((url (make-wol-url "page" req ent)))
 228         (format *html-stream* "index~%")
 229         (format *html-stream* "~A~%" (websession-key session))
 230         (format *html-stream* "~A~%" url)
 231         ))))
 232
 233 (def-test-method test-sessions ((self test-sessions) :run nil)
 234   (multiple-value-bind (body response-code headers uri)
 235       (net.aserve.client:do-http-request
 236           (render-uri (copy-uri (parse-uri "http://localhost/index.html")
 237                                 :port (port self)) nil))
 238     (declare (ignore uri))
 239     (assert-equal response-code 200)
 240     (let ((cookies (set-cookies-in-headers headers)))
 241       (assert-equal (length cookies) 1))
 242     (let ((lines (delimited-string-to-list body #\newline t)))
 243       (assert-equal (length lines) 3)
 244       (assert-equal (first lines) "index")
 245       (assert-equal (length (second lines)) +length-session-id+)
 246       (assert-equal (third lines)
 247                     (format nil "/~~~A~~/page.html" (second lines))))))
 248
 249
 250 ;;; Test no sessions
 251
 252 (defclass test-no-sessions (test-case)
 253   ((wserver :accessor wserver)
 254    (name :accessor name :initform "sessions")
 255    (prefix :accessor prefix :initform "/")
 256    (port :accessor port :initform 31325)
 257    ))
 258
 259 (defmethod set-up ((self test-no-sessions))
 260   (setf (wserver self) (net.aserve:start :port (port self) :server :new))
 261   (setq net.aserve::*enable-logging* nil)
 262   (wol-project (name self) :index "index" :connector :aserve
 263                :sessions nil
 264                :map '(("index" test-no-sessions-index))
 265                :project-prefix (prefix self)
 266                :server (wserver self)))
 267
 268 (defun test-no-sessions-index (req ent)
 269   (let ((session (websession-from-req req)))
 270     (with-wol-page (req ent)
 271       (let ((url (make-wol-url "page" req ent)))
 272         (format *html-stream* "index~%")
 273         (format *html-stream* "~(~A~)~%" session)
 274         (format *html-stream* "~A~%" url)
 275         ))))
 276
 277 (defmethod tear-down ((self test-no-sessions))
 278   (net.aserve:shutdown :server (wserver self)))
 279
 280 (def-test-method test-no-sessions ((self test-no-sessions) :run nil)
 281   (multiple-value-bind (body response-code headers uri)
 282       (net.aserve.client:do-http-request
 283           (render-uri (copy-uri (parse-uri "http://localhost/index.html")
 284                                 :port (port self)) nil))
 285     (declare (ignore uri))
 286     (assert-equal response-code 200)
 287     (let ((cookies (set-cookies-in-headers headers)))
 288       (assert-equal (length cookies) 0))
 289     (let ((lines (delimited-string-to-list body #\newline t)))
 290       (assert-equal (length lines) 3)
 291       (assert-equal (first lines) "index")
 292       (assert-equal (second lines) "nil")
 293       (assert-equal (third lines) "/page.html"))))
 294
 295
 296 ;;; All tests
 297
 298 (defclass all-tests (test-suite) ())
 299 (defparameter *all-tests* (make-instance 'all-tests))
 300
 301 (add-test *all-tests* (get-suite test-keyed-url))
 302 (add-test *all-tests* (get-suite test-non-keyed-url))
 303 (add-test *all-tests* (get-suite test-server))
 304 (add-test *all-tests* (get-suite test-two-projects))
 305 (add-test *all-tests* (get-suite test-sessions))
 306 (add-test *all-tests* (get-suite test-no-sessions))
 307
 308 (defun do-tests ()
 309   (or (was-successful (textui-test-run *all-tests*))
 310       (error "Failed tests")))