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.2 2003/08/10 05:16:52 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   (stop-wol-project (name self)))
  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   (stop-wol-project (name1 self))
 176   (stop-wol-project (name2 self)))
 177
 178 (def-test-method test-two-project-index ((self test-two-projects) :run nil)
 179   (multiple-value-bind (body response-code headers uri)
 180       (net.aserve.client:do-http-request
 181           (render-uri (copy-uri (parse-uri "http://localhost/testprefix/")
 182                                 :port (port self)) nil)
 183         :redirect nil)
 184     (declare (ignore uri))
 185     (assert-true (zerop (length body)))
 186     (let ((redir (parse-uri
 187                   (cdr (assoc "Location" headers :test #'string-equal)))))
 188       (assert-equal (uri-path redir) "/testprefix/index1.html"))
 189     (assert-equal response-code 307))
 190   (multiple-value-bind (body response-code headers uri)
 191       (net.aserve.client:do-http-request
 192           (render-uri (copy-uri (parse-uri "http://localhost/prefixtest/")
 193                                 :port (port self)) nil)
 194         :redirect nil)
 195     (declare (ignore uri))
 196     (assert-true (zerop (length body)))
 197     (let ((redir (parse-uri
 198                   (cdr (assoc "Location" headers :test #'string-equal)))))
 199       (assert-equal (uri-path redir) "/prefixtest/index2.html"))
 200     (assert-equal response-code 307)
 201     ))
 202
 203
 204 ;;; Test sessions
 205
 206 (defclass test-sessions (test-case)
 207   ((wserver :accessor wserver)
 208    (name :accessor name :initform "sessions")
 209    (prefix :accessor prefix :initform "/")
 210    (port :accessor port :initform 31324)
 211    ))
 212
 213 (defmethod set-up ((self test-sessions))
 214   (setf (wserver self) (net.aserve:start :port (port self) :server :new))
 215   (setq net.aserve::*enable-logging* nil)
 216   (wol-project (name self) :index "index" :connector :aserve
 217                :sessions t
 218                :map '(("index" test-sessions-index))
 219                :project-prefix (prefix self)
 220                :server (wserver self)))
 221
 222
 223 (defmethod tear-down ((self test-sessions))
 224   (net.aserve:shutdown :server (wserver self))
 225   (stop-wol-project (name self)))
 226
 227 (defun test-sessions-index (req ent)
 228   (let ((session (websession-from-req req)))
 229     (with-wol-page (req ent)
 230       (let ((url (make-wol-url "page" req ent)))
 231         (format *html-stream* "index~%")
 232         (format *html-stream* "~A~%" (websession-key session))
 233         (format *html-stream* "~A~%" url)
 234         ))))
 235
 236 (def-test-method test-sessions ((self test-sessions) :run nil)
 237   (multiple-value-bind (body response-code headers uri)
 238       (net.aserve.client:do-http-request
 239           (render-uri (copy-uri (parse-uri "http://localhost/index.html")
 240                                 :port (port self)) nil))
 241     (declare (ignore uri))
 242     (assert-equal response-code 200)
 243     (let ((cookies (set-cookies-in-headers headers)))
 244       (assert-equal (length cookies) 1))
 245     (let ((lines (delimited-string-to-list body #\newline t)))
 246       (assert-equal (length lines) 3)
 247       (assert-equal (first lines) "index")
 248       (assert-equal (length (second lines)) +length-session-id+)
 249       (assert-equal (third lines)
 250                     (format nil "/~~~A~~/page.html" (second lines))))))
 251
 252
 253 ;;; Test no sessions
 254
 255 (defclass test-no-sessions (test-case)
 256   ((wserver :accessor wserver)
 257    (name :accessor name :initform "sessions")
 258    (prefix :accessor prefix :initform "/")
 259    (port :accessor port :initform 31325)
 260    ))
 261
 262 (defmethod set-up ((self test-no-sessions))
 263   (setf (wserver self) (net.aserve:start :port (port self) :server :new))
 264   (setq net.aserve::*enable-logging* nil)
 265   (wol-project (name self) :index "index" :connector :aserve
 266                :sessions nil
 267                :map '(("index" test-no-sessions-index))
 268                :project-prefix (prefix self)
 269                :server (wserver self)))
 270
 271 (defun test-no-sessions-index (req ent)
 272   (let ((session (websession-from-req req)))
 273     (with-wol-page (req ent)
 274       (let ((url (make-wol-url "page" req ent)))
 275         (format *html-stream* "index~%")
 276         (format *html-stream* "~(~A~)~%" session)
 277         (format *html-stream* "~A~%" url)
 278         ))))
 279
 280 (defmethod tear-down ((self test-no-sessions))
 281   (net.aserve:shutdown :server (wserver self))
 282   (stop-wol-project (name self)))
 283
 284 (def-test-method test-no-sessions ((self test-no-sessions) :run nil)
 285   (multiple-value-bind (body response-code headers uri)
 286       (net.aserve.client:do-http-request
 287           (render-uri (copy-uri (parse-uri "http://localhost/index.html")
 288                                 :port (port self)) nil))
 289     (declare (ignore uri))
 290     (assert-equal response-code 200)
 291     (let ((cookies (set-cookies-in-headers headers)))
 292       (assert-equal (length cookies) 0))
 293     (let ((lines (delimited-string-to-list body #\newline t)))
 294       (assert-equal (length lines) 3)
 295       (assert-equal (first lines) "index")
 296       (assert-equal (second lines) "nil")
 297       (assert-equal (third lines) "/page.html"))))
 298
 299
 300 ;;; All tests
 301
 302 (defclass all-tests (test-suite) ())
 303 (defparameter *all-tests* (make-instance 'all-tests))
 304
 305 (add-test *all-tests* (get-suite test-keyed-url))
 306 (add-test *all-tests* (get-suite test-non-keyed-url))
 307 (add-test *all-tests* (get-suite test-server))
 308 (add-test *all-tests* (get-suite test-two-projects))
 309 (add-test *all-tests* (get-suite test-sessions))
 310 (add-test *all-tests* (get-suite test-no-sessions))
 311
 312 (defun do-tests ()
 313   (or (was-successful (textui-test-run *all-tests*))
 314       (error "Failed tests")))