-
-
Notifications
You must be signed in to change notification settings - Fork 33
/
dbi.lisp
109 lines (102 loc) · 4.7 KB
/
dbi.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
(defpackage lack/middleware/session/store/dbi
(:nicknames :lack.middleware.session.store.dbi
:lack.session.store.dbi
:lack/session/store/dbi)
(: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 :dbi-store
:make-dbi-store
:fetch-session
:store-session
:remove-session))
(in-package :lack/middleware/session/store/dbi)
(defmacro with-db-connection (connection store &body body)
`(let ((,connection (funcall (dbi-store-connector ,store))))
(unwind-protect
(progn ,@body)
(when (dbi-store-disconnector ,store)
(funcall (dbi-store-disconnector ,store) ,connection)))))
(defstruct (dbi-store (:include store))
(connector nil :type function)
(disconnector nil)
(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))))))
(record-timestamps nil :type boolean)
(table-name "sessions")
(data-column-name "session_data")
(id-column-name "id"))
(defmethod fetch-session ((store dbi-store) sid)
(with-db-connection conn store
(let* ((query (dbi:prepare conn
(format nil "SELECT ~A FROM ~A WHERE ~A = ?"
(dbi-store-data-column-name store)
(dbi-store-table-name store)
(dbi-store-id-column-name store))))
(result (dbi:fetch (dbi:execute query (list sid)))))
(if result
(handler-case (funcall (dbi-store-deserializer store) (getf result :|session_data|))
(error (e)
(warn "Error (~A) occured while deserializing a session. Ignoring.~2% Data:~% ~A~2% Error:~% ~A"
(class-name (class-of e))
(getf result :|session_data|)
e)
nil))
nil))))
(defun current-timestamp ()
(multiple-value-bind (sec min hour date month year)
(decode-universal-time (get-universal-time))
(format nil "~D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0D"
year month date
hour min sec)))
(defmethod store-session ((store dbi-store) sid session)
(with-db-connection conn store
(let ((serialized-session (funcall (dbi-store-serializer store) session)))
(dbi:with-transaction conn
(let* ((query (dbi:prepare conn
(format nil "SELECT ~A FROM ~A WHERE ~A = ?"
(dbi-store-data-column-name store)
(dbi-store-table-name store)
(dbi-store-id-column-name store))))
(current-session (getf (dbi:fetch (dbi:execute query (list sid))) :|session_data|)))
(cond
;; Session exists but not changed
((equal current-session serialized-session))
;; Session exists and is going to be changed
(current-session
(dbi:do-sql conn
(format nil "UPDATE ~A SET ~A = ?~:[~*~;, updated_at = '~A'~] WHERE ~A = ?"
(dbi-store-table-name store)
(dbi-store-data-column-name store)
(dbi-store-record-timestamps store)
(current-timestamp)
(dbi-store-id-column-name store))
(list serialized-session sid)))
;; New session
(t
(dbi:do-sql conn (format nil "INSERT INTO ~A (~A, ~A~:[~;, created_at, updated_at~]) VALUES (?, ?~:*~:[~*~;, '~A', ~:*'~A'~])"
(dbi-store-table-name store)
(dbi-store-id-column-name store)
(dbi-store-data-column-name store)
(dbi-store-record-timestamps store)
(current-timestamp))
(list sid serialized-session)))))))))
(defmethod remove-session ((store dbi-store) sid)
(with-db-connection conn store
(dbi:do-sql conn
(format nil "DELETE FROM ~A WHERE ~A = ?"
(dbi-store-table-name store)
(dbi-store-id-column-name store))
(list sid))))