/t/t-session.lisp

  1(in-package :wu)
  2
  3(5am:def-suite :session :in :wuwei)
  4(5am:in-suite :session)
  5
  6;;; Tests of session and login machinery
  7
  8;;; Test dropping a cookie to establish session
  9(5am:test session-basics
 10  (publish :path (test-path "session1")
 11	   :function #'(lambda (req ent)
 12			 (with-session (req ent)
 13			   (with-http-response-and-body (req ent) 
 14			     (html (:html (:body "foo")))))))
 15  (let ((cookie-jar (make-instance 'net.aserve.client:cookie-jar)))
 16    (multiple-value-bind (response response-code response-headers)
 17	(net.aserve.client::do-http-request (test-url "session1")
 18	  :cookies cookie-jar)
 19      (declare (ignore response response-headers))
 20      (5am:is (equal 200 response-code))
 21      (5am:is (net.aserve.client::cookie-jar-items cookie-jar)))))
 22
 23(def-session-variable *test-2* 0)
 24
 25;;; Test session variable machinery without a web trip
 26(5am:test session-variables
 27  (let ((*session* (make-new-session nil nil)))
 28    (with-session-variables
 29      (5am:is (equal 0 *test-2*))
 30      (incf *test-2*))
 31    (let ((*test-2* nil))
 32      (with-session-variables
 33	(5am:is (equal 1 *test-2*))))))
 34
 35(def-session-variable *test-session-var* 0)
 36
 37;;; Test that session state is working (combines the above two)
 38(5am:test session-state
 39  (publish :path (test-path "session2")
 40	   :function #'(lambda (req ent)
 41			 (with-session (req ent)
 42			   (with-http-response-and-body (req ent) 
 43			     (html (:html (:body (:princ "v") (:princ *test-session-var*))))
 44			     (incf *test-session-var*)
 45			     ))))
 46  (let ((cookie-jar (make-instance 'net.aserve.client:cookie-jar)))
 47    (multiple-value-bind (response response-code response-headers)
 48	(net.aserve.client::do-http-request (test-url "session2")
 49	  :cookies cookie-jar)
 50      (declare (ignore response-headers))
 51      (5am:is (equal 200 response-code))
 52      (5am:is (net.aserve.client::cookie-jar-items cookie-jar))
 53      (5am:is (search "v0" response)))
 54    (multiple-value-bind (response response-code response-headers)
 55	(net.aserve.client::do-http-request (test-url "session2")
 56	  :cookies cookie-jar)
 57      (declare (ignore response-code response-headers))
 58      (5am:is (search "v1" response)))
 59      ))
 60
 61(defun test-login (req ent)
 62  (with-http-response-and-body (req ent)
 63    (render-update
 64      (:redirect "/login"))))
 65
 66;;; This is how you do a login.  Note that the make-new-session has to be OUTSIDE the with-http-response-and-body, to allow the cookies to be set early.
 67(publish :path (test-path "login")
 68	 :function #'(lambda (req ent)
 69		       (setq *session* (make-new-session req ent))
 70		       (with-http-response-and-body (req ent)
 71			 (html "logged in"))
 72		       ))
 73	 
 74
 75;;; Tests protection of an ajax method against unlogged-in users, and logging in.
 76(5am:test login-required
 77  (let* ((test nil)
 78	 (url (format nil "http://localhost:~A~A" 
 79		      *test-port*
 80		      (ajax-continuation (:login-handler 'test-login :keep t) 
 81			(setq test t)
 82			(render-update (:alert "snockity"))))))
 83    (let ((res (net.aserve.client:do-http-request url :method :post :query '((:bogus . "value")))))
 84      (5am:is (not test))		;should NOT run the continuation
 85      ;; Should be getting a redirect command back
 86      (5am:is (search "window.location.href" res)))
 87
 88    ;; simulate a login and try again
 89    (let ((cookie-jar (make-instance 'net.aserve.client:cookie-jar)))
 90      (multiple-value-bind (response response-code response-headers)
 91	  (net.aserve.client::do-http-request (test-url "login")
 92	    :cookies cookie-jar)
 93	(declare (ignore response response-headers))
 94	(5am:is (equal 200 response-code))
 95	(5am:is (net.aserve.client::cookie-jar-items cookie-jar))
 96	(let ((res (net.aserve.client:do-http-request url :method :post :query '((:bogus . "value"))
 97						      :cookies cookie-jar)))
 98	  (5am:is-true test)
 99	  (5am:is (search "alert(" res)))
100	))))