Add lack.session.store.redis for storing session data in Redis.

.travis.yml

@@ -14,6 +14,9 @@ env:
     - LISP=ecl
     - LISP=clisp
 
+services:
+  - redis-server
+
 install:
   # Install Roswell
   - curl -L https://raw.githubusercontent.com/snmsts/roswell/$ROSWELL_BRANCH/scripts/install-for-ci.sh | sh

lack-session-store-redis.asd

@@ -0,0 +1,16 @@
+(in-package :cl-user)
+(defpackage :lack-session-store-redis-asd
+  (:use :cl :asdf))
+(in-package :lack-session-store-redis-asd)
+
+(defsystem lack-session-store-redis
+  :version "0.1"
+  :author "Eitaro Fukamachi"
+  :license "LLGPL"
+  :depends-on (:lack-middleware-session
+               :cl-redis
+               :marshal
+               :cl-base64
+               :trivial-utf-8)
+  :components ((:file "src/middleware/session/store/redis"))
+  :in-order-to ((test-op (test-op t-lack-session-store-redis))))

src/middleware/session/store/redis.lisp

@@ -0,0 +1,90 @@
+(in-package :cl-user)
+(defpackage lack.middleware.session.store.redis
+  (:nicknames :lack.session.store.redis)
+  (:use :cl
+        :lack.middleware.session.store)
+  (:import-from :marshal
+                :marshal
+                :unmarshal)
+  (:import-from :cl-base64
+                :base64-string-to-usb8-array
+                :usb8-array-to-base64-string)
+  (:import-from :trivial-utf-8
+                :string-to-utf-8-bytes
+                :utf-8-bytes-to-string)
+  (:export :redis-store
+           :make-redis-store
+           :fetch-session
+           :store-session
+           :remove-session))
+(in-package :lack.middleware.session.store.redis)
+
+(defun open-connection (&key host port)
+  (make-instance 'redis:redis-connection
+                 :host host
+                 :port port))
+
+(defstruct (redis-store (:include store)
+                        (:constructor %make-redis-store))
+  (host "127.0.0.1")
+  (port 6379)
+  (namespace "session" :type string)
+  (expires nil :type (or null integer))
+  (serializer (lambda (data)
+                (usb8-array-to-base64-string
+                 (string-to-utf-8-bytes (prin1-to-string (marshal data))))))
+  (deserializer (lambda (data)
+                  (unmarshal (read-from-string
+                              (utf-8-bytes-to-string (base64-string-to-usb8-array data))))))
+
+  connection)
+
+(defun make-redis-store (&rest args &key (host "127.0.0.1") (port 6379) connection namespace expires serializer deserializer)
+  (declare (ignore namespace expires serializer deserializer))
+  (if connection
+      (setf (getf args :host) (redis::conn-host connection)
+            (getf args :port) (redis::conn-port connection))
+      (setf (getf args :connection)
+            (open-connection :host host :port port)))
+  (apply #'%make-redis-store args))
+
+(defun redis-connection (store)
+  (check-type store redis-store)
+  (with-slots (host port connection) store
+    (unless (redis::connection-open-p connection)
+      (setf connection
+            (open-connection :host host :port port)))
+    connection))
+
+(defmacro with-connection (store &body body)
+  `(let ((redis::*connection* (redis-connection ,store)))
+     ,@body))
+
+(defmethod fetch-session ((store redis-store) sid)
+  (let ((data (with-connection store
+                (red:get (format nil "~A:~A"
+                                 (redis-store-namespace store)
+                                 sid)))))
+    (if data
+        (handler-case (funcall (redis-store-deserializer store) data)
+          (error (e)
+            (warn "Error (~A) occured while deserializing a session. Ignoring.~2%    Data:~%        ~A~2%    Error:~%        ~A"
+                  (class-name (class-of e))
+                  data
+                  e)
+            nil))
+        nil)))
+
+(defmethod store-session ((store redis-store) sid session)
+  (let ((data (funcall (redis-store-serializer store) session))
+        (key  (format nil "~A:~A" (redis-store-namespace store) sid)))
+    (with-connection store
+      (red:set key data)
+      (when (redis-store-expires store)
+        (red:expire key (redis-store-expires store))))))
+
+(defmethod remove-session ((store redis-store) sid)
+  (with-connection store
+    (red:del (format nil "~A:~A"
+                     (redis-store-namespace store)
+                     sid))))

t-lack-session-store-redis.asd

@@ -0,0 +1,18 @@
+(in-package :cl-user)
+(defpackage t-lack-session-store-redis-asd
+  (:use :cl :asdf))
+(in-package :t-lack-session-store-redis-asd)
+
+(defsystem t-lack-session-store-redis
+  :author "Eitaro Fukamachi"
+  :license "LLGPL"
+  :depends-on (:lack
+               :lack-test
+               :lack-session-store-redis
+               :prove)
+  :components
+  ((:test-file "t/session/store/redis"))
+
+  :defsystem-depends-on (:prove-asdf)
+  :perform (test-op :after (op c)
+                    (funcall (intern #.(string :run-test-system) :prove) c)))

t/session/store/dbi.lisp

@@ -81,7 +81,7 @@
 
 (let ((session (dbi:fetch (dbi:execute (dbi:prepare *conn* "SELECT COUNT(*) AS count FROM sessions")))))
   (is (getf session :|count|) 2
-      "'sessions' has a single record"))
+      "'sessions' has two records"))
 
 (dbi:disconnect *conn*)
 

t/session/store/redis.lisp

@@ -0,0 +1,120 @@
+(in-package :cl-user)
+(defpackage t.lack.session.store.redis
+  (:use :cl
+        :lack
+        :lack.test
+        :lack.session.store.redis
+        :prove)
+  (:import-from :lack.session.store.redis
+                :redis-store-connection))
+(in-package :t.lack.session.store.redis)
+
+(plan 4)
+
+(defvar *namespace* "session_test")
+(defvar *connection* (redis-store-connection (make-redis-store)))
+
+(let ((redis::*connection* *connection*))
+  (let ((keys (red:keys (format nil "~A:*" *namespace*))))
+    (when keys
+      (apply #'red:del keys))))
+
+(subtest "session middleware"
+  (let ((app
+          (builder
+           (:session
+            :store (make-redis-store :namespace *namespace* :connection *connection*))
+           (lambda (env)
+             (unless (gethash :counter (getf env :lack.session))
+               (setf (gethash :counter (getf env :lack.session)) 0))
+             `(200
+               (:content-type "text/plain")
+               (,(format nil "Hello, you've been here for ~Ath times!"
+                         (incf (gethash :counter (getf env :lack.session)))))))))
+        session)
+    (diag "1st request")
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/"))
+      (is status 200)
+      (setf session (parse-lack-session headers))
+      (ok session)
+      (is body '("Hello, you've been here for 1th times!")))
+
+    (diag "2nd request")
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/" :cookies `(("lack.session" . ,session))))
+      (declare (ignore headers))
+      (is status 200)
+      (is body '("Hello, you've been here for 2th times!")))))
+
+(subtest "utf-8 session data"
+  (let ((app
+          (builder
+           (:session
+            :store (make-redis-store :namespace *namespace* :connection *connection*))
+           (lambda (env)
+             (unless (gethash :user (getf env :lack.session))
+               (setf (gethash :user (getf env :lack.session)) "深町英太郎"))
+             (unless (gethash :counter (getf env :lack.session))
+               (setf (gethash :counter (getf env :lack.session)) 0))
+             `(200
+               (:content-type "text/plain")
+               (,(format nil "Hello, ~A! You've been here for ~Ath times!"
+                         (gethash :user (getf env :lack.session))
+                         (incf (gethash :counter (getf env :lack.session)))))))))
+        session)
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/"))
+      (is status 200)
+      (setf session (parse-lack-session headers))
+      (ok session)
+      (is body '("Hello, 深町英太郎! You've been here for 1th times!")))
+
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/" :cookies `(("lack.session" . ,session))))
+      (declare (ignore headers))
+      (is status 200)
+      (is body '("Hello, 深町英太郎! You've been here for 2th times!")))))
+
+(subtest "expires"
+  (let ((app
+          (builder
+           (:session
+            :store (make-redis-store :namespace *namespace* :connection *connection*
+                                     :expires 3))
+           (lambda (env)
+             (unless (gethash :user (getf env :lack.session))
+               (setf (gethash :user (getf env :lack.session)) "深町英太郎"))
+             (unless (gethash :counter (getf env :lack.session))
+               (setf (gethash :counter (getf env :lack.session)) 0))
+             `(200
+               (:content-type "text/plain")
+               (,(format nil "Hello, ~A! You've been here for ~Ath times!"
+                         (gethash :user (getf env :lack.session))
+                         (incf (gethash :counter (getf env :lack.session)))))))))
+        session)
+
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/"))
+      (is status 200)
+      (setf session (parse-lack-session headers))
+      (ok session)
+      (is body '("Hello, 深町英太郎! You've been here for 1th times!")))
+
+    (let ((body (nth 2 (funcall app (generate-env "/" :cookies `(("lack.session" . ,session)))))))
+      (is body '("Hello, 深町英太郎! You've been here for 2th times!")))
+
+    (sleep 3)
+
+    (let ((body (nth 2 (funcall app (generate-env "/" :cookies `(("lack.session" . ,session)))))))
+      (is body '("Hello, 深町英太郎! You've been here for 1th times!")
+          "Session has expired after 3 seconds"))))
+
+(let ((redis::*connection* *connection*))
+  (is (length (red:keys (format nil "~A:*" *namespace*)))
+      3
+      "'session' has three records"))
+
+(finalize)
+
+(redis:close-connection *connection*)